summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJustin Ethier <justin.ethier@gmail.com>2024-01-17 19:43:47 -0800
committerJustin Ethier <justin.ethier@gmail.com>2024-01-17 19:43:47 -0800
commit3b921e73895782edef4d5ca9be77bb46afa21469 (patch)
tree9c6441f8b51782a9795a7e99d6352da9215f6957
parentb44198744bf4886a07c99982838b79bda50c0099 (diff)
Re-format code
-rw-r--r--ck-polyfill.c241
-rw-r--r--ck-polyfill.h141
-rw-r--r--ffi.c40
-rw-r--r--gc.c699
-rw-r--r--hashset.c166
-rw-r--r--include/cyclone/bignum.h655
-rw-r--r--include/cyclone/hashset.h69
-rw-r--r--include/cyclone/runtime-main.h2
-rw-r--r--include/cyclone/runtime.h54
-rw-r--r--include/cyclone/types.h172
-rw-r--r--mstreams.c41
-rw-r--r--runtime.c2683
12 files changed, 2596 insertions, 2367 deletions
diff --git a/ck-polyfill.c b/ck-polyfill.c
index 49a6e485..6b758f1f 100644
--- a/ck-polyfill.c
+++ b/ck-polyfill.c
@@ -27,8 +27,9 @@ void ck_polyfill_init()
}
// CK Hashset section
-bool ck_hs_init(ck_hs_t *hs, unsigned int mode, ck_hs_hash_cb_t *hash_func,
- ck_hs_compare_cb_t *cmp, struct ck_malloc *alloc, unsigned long capacity, unsigned long seed)
+bool ck_hs_init(ck_hs_t * hs, unsigned int mode, ck_hs_hash_cb_t * hash_func,
+ ck_hs_compare_cb_t * cmp, struct ck_malloc *alloc,
+ unsigned long capacity, unsigned long seed)
{
(*hs).hs = simple_hashset_create();
if (pthread_mutex_init(&((*hs).lock), NULL) != 0) {
@@ -38,7 +39,7 @@ bool ck_hs_init(ck_hs_t *hs, unsigned int mode, ck_hs_hash_cb_t *hash_func,
return true;
}
-void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
+void *ck_hs_get(ck_hs_t * _hs, unsigned long hash, const void *key)
{
void *result = NULL;
int index = -1;
@@ -46,7 +47,7 @@ void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
pthread_mutex_lock(&((*_hs).lock));
- index = simple_hashset_is_member(set, (symbol_type *)key);
+ index = simple_hashset_is_member(set, (symbol_type *) key);
if (index > 0) {
result = (void *)(set->items[index].item);
}
@@ -55,7 +56,7 @@ void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
return result;
}
-bool ck_hs_put(ck_hs_t *_hs, unsigned long hash, const void *key)
+bool ck_hs_put(ck_hs_t * _hs, unsigned long hash, const void *key)
{
bool result = false;
int rv, index;
@@ -65,10 +66,10 @@ bool ck_hs_put(ck_hs_t *_hs, unsigned long hash, const void *key)
//index = simple_hashset_is_member(hs, (symbol_type *)key);
//if (index == 0) {
- rv = simple_hashset_add(hs, (symbol_type *)key);
- if (rv >= 0) {
- result = true;
- }
+ rv = simple_hashset_add(hs, (symbol_type *) key);
+ if (rv >= 0) {
+ result = true;
+ }
//}
pthread_mutex_unlock(&((*_hs).lock));
@@ -77,8 +78,8 @@ bool ck_hs_put(ck_hs_t *_hs, unsigned long hash, const void *key)
// CK Array section
bool
-ck_array_init(ck_array_t *array, unsigned int mode,
- struct ck_malloc *allocator, unsigned int initial_length)
+ck_array_init(ck_array_t * array, unsigned int mode,
+ struct ck_malloc *allocator, unsigned int initial_length)
{
(*array).hs = hashset_create();
if (pthread_mutex_init(&((*array).lock), NULL) != 0) {
@@ -101,8 +102,7 @@ ck_array_init(ck_array_t *array, unsigned int mode,
// This function returns 1 if the pointer already exists in the array. It
// returns 0 if the put operation succeeded. It returns -1 on error due to
// internal memory allocation failures.
-int
-ck_array_put_unique(ck_array_t *array, void *pointer)
+int ck_array_put_unique(ck_array_t * array, void *pointer)
{
pthread_mutex_lock(&(array->lock));
hashset_add(array->hs, pointer);
@@ -121,8 +121,8 @@ ck_array_put_unique(ck_array_t *array, void *pointer)
// This function returns true if the remove operation succeeded. It will
// return false otherwise due to internal allocation failures or because the
// value did not exist.
-bool
-ck_array_remove(ck_array_t *array, void *pointer){
+bool ck_array_remove(ck_array_t * array, void *pointer)
+{
pthread_mutex_lock(&(array->lock));
hashset_remove(array->hs, pointer);
pthread_mutex_unlock(&(array->lock));
@@ -138,12 +138,12 @@ ck_array_remove(ck_array_t *array, void *pointer){
// RETURN VALUES
// This function returns true if the commit operation succeeded. It will
// return false otherwise, and pending operations will not be applied.
-bool ck_array_commit(ck_array_t *array) {
+bool ck_array_commit(ck_array_t * array)
+{
// Nothing to do in this polyfill
return true;
}
-
// TODO: global pthread mutex lock for this? obviously not ideal but the
// whole purpose of this module is a minimal interface for compatibility
// not speed
@@ -164,7 +164,7 @@ bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value)
{
bool result = false;
pthread_mutex_lock(&glock);
- if ( *(void **)target == old_value ) {
+ if (*(void **)target == old_value) {
*(void **)target = new_value;
result = true;
}
@@ -173,7 +173,7 @@ bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value)
// *(void **)v = set;
}
-bool ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value)
+bool ck_pr_cas_8(uint8_t * target, uint8_t old_value, uint8_t new_value)
{
bool result = false;
pthread_mutex_lock(&glock);
@@ -185,36 +185,32 @@ bool ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value)
return result;
}
-void
-ck_pr_add_ptr(void *target, uintptr_t delta)
+void ck_pr_add_ptr(void *target, uintptr_t delta)
{
pthread_mutex_lock(&glock);
- size_t value = (size_t) target;
- size_t d = (size_t) delta;
+ size_t value = (size_t)target;
+ size_t d = (size_t)delta;
size_t result = value + d;
*(void **)target = (void *)result;
// *(void **)v = set;
pthread_mutex_unlock(&glock);
}
-void
-ck_pr_add_int(int *target, int delta)
+void ck_pr_add_int(int *target, int delta)
{
pthread_mutex_lock(&glock);
(*target) += delta;
pthread_mutex_unlock(&glock);
}
-void
-ck_pr_add_8(uint8_t *target, uint8_t delta)
+void ck_pr_add_8(uint8_t * target, uint8_t delta)
{
pthread_mutex_lock(&glock);
(*target) += delta;
pthread_mutex_unlock(&glock);
}
-void *
-ck_pr_load_ptr(const void *target)
+void *ck_pr_load_ptr(const void *target)
{
void *result;
pthread_mutex_lock(&glock);
@@ -223,8 +219,7 @@ ck_pr_load_ptr(const void *target)
return result;
}
-int
-ck_pr_load_int(const int *target)
+int ck_pr_load_int(const int *target)
{
int result;
pthread_mutex_lock(&glock);
@@ -233,8 +228,7 @@ ck_pr_load_int(const int *target)
return result;
}
-uint8_t
-ck_pr_load_8(const uint8_t *target)
+uint8_t ck_pr_load_8(const uint8_t * target)
{
uint8_t result;
pthread_mutex_lock(&glock);
@@ -250,134 +244,139 @@ void ck_pr_store_ptr(void *target, void *value)
pthread_mutex_unlock(&glock);
}
-
// Simple hashset
static const size_t prime_1 = 73;
static const size_t prime_2 = 5009;
-size_t hash_function(const char* str, size_t len) {
- unsigned long hash = 5381;
- int c;
+size_t hash_function(const char *str, size_t len)
+{
+ unsigned long hash = 5381;
+ int c;
- while (c = *str++) {
- hash = ((hash << 5) + hash) + c; /* hash * 33 + c */
- }
+ while (c = *str++) {
+ hash = ((hash << 5) + hash) + c; /* hash * 33 + c */
+ }
- return hash;
+ return hash;
}
simple_hashset_t simple_hashset_create()
{
- simple_hashset_t set = (simple_hashset_t)calloc(1, sizeof(struct simple_hashset_st));
+ simple_hashset_t set =
+ (simple_hashset_t) calloc(1, sizeof(struct simple_hashset_st));
- if (set == NULL) {
- return NULL;
- }
+ if (set == NULL) {
+ return NULL;
+ }
- set->hash_func = hash_function;
- set->nbits = 3;
- set->capacity = (size_t)(1 << set->nbits);
- set->mask = set->capacity - 1;
- set->items = (struct simple_hashset_item_st*)calloc(set->capacity, sizeof(struct simple_hashset_item_st));
- if (set->items == NULL) {
- simple_hashset_destroy(set);
- return NULL;
- }
- set->nitems = 0;
- set->n_deleted_items = 0;
- return set;
+ set->hash_func = hash_function;
+ set->nbits = 3;
+ set->capacity = (size_t)(1 << set->nbits);
+ set->mask = set->capacity - 1;
+ set->items =
+ (struct simple_hashset_item_st *)calloc(set->capacity,
+ sizeof(struct
+ simple_hashset_item_st));
+ if (set->items == NULL) {
+ simple_hashset_destroy(set);
+ return NULL;
+ }
+ set->nitems = 0;
+ set->n_deleted_items = 0;
+ return set;
}
void simple_hashset_destroy(simple_hashset_t set)
{
- if (set) {
- free(set->items);
- }
- free(set);
+ if (set) {
+ free(set->items);
+ }
+ free(set);
}
void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func)
{
- set->hash_func = func;
+ set->hash_func = func;
}
-static int simple_hashset_add_member(simple_hashset_t set, symbol_type* key, size_t hash)
+static int simple_hashset_add_member(simple_hashset_t set, symbol_type * key,
+ size_t hash)
{
- size_t index;
+ size_t index;
- if (hash < 2) {
- return -1;
- }
+ if (hash < 2) {
+ return -1;
+ }
- index = set->mask & (prime_1 * hash);
+ index = set->mask & (prime_1 * hash);
- while (set->items[index].hash != 0 && set->items[index].hash != 1) {
- if (set->items[index].hash == hash) {
- return 0;
- }
- else {
- /* search free slot */
- index = set->mask & (index + prime_2);
- }
+ while (set->items[index].hash != 0 && set->items[index].hash != 1) {
+ if (set->items[index].hash == hash) {
+ return 0;
+ } else {
+ /* search free slot */
+ index = set->mask & (index + prime_2);
}
+ }
- ++set->nitems;
- if (set->items[index].hash == 1) {
- --set->n_deleted_items;
- }
+ ++set->nitems;
+ if (set->items[index].hash == 1) {
+ --set->n_deleted_items;
+ }
- set->items[index].hash = hash;
- set->items[index].item = key;
- return 1;
+ set->items[index].hash = hash;
+ set->items[index].item = key;
+ return 1;
}
static void set_maybe_rehash(simple_hashset_t set)
{
- struct simple_hashset_item_st *old_items;
- size_t old_capacity, index;
-
-
- if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
- old_items = set->items;
- old_capacity = set->capacity;
- ++set->nbits;
- set->capacity = (size_t)(1 << set->nbits);
- set->mask = set->capacity - 1;
- set->items = (struct simple_hashset_item_st*)calloc(set->capacity, sizeof(struct simple_hashset_item_st));
- set->nitems = 0;
- set->n_deleted_items = 0;
- //assert(set->items);
- for (index = 0; index < old_capacity; ++index) {
- simple_hashset_add_member(set, old_items[index].item, old_items[index].hash);
- }
- free(old_items);
+ struct simple_hashset_item_st *old_items;
+ size_t old_capacity, index;
+
+ if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
+ old_items = set->items;
+ old_capacity = set->capacity;
+ ++set->nbits;
+ set->capacity = (size_t)(1 << set->nbits);
+ set->mask = set->capacity - 1;
+ set->items =
+ (struct simple_hashset_item_st *)calloc(set->capacity,
+ sizeof(struct
+ simple_hashset_item_st));
+ set->nitems = 0;
+ set->n_deleted_items = 0;
+ //assert(set->items);
+ for (index = 0; index < old_capacity; ++index) {
+ simple_hashset_add_member(set, old_items[index].item,
+ old_items[index].hash);
}
+ free(old_items);
+ }
}
-int simple_hashset_add(simple_hashset_t set, symbol_type* key)
+int simple_hashset_add(simple_hashset_t set, symbol_type * key)
{
- size_t key_len = strlen(key->desc);
- size_t hash = set->hash_func(key->desc, key_len);
- int rv = simple_hashset_add_member(set, key, hash);
- set_maybe_rehash(set);
- return rv;
+ size_t key_len = strlen(key->desc);
+ size_t hash = set->hash_func(key->desc, key_len);
+ int rv = simple_hashset_add_member(set, key, hash);
+ set_maybe_rehash(set);
+ return rv;
}
-int simple_hashset_is_member(simple_hashset_t set, symbol_type* key)
+int simple_hashset_is_member(simple_hashset_t set, symbol_type * key)
{
- size_t key_len = strlen(key->desc);
- size_t hash = set->hash_func(key->desc, key_len);
- size_t index = set->mask & (prime_1 * hash);
-
- while (set->items[index].hash != 0) {
- if (set->items[index].hash == hash) {
- return index;
- } else {
- index = set->mask & (index + prime_2);
- }
+ size_t key_len = strlen(key->desc);
+ size_t hash = set->hash_func(key->desc, key_len);
+ size_t index = set->mask & (prime_1 * hash);
+
+ while (set->items[index].hash != 0) {
+ if (set->items[index].hash == hash) {
+ return index;
+ } else {
+ index = set->mask & (index + prime_2);
}
- return 0;
+ }
+ return 0;
}
-
-
diff --git a/ck-polyfill.h b/ck-polyfill.h
index df875f0b..085bc0be 100644
--- a/ck-polyfill.h
+++ b/ck-polyfill.h
@@ -8,53 +8,52 @@
void ck_polyfill_init();
-struct ck_malloc {
- void *(*malloc)(size_t);
- void *(*realloc)(void *, size_t, size_t, bool);
- void (*free)(void *, size_t, bool);
-};
+struct ck_malloc {
+ void *(*malloc)(size_t);
+ void *(*realloc)(void *, size_t, size_t, bool);
+ void (*free)(void *, size_t, bool);
+};
///////////////////////////////////////////////////////////////////////////////
// Simple hashset (hashset with string support)
/* hash function */
- typedef size_t(*hash_func_t)(const char*, size_t);
-
- struct simple_hashset_item_st {
- size_t hash;
- symbol_type* item;
- };
-
- struct simple_hashset_st {
- size_t nbits;
- size_t mask;
-
- size_t capacity;
- struct simple_hashset_item_st *items;
- size_t nitems;
- size_t n_deleted_items;
-
- hash_func_t hash_func;
- };
-// struct simple_hashset_st;
- typedef struct simple_hashset_st *simple_hashset_t;
+typedef size_t (*hash_func_t)(const char *, size_t);
+
+struct simple_hashset_item_st {
+ size_t hash;
+ symbol_type *item;
+};
+
+struct simple_hashset_st {
+ size_t nbits;
+ size_t mask;
+ size_t capacity;
+ struct simple_hashset_item_st *items;
+ size_t nitems;
+ size_t n_deleted_items;
- struct hashmap_st;
- typedef struct hashmap_st *hashmap_t;
+ hash_func_t hash_func;
+};
+// struct simple_hashset_st;
+typedef struct simple_hashset_st *simple_hashset_t;
+
+struct hashmap_st;
+typedef struct hashmap_st *hashmap_t;
/*
* HASHSET FUNCTIONS
*/
/* create hashset instance */
- simple_hashset_t simple_hashset_create(void);
+simple_hashset_t simple_hashset_create(void);
/* destroy hashset instance */
- void simple_hashset_destroy(simple_hashset_t set);
+void simple_hashset_destroy(simple_hashset_t set);
/* set hash function */
- void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func);
-
+void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func);
+
/* add item into the hashset.
*
* @note 0 and 1 is special values, meaning nil and deleted items. the
@@ -62,17 +61,17 @@ struct ck_malloc {
*
* returns zero if the item already in the set and non-zero otherwise
*/
- int simple_hashset_add(simple_hashset_t set, symbol_type* key);
+int simple_hashset_add(simple_hashset_t set, symbol_type * key);
/* check if existence of the item
*
* returns non-zero if the item exists and zero otherwise
*/
- int simple_hashset_is_member(simple_hashset_t set, symbol_type* key);
+int simple_hashset_is_member(simple_hashset_t set, symbol_type * key);
static inline uint64_t MurmurHash64A(const void *key, int len, uint64_t seed)
-{
- return 0;
+{
+ return 0;
}
///////////////////////////////////////////////////////////////////////////////
@@ -81,30 +80,31 @@ static inline uint64_t MurmurHash64A(const void *key, int len, uint64_t seed)
#define CK_HS_MODE_OBJECT 0
#define CK_HS_MODE_SPMC 0
-struct ck_hs {
+struct ck_hs {
pthread_mutex_t lock;
simple_hashset_t hs;
-};
+};
-typedef struct ck_hs ck_hs_t;
+typedef struct ck_hs ck_hs_t;
/*
* Hash callback function.
- */
-typedef unsigned long ck_hs_hash_cb_t(const void *, unsigned long);
-
+ */
+typedef unsigned long ck_hs_hash_cb_t(const void *, unsigned long);
+
/*
* Returns pointer to object if objects are equivalent.
- */
-typedef bool ck_hs_compare_cb_t(const void *, const void *);
+ */
+typedef bool ck_hs_compare_cb_t(const void *, const void *);
#define CK_HS_HASH(hs, hs_hash, value) 0
-bool ck_hs_init(ck_hs_t *, unsigned int, ck_hs_hash_cb_t *,
- ck_hs_compare_cb_t *, struct ck_malloc *, unsigned long, unsigned long);
+bool ck_hs_init(ck_hs_t *, unsigned int, ck_hs_hash_cb_t *,
+ ck_hs_compare_cb_t *, struct ck_malloc *, unsigned long,
+ unsigned long);
-void *ck_hs_get(ck_hs_t *, unsigned long, const void *);
-bool ck_hs_put(ck_hs_t *, unsigned long, const void *);
+void *ck_hs_get(ck_hs_t *, unsigned long, const void *);
+bool ck_hs_put(ck_hs_t *, unsigned long, const void *);
/*
struct ck_hs {
@@ -150,8 +150,8 @@ typedef struct ck_array_iterator ck_array_iterator_t;
// returns false if the creation failed. Failure may occur due to internal
// memory allocation failures or invalid arguments.
bool
-ck_array_init(ck_array_t *array, unsigned int mode,
- struct ck_malloc *allocator, unsigned int initial_length);
+ck_array_init(ck_array_t * array, unsigned int mode,
+ struct ck_malloc *allocator, unsigned int initial_length);
// DESCRIPTION
// The ck_array_put_unique(3) function will attempt to insert the value of
@@ -166,8 +166,7 @@ ck_array_init(ck_array_t *array, unsigned int mode,
// This function returns 1 if the pointer already exists in the array. It
// returns 0 if the put operation succeeded. It returns -1 on error due to
// internal memory allocation failures.
-int
-ck_array_put_unique(ck_array_t *array, void *pointer);
+int ck_array_put_unique(ck_array_t * array, void *pointer);
// DESCRIPTION
// The ck_array_remove(3) function will attempt to remove the value of
@@ -180,9 +179,7 @@ ck_array_put_unique(ck_array_t *array, void *pointer);
// This function returns true if the remove operation succeeded. It will
// return false otherwise due to internal allocation failures or because the
// value did not exist.
-bool
-ck_array_remove(ck_array_t *array, void *pointer);
-
+bool ck_array_remove(ck_array_t * array, void *pointer);
// DESCRIPTION
// The ck_array_commit(3) function will commit any pending put or remove
@@ -193,9 +190,7 @@ ck_array_remove(ck_array_t *array, void *pointer);
// RETURN VALUES
// This function returns true if the commit operation succeeded. It will
// return false otherwise, and pending operations will not be applied.
-bool
-ck_array_commit(ck_array_t *array);
-
+bool ck_array_commit(ck_array_t * array);
// TODO:
@@ -209,37 +204,27 @@ ck_array_commit(ck_array_t *array);
if (tmpc > 0) { (*b) = tmp[0]; } \
for (unsigned int _ck_i = 0; \
_ck_i < tmpc; \
- _ck_i++, (*b) = tmp[_ck_i])
-
+ _ck_i++, (*b) = tmp[_ck_i])
+
///////////////////////////////////////////////////////////////////////////////
// CK PR section
-bool
-ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
+bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
-bool
-ck_pr_cas_int(int *target, int old_value, int new_value);
-
-bool
-ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value);
+bool ck_pr_cas_int(int *target, int old_value, int new_value);
+bool ck_pr_cas_8(uint8_t * target, uint8_t old_value, uint8_t new_value);
-void
-ck_pr_add_ptr(void *target, uintptr_t delta);
+void ck_pr_add_ptr(void *target, uintptr_t delta);
-void
-ck_pr_add_int(int *target, int delta);
+void ck_pr_add_int(int *target, int delta);
-void
-ck_pr_add_8(uint8_t *target, uint8_t delta);
+void ck_pr_add_8(uint8_t * target, uint8_t delta);
-void *
-ck_pr_load_ptr(const void *target);
+void *ck_pr_load_ptr(const void *target);
-int
-ck_pr_load_int(const int *target);
+int ck_pr_load_int(const int *target);
-uint8_t
-ck_pr_load_8(const uint8_t *target);
+uint8_t ck_pr_load_8(const uint8_t * target);
void ck_pr_store_ptr(void *target, void *value);
#endif /* CYCLONE_CK_POLYFILL_H */
diff --git a/ffi.c b/ffi.c
index 7ae707dd..2d37647f 100644
--- a/ffi.c
+++ b/ffi.c
@@ -13,14 +13,15 @@
#include <ck_pr.h>
#include <unistd.h>
-void *Cyc_init_thread(object thread_and_thunk, int argc, object *args);
+void *Cyc_init_thread(object thread_and_thunk, int argc, object * args);
/**
* After the Scheme call finishes, we wind down the GC / Heap used
* for the call and perform a minor GC to ensure any returned object
* is on the heap and safe to use.
*/
-static void Cyc_return_from_scm_call(void *data, object _, int argc, object *args)
+static void Cyc_return_from_scm_call(void *data, object _, int argc,
+ object * args)
{
gc_thread_data *thd = data;
object result = args[0];
@@ -41,12 +42,13 @@ static void Cyc_return_from_scm_call(void *data, object _, int argc, object *arg
* We store results and longjmp back to where we started, at the
* bottom of the trampoline (we only jump once).
*/
-static void Cyc_after_scm_call(void *data, object _, int argc, object *args)
+static void Cyc_after_scm_call(void *data, object _, int argc, object * args)
{
gc_thread_data *thd = data;
object result = args[0];
mclosure0(clo, Cyc_return_from_scm_call);
- object buf[1]; buf[0] = result;
+ object buf[1];
+ buf[0] = result;
GC(thd, &clo, buf, 1);
}
@@ -58,7 +60,8 @@ static void Cyc_after_scm_call(void *data, object _, int argc, object *args)
* can do anything "normal" Scheme code does, and any returned
* objects will be on the heap and available for use by the caller.
*/
-object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *args)
+object Cyc_scm_call(gc_thread_data * parent_thd, object fnc, int argc,
+ object * args)
{
jmp_buf l;
gc_thread_data local;
@@ -66,13 +69,13 @@ object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *ar
local.jmp_start = &l;
gc_thread_data *td = malloc(sizeof(gc_thread_data));
- gc_add_new_unrunning_mutator(td); /* Register this thread */
+ gc_add_new_unrunning_mutator(td); /* Register this thread */
make_c_opaque(co, td);
make_utf8_string(NULL, name_str, "");
make_c_opaque(co_parent_thd, parent_thd);
make_c_opaque(co_this_thd, &local);
- mclosure0(after, (function_type)Cyc_after_scm_call);
+ mclosure0(after, (function_type) Cyc_after_scm_call);
make_empty_vector(vec);
vec.num_elements = 7;
@@ -81,11 +84,11 @@ object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *ar
vec.elements[1] = fnc;
vec.elements[2] = &co;
vec.elements[3] = &name_str;
- vec.elements[4] = &co_this_thd; //boolean_f;
+ vec.elements[4] = &co_this_thd; //boolean_f;
vec.elements[5] = &co_parent_thd;
vec.elements[6] = &after;
- make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so...
+ make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so...
if (!setjmp(*(local.jmp_start))) {
Cyc_init_thread(&thread_and_thunk, argc, args);
@@ -105,7 +108,8 @@ object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *ar
* We store results and longjmp back to where we started, at the
* bottom of the trampoline (we only jump once).
*/
-static void no_gc_after_call_scm(gc_thread_data *thd, object _, int argc, object *args)
+static void no_gc_after_call_scm(gc_thread_data * thd, object _, int argc,
+ object * args)
{
object result = args[0];
thd->gc_cont = result;
@@ -115,11 +119,11 @@ static void no_gc_after_call_scm(gc_thread_data *thd, object _, int argc, object
/**
* Call into Scheme function
*/
-static void no_gc_call_scm(gc_thread_data *thd, object fnc, object obj)
+static void no_gc_call_scm(gc_thread_data * thd, object fnc, object obj)
{
- mclosure0(after, (function_type)no_gc_after_call_scm);
- object buf[2] = {&after, obj};
- ((closure)fnc)->fn(thd, fnc, 2, buf);
+ mclosure0(after, (function_type) no_gc_after_call_scm);
+ object buf[2] = { &after, obj };
+ ((closure) fnc)->fn(thd, fnc, 2, buf);
}
/**
@@ -134,12 +138,12 @@ static void no_gc_call_scm(gc_thread_data *thd, object fnc, object obj)
* or re-allocated (EG: malloc) before returning it
* to the C layer.
*/
-object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg)
+object Cyc_scm_call_no_gc(gc_thread_data * parent_thd, object fnc, object arg)
{
long stack_size = 100000;
char *stack_base = (char *)&stack_size;
char *stack_traces[MAX_STACK_TRACES];
- gc_thread_data thd = {0};
+ gc_thread_data thd = { 0 };
jmp_buf jmp;
thd.jmp_start = &jmp;
thd.stack_start = stack_base;
@@ -154,7 +158,7 @@ object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg)
thd.thread_state = CYC_THREAD_STATE_RUNNABLE;
// Copy parameter objects from the calling thread
- object parent = parent_thd->param_objs; // Unbox parent thread's data
+ object parent = parent_thd->param_objs; // Unbox parent thread's data
object child = NULL;
while (parent) {
if (thd.param_objs == NULL) {
@@ -184,5 +188,5 @@ object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg)
no_gc_call_scm(&thd, fnc, arg);
}
- return(thd.gc_cont);
+ return (thd.gc_cont);
}
diff --git a/gc.c b/gc.c
index 7bc21109..434c2bdb 100644
--- a/gc.c
+++ b/gc.c
@@ -48,9 +48,9 @@
// Note: will need to use atomics and/or locking to access any
// variables shared between threads
-static unsigned char gc_color_mark = 5; // Black, is swapped during GC
-static unsigned char gc_color_clear = 3; // White, is swapped during GC
-static unsigned char gc_color_purple = 1; // There are many "shades" of purple, this is the most recent one
+static unsigned char gc_color_mark = 5; // Black, is swapped during GC
+static unsigned char gc_color_clear = 3; // White, is swapped during GC
+static unsigned char gc_color_purple = 1; // There are many "shades" of purple, this is the most recent one
// unfortunately this had to be split up; const colors are located in types.h
static int gc_status_col = STATUS_SYNC1;
@@ -111,13 +111,13 @@ static mark_buffer *mark_buffer_init(unsigned initial_size)
return mb;
}
-static void *mark_buffer_get(mark_buffer *mb, unsigned i) // TODO: macro?
+static void *mark_buffer_get(mark_buffer * mb, unsigned i) // TODO: macro?
{
while (i >= mb->buf_len) {
// Not on this page, try the next one
i -= mb->buf_len;
mb = mb->next;
- if (mb == NULL) { // Safety check
+ if (mb == NULL) { // Safety check
// For now this is a fatal error, could return NULL instead
fprintf(stderr, "mark_buffer_get ran out of mark buffers, exiting\n");
exit(1);
@@ -126,13 +126,13 @@ static void *mark_buffer_get(mark_buffer *mb, unsigned i) // TODO: macro?
return mb->buf[i];
}
-static void mark_buffer_set(mark_buffer *mb, unsigned i, void *obj)
+static void mark_buffer_set(mark_buffer * mb, unsigned i, void *obj)
{
// Find index i
while (i >= mb->buf_len) {
// Not on this page, try the next one
i -= mb->buf_len;
- if (mb->next == NULL) {
+ if (mb->next == NULL) {
// If it does not exist, allocate a new buffer
mb->next = mark_buffer_init(mb->buf_len * 2);
}
@@ -141,7 +141,7 @@ static void mark_buffer_set(mark_buffer *mb, unsigned i, void *obj)
mb->buf[i] = obj;
}
-static void mark_buffer_free(mark_buffer *mb)
+static void mark_buffer_free(mark_buffer * mb)
{
mark_buffer *next;
while (mb) {
@@ -157,47 +157,51 @@ static void mark_buffer_free(mark_buffer *mb)
#if GC_DEBUG_TRACE
const int NUM_ALLOC_SIZES = 10;
static double allocated_size_counts[10] = {
- 0,0,0,0,0,
- 0,0,0,0,0};
+ 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0
+};
+
static double allocated_obj_counts[25] = {
- 0,0,0,0,0,
- 0,0,0,0,0,
- 0,0,0,0,0,
- 0,0,0,0,0,
- 0,0,0,0,0};
+ 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0
+};
+
// TODO: allocated object sizes (EG: 32, 64, etc).
-static double allocated_heap_counts[4] = {0, 0, 0, 0};
+static double allocated_heap_counts[4] = { 0, 0, 0, 0 };
void print_allocated_obj_counts()
{
int i;
fprintf(stderr, "Allocated sizes:\n");
fprintf(stderr, "Size, Allocations\n");
- for (i = 0; i < NUM_ALLOC_SIZES; i++){
- fprintf(stderr, "%d, %lf\n", 32 + (i*32), allocated_size_counts[i]);
+ for (i = 0; i < NUM_ALLOC_SIZES; i++) {
+ fprintf(stderr, "%d, %lf\n", 32 + (i * 32), allocated_size_counts[i]);
}
fprintf(stderr, "Allocated objects:\n");
fprintf(stderr, "Tag, Allocations\n");
- for (i = 0; i < 25; i++){
+ for (i = 0; i < 25; i++) {
fprintf(stderr, "%d, %lf\n", i, allocated_obj_counts[i]);
}
fprintf(stderr, "Allocated heaps:\n");
fprintf(stderr, "Heap, Allocations\n");
- for (i = 0; i < 4; i++){
+ for (i = 0; i < 4; i++) {
fprintf(stderr, "%d, %lf\n", i, allocated_heap_counts[i]);
}
}
-void gc_log(FILE *stream, const char *format, ...)
+void gc_log(FILE * stream, const char *format, ...)
{
va_list vargs;
time_t rawtime;
- struct tm * timeinfo;
- time ( &rawtime );
- timeinfo = localtime ( &rawtime );
+ struct tm *timeinfo;
+ time(&rawtime);
+ timeinfo = localtime(&rawtime);
- fprintf(stream, "%.2d:%.2d:%.2d - ",
- timeinfo->tm_hour, timeinfo->tm_min, timeinfo->tm_sec);
+ fprintf(stream, "%.2d:%.2d:%.2d - ",
+ timeinfo->tm_hour, timeinfo->tm_min, timeinfo->tm_sec);
va_start(vargs, format);
vfprintf(stream, format, vargs);
fprintf(stream, "\n");
@@ -271,7 +275,7 @@ void gc_add_mutator(gc_thread_data * thd)
// Main thread is always the first one added
if (primordial_thread == NULL) {
- primordial_thread = thd;
+ primordial_thread = thd;
} else {
// At this point the mutator is running, so remove it from the new list
pthread_mutex_lock(&mutators_lock);
@@ -310,7 +314,7 @@ void gc_remove_mutator(gc_thread_data * thd)
* @param thd Thread data object of the m
* @return A true value if the mutator is active, 0 otherwise.
*/
-int gc_is_mutator_active(gc_thread_data *thd)
+int gc_is_mutator_active(gc_thread_data * thd)
{
ck_array_iterator_t iterator;
gc_thread_data *m;
@@ -327,7 +331,7 @@ int gc_is_mutator_active(gc_thread_data *thd)
* @param thd Thread data object of the m
* @return A true value if the mutator is found, 0 otherwise.
*/
-int gc_is_mutator_new(gc_thread_data *thd)
+int gc_is_mutator_new(gc_thread_data * thd)
{
ck_array_iterator_t iterator;
gc_thread_data *m;
@@ -371,10 +375,11 @@ void gc_free_old_thread_data()
* @param gc_heap Root of the heap
* @return Free space in bytes
*/
-uint64_t gc_heap_free_size(gc_heap *h) {
+uint64_t gc_heap_free_size(gc_heap * h)
+{
uint64_t free_size = 0;
- for (; h; h = h->next){
- if (h->is_unswept == 1) { // Assume all free prior to sweep
+ for (; h; h = h->next) {
+ if (h->is_unswept == 1) { // Assume all free prior to sweep
free_size += h->size;
} else {
free_size += (h->free_size);
@@ -392,7 +397,7 @@ uint64_t gc_heap_free_size(gc_heap *h) {
* @return Pointer to the newly allocated heap page, or NULL
* if the allocation failed.
*/
-gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd)
+gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data * thd)
{
gc_free_list *free, *next;
gc_heap *h;
@@ -434,7 +439,7 @@ gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd)
//
h->remaining = size - (size % h->block_size);
h->data_end = h->data + h->remaining;
- h->free_list = NULL; // No free lists with bump&pop
+ h->free_list = NULL; // No free lists with bump&pop
// This is for starting with a free list, but we want bump&pop instead
// h->remaining = 0;
// h->data_end = NULL;
@@ -456,34 +461,34 @@ gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd)
* Assumes that there is no data currently on the heap page!
* @param h Heap page to initialize
*/
-void gc_init_fixed_size_free_list(gc_heap *h)
+void gc_init_fixed_size_free_list(gc_heap * h)
{
// for this flavor, just layer a free list on top of unitialized memory
gc_free_list *next;
//int i = 0;
- size_t remaining = h->size - (h->size % h->block_size) - h->block_size; // Starting at first one so skip it
- next = h->free_list = (gc_free_list *)h->data;
+ size_t remaining = h->size - (h->size % h->block_size) - h->block_size; // Starting at first one so skip it
+ next = h->free_list = (gc_free_list *) h->data;
//printf("data start = %p\n", h->data);
//printf("data end = %p\n", h->data + h->size);
while (remaining >= h->block_size) {
//printf("%d init remaining=%d next = %p\n", i++, remaining, next);
- next->next = (gc_free_list *)(((char *) next) + h->block_size);
+ next->next = (gc_free_list *) (((char *)next) + h->block_size);
next = next->next;
remaining -= h->block_size;
}
next->next = NULL;
- h->data_end = NULL; // Indicate we are using free lists
-}
+ h->data_end = NULL; // Indicate we are using free lists
+}
/**
* @brief Diagnostic function to print all free lists on a fixed-size heap page
* @param h Heap page to output
*/
-void gc_print_fixed_size_free_list(gc_heap *h)
+void gc_print_fixed_size_free_list(gc_heap * h)
{
gc_free_list *f = h->free_list;
fprintf(stderr, "printing free list:\n");
- while(f) {
+ while (f) {
fprintf(stderr, "%p\n", f);
f = f->next;
}
@@ -494,13 +499,15 @@ void gc_print_fixed_size_free_list(gc_heap *h)
* @brief Essentially this is half of the sweep code, for sweeping bump&pop
* @param h Heap page to convert
*/
-static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
+static size_t gc_convert_heap_page_to_free_list(gc_heap * h,
+ gc_thread_data * thd)
{
size_t freed = 0;
object p;
gc_free_list *next;
int remaining = h->size - (h->size % h->block_size);
- if (h->data_end == NULL) return 0; // Already converted
+ if (h->data_end == NULL)
+ return 0; // Already converted
next = h->free_list = NULL;
while (remaining > h->remaining) {
@@ -509,12 +516,11 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
int color = mark(p);
// printf("found object %d color %d at %p with remaining=%lu\n", tag, color, p, remaining);
// free space, add it to the free list
- if (color != thd->gc_alloc_color &&
- color != thd->gc_trace_color) { //gc_color_clear)
+ if (color != thd->gc_alloc_color && color != thd->gc_trace_color) { //gc_color_clear)
// Run any finalizers
if (type_of(p) == mutex_tag) {
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "pthread_mutex_destroy from sweep\n");
+ fprintf(stderr, "pthread_mutex_destroy from sweep\n");
#endif
if (pthread_mutex_destroy(&(((mutex) p)->lock)) != 0) {
fprintf(stderr, "Error destroying mutex\n");
@@ -522,7 +528,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
}
} else if (type_of(p) == cond_var_tag) {
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "pthread_cond_destroy from sweep\n");
+ fprintf(stderr, "pthread_cond_destroy from sweep\n");
#endif
if (pthread_cond_destroy(&(((cond_var) p)->cond)) != 0) {
fprintf(stderr, "Error destroying condition variable\n");
@@ -534,20 +540,19 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
#if GC_DEBUG_VERBOSE
fprintf(stderr, "mp_clear from sweep\n");
#endif
- mp_clear(&(((bignum_type *)p)->bn));
+ mp_clear(&(((bignum_type *) p)->bn));
} else if (type_of(p) == c_opaque_tag && opaque_collect_ptr(p)) {
#if GC_DEBUG_VERBOSE
fprintf(stderr, "free opaque pointer %p from sweep\n", opaque_ptr(p));
#endif
- free( opaque_ptr(p) );
+ free(opaque_ptr(p));
}
// Free block
freed += h->block_size;
if (next == NULL) {
next = h->free_list = p;
- }
- else {
+ } else {
next->next = p;
next = next->next;
}
@@ -562,9 +567,8 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
// printf("no object at %p fill with free list\n", p);
if (next == NULL) {
next = h->free_list = p;
- }
- else {
- next->next = p; //(gc_free_list *)(((char *) next) + h->block_size);
+ } else {
+ next->next = p; //(gc_free_list *)(((char *) next) + h->block_size);
next = next->next;
}
remaining -= h->block_size;
@@ -589,7 +593,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
* memory slots to the heap. It is only called by the collector thread after
* the heap has been traced to identify live objects.
*/
-static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
+static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data * thd)
{
short heap_is_empty;
object p, end;
@@ -611,19 +615,20 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
if (h->data_end != NULL) {
// Special case, bump&pop heap
gc_convert_heap_page_to_free_list(h, thd);
- heap_is_empty = 0; // For now, don't try to free bump&pop
+ heap_is_empty = 0; // For now, don't try to free bump&pop
} else {
//gc_free_list *next;
- size_t remaining = h->size - (h->size % h->block_size); // - h->block_size; // Remove first one??
+ size_t remaining = h->size - (h->size % h->block_size); // - h->block_size; // Remove first one??
char *data_end = h->data + remaining;
- heap_is_empty = 1; // Base case is an empty heap
- end = (object)data_end;
+ heap_is_empty = 1; // Base case is an empty heap
+ end = (object) data_end;
p = h->data;
q = h->free_list;
while (p < end) {
// find preceding/succeeding free list pointers for p
- for (r = (q?q->next:NULL); r && ((char *)r < (char *)p); q = r, r = r->next) ;
- if ((char *)q == (char *)p || (char *)r == (char *)p) { // this is a free block, skip it
+ for (r = (q ? q->next : NULL); r && ((char *)r < (char *)p);
+ q = r, r = r->next) ;
+ if ((char *)q == (char *)p || (char *)r == (char *)p) { // this is a free block, skip it
//printf("Sweep skip free block %p remaining=%lu\n", p, remaining);
p = (object) (((char *)p) + h->block_size);
continue;
@@ -638,8 +643,7 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
exit(1);
}
#endif
- if (mark(p) != thd->gc_alloc_color &&
- mark(p) != thd->gc_trace_color) { //gc_color_clear)
+ if (mark(p) != thd->gc_alloc_color && mark(p) != thd->gc_trace_color) { //gc_color_clear)
#if GC_DEBUG_VERBOSE
fprintf(stderr, "sweep is freeing unmarked obj: %p with tag %d\n", p,
type_of(p));
@@ -667,7 +671,7 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
#if GC_DEBUG_VERBOSE
fprintf(stderr, "mp_clear from sweep\n");
#endif
- mp_clear(&(((bignum_type *)p)->bn));
+ mp_clear(&(((bignum_type *) p)->bn));
}
// free p
@@ -682,12 +686,12 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
// note if this is the case, either there is no free_list (see above case) or
// the free list is after p, which is handled now. these are the only situations
// where there is no q
- s = (gc_free_list *)p;
+ s = (gc_free_list *) p;
s->next = h->free_list;
q = h->free_list = p;
//printf("sweep reclaimed remaining=%d, %p, assign h->free_list which was %p\n", remaining, p, h->free_list);
} else {
- s = (gc_free_list *)p;
+ s = (gc_free_list *) p;
s->next = r;
q->next = s;
//printf("sweep reclaimed remaining=%d, %p, q=%p, r=%p\n", remaining, p, q, r);
@@ -705,12 +709,12 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
// Free the heap page if possible.
if (heap_is_empty) {
if (h->type == HEAP_HUGE || (h->ttl--) <= 0) {
- rv = NULL; // Let caller know heap needs to be freed
+ rv = NULL; // Let caller know heap needs to be freed
} else {
// Convert back to bump&pop
h->remaining = h->size - (h->size % h->block_size);
h->data_end = h->data + h->remaining;
- h->free_list = NULL; // No free lists with bump&pop
+ h->free_list = NULL; // No free lists with bump&pop
}
} else {
//(thd->heap->heap[h->type])->num_unswept_children--;
@@ -731,14 +735,15 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
* @param prev_page Previous page in the heap
* @return Previous page if successful, NULL otherwise
*/
-gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
+gc_heap *gc_heap_free(gc_heap * page, gc_heap * prev_page)
{
// At least for now, do not free first page
if (prev_page == NULL || page == NULL) {
return NULL;
}
#if GC_DEBUG_TRACE
- fprintf(stderr, "DEBUG freeing heap type %d page at addr: %p\n", page->type, page);
+ fprintf(stderr, "DEBUG freeing heap type %d page at addr: %p\n", page->type,
+ page);
#endif
prev_page->next = page->next;
@@ -751,19 +756,22 @@ gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
* @param h Heap to inspect. The caller should acquire any necessary locks.
* @return A truthy value if the heap is empty, 0 otherwise.
*/
-static int gc_is_heap_empty(gc_heap *h)
+static int gc_is_heap_empty(gc_heap * h)
{
gc_free_list *f;
- if (!h) return 0;
+ if (!h)
+ return 0;
- if (h->data_end) { // Fixed-size bump&pop
+ if (h->data_end) { // Fixed-size bump&pop
return (h->remaining == (h->size - (h->size % h->block_size)));
}
- if (!h->free_list) return 0;
+ if (!h->free_list)
+ return 0;
f = h->free_list;
- if (f->size != 0 || !f->next) return 0;
+ if (f->size != 0 || !f->next)
+ return 0;
f = f->next;
return (f->size + gc_heap_align(gc_free_chunk_size)) == h->size;
@@ -792,13 +800,14 @@ void gc_print_stats(gc_heap * h)
if (f->size > free_max)
free_max = f->size;
}
- if (free == 0){ // No free chunks
+ if (free == 0) { // No free chunks
free_min = 0;
}
heap_is_empty = gc_is_heap_empty(h);
fprintf(stderr,
"Heap type=%d, page size=%u, is empty=%d, used=%u, free=%u, free chunks=%u, min=%u, max=%u\n",
- h->type, h->size, heap_is_empty, h->size - free, free, free_chunks, free_min, free_max);
+ h->type, h->size, heap_is_empty, h->size - free, free, free_chunks,
+ free_min, free_max);
}
}
@@ -814,9 +823,9 @@ void gc_print_stats(gc_heap * h)
*/
char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
{
- #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
allocated_obj_counts[type_of(obj)]++;
- #endif
+#endif
switch (type_of(obj)) {
case closureN_tag:{
@@ -827,7 +836,8 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
hp->num_args = ((closureN) obj)->num_args;
hp->num_elements = ((closureN) obj)->num_elements;
hp->elements = (object *) (((char *)hp) + sizeof(closureN_type));
- memcpy(hp->elements, ((closureN)obj)->elements, sizeof(object *) * hp->num_elements);
+ memcpy(hp->elements, ((closureN) obj)->elements,
+ sizeof(object *) * hp->num_elements);
return (char *)hp;
}
case pair_tag:{
@@ -866,7 +876,8 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
type_of(hp) = vector_tag;
hp->num_elements = ((vector) obj)->num_elements;
hp->elements = (object *) (((char *)hp) + sizeof(vector_type));
- memcpy(hp->elements, ((vector)obj)->elements, sizeof(object *) * hp->num_elements);
+ memcpy(hp->elements, ((vector) obj)->elements,
+ sizeof(object *) * hp->num_elements);
return (char *)hp;
}
case bytevector_tag:{
@@ -893,21 +904,21 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
hp->tok_end = ((port_type *) obj)->tok_end;
hp->tok_buf = ((port_type *) obj)->tok_buf;
hp->tok_buf_len = ((port_type *) obj)->tok_buf_len;
- hp->mem_buf = ((port_type *)obj)->mem_buf;
- hp->mem_buf_len = ((port_type *)obj)->mem_buf_len;
- hp->str_bv_in_mem_buf = ((port_type *)obj)->str_bv_in_mem_buf;
- hp->str_bv_in_mem_buf_len = ((port_type *)obj)->str_bv_in_mem_buf_len;
- hp->read_len = ((port_type *)obj)->read_len;
+ hp->mem_buf = ((port_type *) obj)->mem_buf;
+ hp->mem_buf_len = ((port_type *) obj)->mem_buf_len;
+ hp->str_bv_in_mem_buf = ((port_type *) obj)->str_bv_in_mem_buf;
+ hp->str_bv_in_mem_buf_len = ((port_type *) obj)->str_bv_in_mem_buf_len;
+ hp->read_len = ((port_type *) obj)->read_len;
return (char *)hp;
}
case bignum_tag:{
bignum_type *hp = dest;
mark(hp) = thd->gc_alloc_color;
type_of(hp) = bignum_tag;
- ((bignum_type *)hp)->bn.used = ((bignum_type *)obj)->bn.used;
- ((bignum_type *)hp)->bn.alloc = ((bignum_type *)obj)->bn.alloc;
- ((bignum_type *)hp)->bn.sign = ((bignum_type *)obj)->bn.sign;
- ((bignum_type *)hp)->bn.dp = ((bignum_type *)obj)->bn.dp;
+ ((bignum_type *) hp)->bn.used = ((bignum_type *) obj)->bn.used;
+ ((bignum_type *) hp)->bn.alloc = ((bignum_type *) obj)->bn.alloc;
+ ((bignum_type *) hp)->bn.sign = ((bignum_type *) obj)->bn.sign;
+ ((bignum_type *) hp)->bn.dp = ((bignum_type *) obj)->bn.dp;
return (char *)hp;
}
case cvar_tag:{
@@ -935,7 +946,7 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
atomic_type *hp = dest;
mark(hp) = thd->gc_alloc_color;
type_of(hp) = atomic_tag;
- hp->obj = ((atomic_type *)obj)->obj; // TODO: should access via CK atomic operations, though this may not be needed at all since we alloc directly on heap
+ hp->obj = ((atomic_type *) obj)->obj; // TODO: should access via CK atomic operations, though this may not be needed at all since we alloc directly on heap
return (char *)hp;
}
case macro_tag:{
@@ -1010,7 +1021,7 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
* increasing size using the Fibonnaci Sequence until reaching the
* max size.
*/
-gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
+gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data * thd)
{
size_t new_size;
gc_heap *h_last = h, *h_new;
@@ -1029,8 +1040,8 @@ gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
new_size = prev_size + h_last->size;
prev_size = h_last->size;
if (new_size > HEAP_SIZE) {
- new_size = HEAP_SIZE;
- break;
+ new_size = HEAP_SIZE;
+ break;
}
} else {
new_size = HEAP_SIZE;
@@ -1049,11 +1060,10 @@ gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
new_size = HEAP_SIZE;
}
#if GC_DEBUG_TRACE
- fprintf(stderr, "Growing heap %d new page size = %zu\n", h->type,
- new_size);
+ fprintf(stderr, "Growing heap %d new page size = %zu\n", h->type, new_size);
#endif
}
- h_last = gc_heap_last(h_last); // Ensure we don't unlink any heaps
+ h_last = gc_heap_last(h_last); // Ensure we don't unlink any heaps
// Done with computing new page size
h_new = gc_heap_create(h->type, new_size, thd);
h_last->next = h_new;
@@ -1074,30 +1084,29 @@ gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
* This function will fail if there is no space on the heap for the
* requested object.
*/
-void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
- gc_thread_data * thd)
+void *gc_try_alloc(gc_heap * h, size_t size, char *obj, gc_thread_data * thd)
{
gc_free_list *f1, *f2, *f3;
- for (f1 = h->free_list, f2 = f1->next; f2; f1 = f2, f2 = f2->next) { // all free in this heap
- if (f2->size >= size) { // Big enough for request
+ for (f1 = h->free_list, f2 = f1->next; f2; f1 = f2, f2 = f2->next) { // all free in this heap
+ if (f2->size >= size) { // Big enough for request
// TODO: take whole chunk or divide up f2 (using f3)?
if (f2->size >= (size + gc_heap_align(1) /* min obj size */ )) {
f3 = (gc_free_list *) (((char *)f2) + size);
f3->size = f2->size - size;
f3->next = f2->next;
f1->next = f3;
- } else { /* Take the whole chunk */
+ } else { /* Take the whole chunk */
f1->next = f2->next;
}
if (h->type != HEAP_HUGE) {
// Copy object into heap now to avoid any uninitialized memory issues
- #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
if (size < (32 * NUM_ALLOC_SIZES)) {
allocated_size_counts[(size / 32) - 1]++;
}
- #endif
+#endif
gc_copy_obj(f2, obj, thd);
// Done after sweep now instead of with each allocation
h->free_size -= size;
@@ -1115,12 +1124,12 @@ void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
* @param h Heap we are starting from (assume first in the chain)
* @return Count of heaps that have not been swept yet.
*/
-int gc_num_unswept_heaps(gc_heap *h)
+int gc_num_unswept_heaps(gc_heap * h)
{
int count = 0;
while (h) {
- if (h->is_unswept == 1 /*||
- gc_is_heap_empty(h)*/) {
+ if (h->is_unswept == 1 /*||
+ gc_is_heap_empty(h) */ ) {
count++;
}
h = h->next;
@@ -1128,7 +1137,8 @@ int gc_num_unswept_heaps(gc_heap *h)
return count;
}
-void gc_start_major_collection(gc_thread_data *thd){
+void gc_start_major_collection(gc_thread_data * thd)
+{
if (ck_pr_load_int(&gc_stage) == STAGE_RESTING) {
#if GC_DEBUG_TRACE
gc_log(stderr, "gc_start_major_collection - initiating collector");
@@ -1137,10 +1147,11 @@ void gc_start_major_collection(gc_thread_data *thd){
}
}
-void *gc_try_alloc_slow(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd)
+void *gc_try_alloc_slow(gc_heap * h_passed, gc_heap * h, size_t size, char *obj,
+ gc_thread_data * thd)
{
#ifdef CYC_HIGH_RES_TIMERS
-long long tstamp = hrt_get_current();
+ long long tstamp = hrt_get_current();
#endif
gc_heap *h_start = h, *h_prev;
void *result = NULL;
@@ -1159,8 +1170,8 @@ long long tstamp = hrt_get_current();
}
// check allocation status to make sure we can use it
if (h->is_full) {
- continue; // Cannot sweep until next GC cycle
- } else if (h->is_unswept == 1 && !gc_is_heap_empty(h)) { // TODO: empty function does not support fixed-size heaps yet
+ continue; // Cannot sweep until next GC cycle
+ } else if (h->is_unswept == 1 && !gc_is_heap_empty(h)) { // TODO: empty function does not support fixed-size heaps yet
unsigned int h_size = h->size;
//unsigned int prev_free_size = h->free_size;
//if (h->is_unswept == 1) {
@@ -1168,13 +1179,13 @@ long long tstamp = hrt_get_current();
//}
gc_heap *keep = gc_sweep(h, thd); // Clean up garbage objects
#ifdef CYC_HIGH_RES_TIMERS
-fprintf(stderr, "sweep heap %p \n", h);
-hrt_log_delta("gc sweep", tstamp);
+ fprintf(stderr, "sweep heap %p \n", h);
+ hrt_log_delta("gc sweep", tstamp);
#endif
h_passed->num_unswept_children--;
if (!keep) {
#if GC_DEBUG_TRACE
- fprintf(stderr, "heap %p marked for deletion\n", h);
+ fprintf(stderr, "heap %p marked for deletion\n", h);
#endif
// Heap marked for deletion, remove it and keep searching
gc_heap *freed = gc_heap_free(h, h_prev);
@@ -1197,7 +1208,7 @@ hrt_log_delta("gc sweep", tstamp);
// TODO: else, assign heap full? YES for fixed-size, for REST maybe not??
h->is_full = 1;
#if GC_DEBUG_TRACE
- fprintf(stderr, "heap %p is full\n", h);
+ fprintf(stderr, "heap %p is full\n", h);
#endif
}
}
@@ -1215,40 +1226,42 @@ hrt_log_delta("gc sweep", tstamp);
* This function will fail if there is no space on the heap for the
* requested object.
*/
-static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj, gc_thread_data * thd)
+static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj,
+ gc_thread_data * thd)
{
- void *result;
-
- if (h->free_list) {
- result = h->free_list;
- h->free_list = h->free_list->next;
- } else if (h->remaining) {
- h->remaining -= h->block_size;
- result = h->data_end - h->remaining - h->block_size;
- } else {
- // Cannot allocate on this page, skip it
- result = NULL;
- }
+ void *result;
- if (result) {
- // Copy object into heap now to avoid any uninitialized memory issues
- #if GC_DEBUG_TRACE
- if (size < (32 * NUM_ALLOC_SIZES)) {
- allocated_size_counts[(size / 32) - 1]++;
- }
- #endif
- gc_copy_obj(result, obj, thd);
+ if (h->free_list) {
+ result = h->free_list;
+ h->free_list = h->free_list->next;
+ } else if (h->remaining) {
+ h->remaining -= h->block_size;
+ result = h->data_end - h->remaining - h->block_size;
+ } else {
+ // Cannot allocate on this page, skip it
+ result = NULL;
+ }
- h->free_size -= size;
- return result;
+ if (result) {
+ // Copy object into heap now to avoid any uninitialized memory issues
+#if GC_DEBUG_TRACE
+ if (size < (32 * NUM_ALLOC_SIZES)) {
+ allocated_size_counts[(size / 32) - 1]++;
}
- return NULL;
+#endif
+ gc_copy_obj(result, obj, thd);
+
+ h->free_size -= size;
+ return result;
+ }
+ return NULL;
}
-void *gc_try_alloc_slow_fixed_size(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd)
+void *gc_try_alloc_slow_fixed_size(gc_heap * h_passed, gc_heap * h, size_t size,
+ char *obj, gc_thread_data * thd)
{
#ifdef CYC_HIGH_RES_TIMERS
-long long tstamp = hrt_get_current();
+ long long tstamp = hrt_get_current();
#endif
gc_heap *h_start = h, *h_prev;
void *result = NULL;
@@ -1267,18 +1280,18 @@ long long tstamp = hrt_get_current();
}
// check allocation status to make sure we can use it
if (h->is_full) {
- continue; // Cannot sweep until next GC cycle
+ continue; // Cannot sweep until next GC cycle
} else if (h->is_unswept == 1 && !gc_is_heap_empty(h)) {
unsigned int h_size = h->size;
- gc_heap *keep = gc_sweep_fixed_size(h, thd); // Clean up garbage objects
+ gc_heap *keep = gc_sweep_fixed_size(h, thd); // Clean up garbage objects
#ifdef CYC_HIGH_RES_TIMERS
-fprintf(stderr, "sweep fixed size heap %p size %lu \n", h, size);
-hrt_log_delta("gc sweep fixed size", tstamp);
+ fprintf(stderr, "sweep fixed size heap %p size %lu \n", h, size);
+ hrt_log_delta("gc sweep fixed size", tstamp);
#endif
h_passed->num_unswept_children--;
if (!keep) {
#if GC_DEBUG_TRACE
- fprintf(stderr, "heap %p marked for deletion\n", h);
+ fprintf(stderr, "heap %p marked for deletion\n", h);
#endif
// Heap marked for deletion, remove it and keep searching
gc_heap *freed = gc_heap_free(h, h_prev);
@@ -1301,7 +1314,7 @@ hrt_log_delta("gc sweep fixed size", tstamp);
// TODO: else, assign heap full? YES for fixed-size, for REST maybe not??
h->is_full = 1;
#if GC_DEBUG_TRACE
- fprintf(stderr, "heap %p is full\n", h);
+ fprintf(stderr, "heap %p is full\n", h);
#endif
}
}
@@ -1313,7 +1326,7 @@ hrt_log_delta("gc sweep fixed size", tstamp);
* @param data The mutator's thread data object
* @return Pointer to a heap object for the bignum
*/
-void *gc_alloc_bignum(gc_thread_data *data)
+void *gc_alloc_bignum(gc_thread_data * data)
{
int heap_grown, result;
bignum_type *bn;
@@ -1322,12 +1335,12 @@ void *gc_alloc_bignum(gc_thread_data *data)
//tmp.hdr.mark = gc_color_red;
//tmp.hdr.grayed = 0;
tmp.tag = bignum_tag;
- bn = gc_alloc(((gc_thread_data *)data)->heap, sizeof(bignum_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
+ bn = gc_alloc(((gc_thread_data *) data)->heap, sizeof(bignum_type),
+ (char *)(&tmp), (gc_thread_data *) data, &heap_grown);
if ((result = mp_init(&bignum_value(bn))) != MP_OKAY) {
- fprintf(stderr, "Error initializing number %s",
- mp_error_to_string(result));
- exit(1);
+ fprintf(stderr, "Error initializing number %s", mp_error_to_string(result));
+ exit(1);
}
return bn;
}
@@ -1338,13 +1351,13 @@ void *gc_alloc_bignum(gc_thread_data *data)
* @param src The bignum instance to copy to the heap
* @return Pointer to the heap object
*/
-void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src)
+void *gc_alloc_from_bignum(gc_thread_data * data, bignum_type * src)
{
int heap_grown;
- return gc_alloc(((gc_thread_data *)data)->heap, sizeof(bignum_type), (char *)(src), (gc_thread_data *)data, &heap_grown);
+ return gc_alloc(((gc_thread_data *) data)->heap, sizeof(bignum_type),
+ (char *)(src), (gc_thread_data *) data, &heap_grown);
}
-
/**
* @brief Allocate memory on the heap for an object
* @param hrt The root of the heap to allocate from
@@ -1365,7 +1378,8 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
gc_heap *h_passed, *h = NULL;
int heap_type;
void *(*try_alloc)(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
- void *(*try_alloc_slow)(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd);
+ void *(*try_alloc_slow)(gc_heap * h_passed, gc_heap * h, size_t size,
+ char *obj, gc_thread_data * thd);
size = gc_heap_align(size);
if (size <= (32 * (LAST_FIXED_SIZE_HEAP_TYPE + 1))) {
heap_type = (size - 1) / 32;
@@ -1399,12 +1413,13 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
h->is_full = 1;
result = try_alloc_slow(h_passed, h, size, obj, thd);
#if GC_DEBUG_VERBOSE
-fprintf(stderr, "slow alloc of %p\n", result);
+ fprintf(stderr, "slow alloc of %p\n", result);
#endif
if (result) {
// Check if we need to start a major collection
- if (heap_type != HEAP_HUGE &&
- (h_passed->num_unswept_children < GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
+ if (heap_type != HEAP_HUGE &&
+ (h_passed->num_unswept_children <
+ GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
gc_start_major_collection(thd);
}
} else {
@@ -1416,7 +1431,7 @@ fprintf(stderr, "slow alloc of %p\n", result);
*heap_grown = 1;
result = try_alloc_slow(h_passed, last, size, obj, thd);
#if GC_DEBUG_VERBOSE
-fprintf(stderr, "slowest alloc of %p\n", result);
+ fprintf(stderr, "slowest alloc of %p\n", result);
#endif
if (result) {
// We had to allocate memory, start a major collection ASAP!
@@ -1428,13 +1443,13 @@ fprintf(stderr, "slowest alloc of %p\n", result);
// Longer-term there may be a better way to deal with huge objects.
//
//if (heap_type != HEAP_HUGE) {
- gc_start_major_collection(thd);
+ gc_start_major_collection(thd);
//}
} else {
fprintf(stderr, "out of memory error allocating %zu bytes\n", size);
fprintf(stderr, "Heap type %d diagnostics:\n", heap_type);
gc_print_stats(h);
- exit(1); /* could throw error, but OOM is a major issue, so... */
+ exit(1); /* could throw error, but OOM is a major issue, so... */
}
}
}
@@ -1444,8 +1459,9 @@ fprintf(stderr, "slowest alloc of %p\n", result);
#endif
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "alloc %p size = %zu, obj=%p, tag=%d, mark=%d, thd->alloc=%d, thd->trace=%d\n", result,
- size, obj, type_of(obj), mark(((object) result)),
+ fprintf(stderr,
+ "alloc %p size = %zu, obj=%p, tag=%d, mark=%d, thd->alloc=%d, thd->trace=%d\n",
+ result, size, obj, type_of(obj), mark(((object) result)),
thd->gc_alloc_color, thd->gc_trace_color);
// Debug check, should no longer be necessary
//if (is_value_type(result)) {
@@ -1478,7 +1494,7 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r)
return gc_heap_align(sizeof(pair_type));
if (t == closureN_tag) {
return gc_heap_align(sizeof(closureN_type) +
- sizeof(object) *
+ sizeof(object) *
((closureN_type *) obj)->num_elements);
}
if (t == double_tag)
@@ -1566,7 +1582,7 @@ void gc_collector_sweep()
* memory slots to the heap. It is only called by the allocator to free up space
* after the heap has been traced to identify live objects.
*/
-gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
+gc_heap *gc_sweep(gc_heap * h, gc_thread_data * thd)
{
size_t freed, size;
object p, end;
@@ -1590,148 +1606,146 @@ gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
//for (; h; prev_h = h, h = h->next) // All heaps
#if GC_DEBUG_TRACE
- fprintf(stderr, "sweep heap %p, size = %zu\n", h, (size_t) h->size);
+ fprintf(stderr, "sweep heap %p, size = %zu\n", h, (size_t)h->size);
#endif
#if GC_DEBUG_VERBOSE
- {
- gc_free_list *tmp = h->free_list;
- while (tmp) {
- fprintf(stderr, "free list %p\n", tmp);
- tmp = tmp->next;
- }
+ {
+ gc_free_list *tmp = h->free_list;
+ while (tmp) {
+ fprintf(stderr, "free list %p\n", tmp);
+ tmp = tmp->next;
}
+ }
#endif
- p = gc_heap_first_block(h);
- q = h->free_list;
- end = gc_heap_end(h);
- while (p < end) {
- // find preceding/succeeding free list pointers for p
- for (r = q->next; r && ((char *)r < (char *)p); q = r, r = r->next) ;
+ p = gc_heap_first_block(h);
+ q = h->free_list;
+ end = gc_heap_end(h);
+ while (p < end) {
+ // find preceding/succeeding free list pointers for p
+ for (r = q->next; r && ((char *)r < (char *)p); q = r, r = r->next) ;
- if ((char *)r == (char *)p) { // this is a free block, skip it
- p = (object) (((char *)p) + r->size);
- //h->free_size += r->size;
+ if ((char *)r == (char *)p) { // this is a free block, skip it
+ p = (object) (((char *)p) + r->size);
+ //h->free_size += r->size;
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "skip free block %p size = %zu\n", p, r->size);
+ fprintf(stderr, "skip free block %p size = %zu\n", p, r->size);
#endif
- continue;
- }
- size = gc_allocated_bytes(p, q, r);
+ continue;
+ }
+ size = gc_allocated_bytes(p, q, r);
#if GC_SAFETY_CHECKS
- if (!is_object_type(p)) {
- fprintf(stderr, "sweep: invalid object at %p", p);
- exit(1);
- }
- if ((char *)q + q->size > (char *)p) {
- fprintf(stderr, "bad size at %p < %p + %u", p, q, q->size);
- exit(1);
- }
- if (r && ((char *)p) + size > (char *)r) {
- fprintf(stderr, "sweep: bad size at %p + %zu > %p", p, size, r);
- exit(1);
- }
+ if (!is_object_type(p)) {
+ fprintf(stderr, "sweep: invalid object at %p", p);
+ exit(1);
+ }
+ if ((char *)q + q->size > (char *)p) {
+ fprintf(stderr, "bad size at %p < %p + %u", p, q, q->size);
+ exit(1);
+ }
+ if (r && ((char *)p) + size > (char *)r) {
+ fprintf(stderr, "sweep: bad size at %p + %zu > %p", p, size, r);
+ exit(1);
+ }
#endif
- // Use the object's mark to determine if we keep it.
- // Need to check for both colors because:
- // - Objects that are either newly-allocated or recently traced are given
- // the alloc color, and we need to keep them.
- // - If the collector is currently tracing, objects not traced yet will
- // have the trace/clear color. We need to keep any of those to make sure
- // the collector has a chance to trace the entire heap.
- if (//mark(p) != markColor &&
- mark(p) != thd->gc_alloc_color &&
- mark(p) != thd->gc_trace_color) { //gc_color_clear)
+ // Use the object's mark to determine if we keep it.
+ // Need to check for both colors because:
+ // - Objects that are either newly-allocated or recently traced are given
+ // the alloc color, and we need to keep them.
+ // - If the collector is currently tracing, objects not traced yet will
+ // have the trace/clear color. We need to keep any of those to make sure
+ // the collector has a chance to trace the entire heap.
+ if ( //mark(p) != markColor &&
+ mark(p) != thd->gc_alloc_color && mark(p) != thd->gc_trace_color) { //gc_color_clear)
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "sweep is freeing unmarked obj: %p with tag %d mark %d - alloc color %d trace color %d\n", p,
- type_of(p),
- mark(p),
- thd->gc_alloc_color, thd->gc_trace_color);
+ fprintf(stderr,
+ "sweep is freeing unmarked obj: %p with tag %d mark %d - alloc color %d trace color %d\n",
+ p, type_of(p), mark(p), thd->gc_alloc_color, thd->gc_trace_color);
#endif
- //mark(p) = gc_color_blue; // Needed?
- if (type_of(p) == mutex_tag) {
+ //mark(p) = gc_color_blue; // Needed?
+ if (type_of(p) == mutex_tag) {
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "pthread_mutex_destroy from sweep\n");
+ fprintf(stderr, "pthread_mutex_destroy from sweep\n");
#endif
- if (pthread_mutex_destroy(&(((mutex) p)->lock)) != 0) {
- fprintf(stderr, "Error destroying mutex\n");
- exit(1);
- }
- } else if (type_of(p) == cond_var_tag) {
+ if (pthread_mutex_destroy(&(((mutex) p)->lock)) != 0) {
+ fprintf(stderr, "Error destroying mutex\n");
+ exit(1);
+ }
+ } else if (type_of(p) == cond_var_tag) {
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "pthread_cond_destroy from sweep\n");
+ fprintf(stderr, "pthread_cond_destroy from sweep\n");
#endif
- if (pthread_cond_destroy(&(((cond_var) p)->cond)) != 0) {
- fprintf(stderr, "Error destroying condition variable\n");
- exit(1);
- }
- } else if (type_of(p) == bignum_tag) {
- // TODO: this is no good if we abandon bignum's on the stack
- // in that case the finalizer is never called
+ if (pthread_cond_destroy(&(((cond_var) p)->cond)) != 0) {
+ fprintf(stderr, "Error destroying condition variable\n");
+ exit(1);
+ }
+ } else if (type_of(p) == bignum_tag) {
+ // TODO: this is no good if we abandon bignum's on the stack
+ // in that case the finalizer is never called
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "mp_clear from sweep\n");
+ fprintf(stderr, "mp_clear from sweep\n");
#endif
- mp_clear(&(((bignum_type *)p)->bn));
- }
- // free p
- if (((((char *)q) + q->size) == (char *)p) && (q != h->free_list)) {
- /* merge q with p */
- if (r && r->size && ((((char *)p) + size) == (char *)r)) {
- // ... and with r
- q->next = r->next;
- freed = q->size + size + r->size;
- p = (object) (((char *)p) + size + r->size);
- } else {
- freed = q->size + size;
- p = (object) (((char *)p) + size);
- }
- q->size = freed;
+ mp_clear(&(((bignum_type *) p)->bn));
+ }
+ // free p
+ if (((((char *)q) + q->size) == (char *)p) && (q != h->free_list)) {
+ /* merge q with p */
+ if (r && r->size && ((((char *)p) + size) == (char *)r)) {
+ // ... and with r
+ q->next = r->next;
+ freed = q->size + size + r->size;
+ p = (object) (((char *)p) + size + r->size);
} else {
- s = (gc_free_list *) p;
- if (r && r->size && ((((char *)p) + size) == (char *)r)) {
- // merge p with r
- s->size = size + r->size;
- s->next = r->next;
- q->next = s;
- freed = size + r->size;
- } else {
- s->size = size;
- s->next = r;
- q->next = s;
- freed = size;
- }
- p = (object) (((char *)p) + freed);
+ freed = q->size + size;
+ p = (object) (((char *)p) + size);
}
- h->free_size += size;
+ q->size = freed;
} else {
+ s = (gc_free_list *) p;
+ if (r && r->size && ((((char *)p) + size) == (char *)r)) {
+ // merge p with r
+ s->size = size + r->size;
+ s->next = r->next;
+ q->next = s;
+ freed = size + r->size;
+ } else {
+ s->size = size;
+ s->next = r;
+ q->next = s;
+ freed = size;
+ }
+ p = (object) (((char *)p) + freed);
+ }
+ h->free_size += size;
+ } else {
//#if GC_DEBUG_VERBOSE
// fprintf(stderr, "sweep: object is marked %p\n", p);
//#endif
- p = (object) (((char *)p) + size);
- }
+ p = (object) (((char *)p) + size);
}
- // Free the heap page if possible.
- //
- // With huge heaps, this becomes more important. one of the huge
- // pages only has one object, so it is likely that the page
- // will become free at some point and could be reclaimed.
- //
- // The newly created flag is used to attempt to avoid situtaions
- // where a page is allocated because there is not enough free space,
- // but then we do a sweep and see it is empty so we free it, and
- // so forth. A better solution might be to keep empty heap pages
- // off to the side and only free them if there is enough free space
- // remaining without them.
- //
- // Experimenting with only freeing huge heaps
- if (gc_is_heap_empty(h)) {
- if (h->type == HEAP_HUGE || (h->ttl--) <= 0) {
- rv = NULL; // Let caller know heap needs to be freed
- }
- } else {
- //(thd->heap->heap[h->type])->num_unswept_children--;
+ }
+ // Free the heap page if possible.
+ //
+ // With huge heaps, this becomes more important. one of the huge
+ // pages only has one object, so it is likely that the page
+ // will become free at some point and could be reclaimed.
+ //
+ // The newly created flag is used to attempt to avoid situtaions
+ // where a page is allocated because there is not enough free space,
+ // but then we do a sweep and see it is empty so we free it, and
+ // so forth. A better solution might be to keep empty heap pages
+ // off to the side and only free them if there is enough free space
+ // remaining without them.
+ //
+ // Experimenting with only freeing huge heaps
+ if (gc_is_heap_empty(h)) {
+ if (h->type == HEAP_HUGE || (h->ttl--) <= 0) {
+ rv = NULL; // Let caller know heap needs to be freed
}
+ } else {
+ //(thd->heap->heap[h->type])->num_unswept_children--;
+ }
#if GC_DEBUG_SHOW_SWEEP_DIAG
fprintf(stderr, "\nAfter sweep -------------------------\n");
@@ -1841,9 +1855,13 @@ static void mark_stack_or_heap_obj(gc_thread_data * thd, object obj, int locked)
grayed(obj) = 1;
} else {
// Value is on the heap, mark gray right now
- if (!locked) { pthread_mutex_lock(&(thd->lock)); }
+ if (!locked) {
+ pthread_mutex_lock(&(thd->lock));
+ }
gc_mark_gray(thd, obj);
- if (!locked) { pthread_mutex_unlock(&(thd->lock)); }
+ if (!locked) {
+ pthread_mutex_unlock(&(thd->lock));
+ }
}
}
@@ -1858,8 +1876,8 @@ static void mark_stack_or_heap_obj(gc_thread_data * thd, object obj, int locked)
*/
void gc_mut_update(gc_thread_data * thd, object old_obj, object value)
{
- int //status = ck_pr_load_int(&gc_status_col),
- stage = ck_pr_load_int(&gc_stage);
+ int //status = ck_pr_load_int(&gc_status_col),
+ stage = ck_pr_load_int(&gc_stage);
if (ck_pr_load_int(&(thd->gc_status)) != STATUS_ASYNC) {
pthread_mutex_lock(&(thd->lock));
mark_stack_or_heap_obj(thd, old_obj, 1);
@@ -1957,11 +1975,11 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
#endif
// If we have finished tracing, clear any "full" bits on the heap
- if(ck_pr_cas_8(&(thd->gc_done_tracing), 1, 0)) {
+ if (ck_pr_cas_8(&(thd->gc_done_tracing), 1, 0)) {
int heap_type, unswept;
gc_heap *h_tmp, *h_head;
#if GC_DEBUG_VERBOSE
-fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
+ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
#endif
for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
h_head = h_tmp = thd->heap->heap[heap_type];
@@ -2006,23 +2024,27 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
}
thd->num_minor_gcs++;
- if (thd->num_minor_gcs % 10 == 9) { // Throttle a bit since usually we do not need major GC
+ if (thd->num_minor_gcs % 10 == 9) { // Throttle a bit since usually we do not need major GC
int heap_type, over_gc_collection_threshold = 0;
for (heap_type = 0; heap_type < HEAP_HUGE; heap_type++) {
- thd->cached_heap_free_sizes[heap_type] = gc_heap_free_size(thd->heap->heap[heap_type]);
- if (thd->cached_heap_free_sizes[heap_type] <
+ thd->cached_heap_free_sizes[heap_type] =
+ gc_heap_free_size(thd->heap->heap[heap_type]);
+ if (thd->cached_heap_free_sizes[heap_type] <
thd->cached_heap_total_sizes[heap_type] * GC_COLLECTION_THRESHOLD) {
over_gc_collection_threshold = 1;
}
#if GC_DEBUG_VERBOSE
- fprintf(stderr, "heap %d free %zu total %zu\n",
- heap_type,
- thd->cached_heap_free_sizes[heap_type],
- thd->cached_heap_total_sizes[heap_type]);
- if (thd->cached_heap_free_sizes[heap_type] > thd->cached_heap_total_sizes[heap_type]) {
- fprintf(stderr, "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n",
- thd->cached_heap_free_sizes[heap_type], thd->cached_heap_total_sizes[heap_type]);
+ fprintf(stderr, "heap %d free %zu total %zu\n",
+ heap_type,
+ thd->cached_heap_free_sizes[heap_type],
+ thd->cached_heap_total_sizes[heap_type]);
+ if (thd->cached_heap_free_sizes[heap_type] >
+ thd->cached_heap_total_sizes[heap_type]) {
+ fprintf(stderr,
+ "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n",
+ thd->cached_heap_free_sizes[heap_type],
+ thd->cached_heap_total_sizes[heap_type]);
exit(1);
}
#endif
@@ -2035,12 +2057,12 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
(over_gc_collection_threshold ||
// Separate huge heap threshold since these are typically allocated as whole pages
(thd->heap_num_huge_allocations > 100)
- )) {
- #if GC_DEBUG_TRACE
+ )) {
+#if GC_DEBUG_TRACE
fprintf(stderr,
"Less than %f%% of the heap is free, initiating collector\n",
100.0 * GC_COLLECTION_THRESHOLD);
- #endif
+#endif
ck_pr_cas_int(&gc_stage, STAGE_RESTING, STAGE_CLEAR_OR_MARKING);
}
}
@@ -2069,8 +2091,7 @@ void gc_mark_gray(gc_thread_data * thd, object obj)
// timing issues when incrementing colors and since if we ever reach a
// purple object during tracing we would want to mark it.
// TODO: revisit if checking for gc_color_purple is truly necessary here and elsewhere.
- if (is_object_type(obj) && (mark(obj) == gc_color_clear ||
- mark(obj) == gc_color_purple)) { // TODO: sync??
+ if (is_object_type(obj) && (mark(obj) == gc_color_clear || mark(obj) == gc_color_purple)) { // TODO: sync??
// Place marked object in a buffer to avoid repeated scans of the heap.
// TODO:
// Note that ideally this should be a lock-free data structure to make the
@@ -2096,7 +2117,8 @@ void gc_mark_gray2(gc_thread_data * thd, object obj)
{
if (is_object_type(obj) && (mark(obj) == gc_color_clear ||
mark(obj) == gc_color_purple)) {
- mark_buffer_set(thd->mark_buffer, thd->last_write + thd->pending_writes, obj);
+ mark_buffer_set(thd->mark_buffer, thd->last_write + thd->pending_writes,
+ obj);
thd->pending_writes++;
}
}
@@ -2119,8 +2141,9 @@ static void gc_collector_mark_gray(object parent, object obj)
fprintf(stderr, "mark gray parent = %p (%d) obj = %p\n", parent,
type_of(parent), obj);
} else if (is_object_type(obj)) {
- fprintf(stderr, "not marking gray, parent = %p (%d) obj = %p mark(obj) = %d, gc_color_clear = %d\n", parent,
- type_of(parent), obj, mark(obj), gc_color_clear);
+ fprintf(stderr,
+ "not marking gray, parent = %p (%d) obj = %p mark(obj) = %d, gc_color_clear = %d\n",
+ parent, type_of(parent), obj, mark(obj), gc_color_clear);
}
}
#else
@@ -2175,8 +2198,8 @@ void gc_mark_black(object obj)
}
break;
}
- case atomic_tag: {
- atomic_type *a = (atomic_type *)obj;
+ case atomic_tag:{
+ atomic_type *a = (atomic_type *) obj;
object o = ck_pr_load_ptr(&(a->obj));
if (obj) {
gc_collector_mark_gray(obj, o);
@@ -2277,13 +2300,14 @@ void gc_collector_trace()
// went with the version of last write we are holding here... so
// we avoid that race condition.
last_write = m->last_write;
- pthread_mutex_unlock(&(m->lock));
+ pthread_mutex_unlock(&(m->lock));
while (m->last_read < last_write) {
clean = 0;
#if GC_DEBUG_VERBOSE
fprintf(stderr,
"gc_mark_black mark buffer %p, last_read = %d last_write = %d\n",
- mark_buffer_get(m->mark_buffer, m->last_read), m->last_read, last_write);
+ mark_buffer_get(m->mark_buffer, m->last_read), m->last_read,
+ last_write);
#endif
gc_mark_black(mark_buffer_get(m->mark_buffer, m->last_read));
gc_empty_collector_stack();
@@ -2403,9 +2427,10 @@ void gc_wait_handshake()
) {
//printf("DEBUG - update mutator GC status\n");
ck_pr_cas_int(&(m->gc_status), statusm, statusc);
- #if GC_DEBUG_TRACE
- fprintf(stderr, "DEBUG - collector is cooperating for blocked mutator\n");
- #endif
+#if GC_DEBUG_TRACE
+ fprintf(stderr,
+ "DEBUG - collector is cooperating for blocked mutator\n");
+#endif
buf_len =
gc_minor(m, m->stack_limit, m->stack_start, m->gc_cont, NULL,
0);
@@ -2490,7 +2515,7 @@ void gc_collector()
fprintf(stderr, "DEBUG - after post_handshake async\n");
#endif
gc_wait_handshake();
- gc_request_mark_globals(); // Wait until mutators have new mark color
+ gc_request_mark_globals(); // Wait until mutators have new mark color
#if GC_DEBUG_TRACE
fprintf(stderr, "DEBUG - after wait_handshake async\n");
#endif
@@ -2551,8 +2576,7 @@ static pthread_t collector_thread;
*/
void gc_start_collector()
{
- if (pthread_create
- (&collector_thread, NULL, collector_main, NULL)) {
+ if (pthread_create(&collector_thread, NULL, collector_main, NULL)) {
fprintf(stderr, "Error creating collector thread\n");
exit(1);
}
@@ -2572,7 +2596,7 @@ void gc_mark_globals(object globals, object global_table)
fprintf(stderr, "Cyc_global_variables %p\n", globals);
#endif
// Mark global variables
- gc_mark_black(globals); // Internal global used by the runtime
+ gc_mark_black(globals); // Internal global used by the runtime
// Marking it ensures all glos are marked
{
list l = global_table;
@@ -2589,7 +2613,6 @@ void gc_mark_globals(object globals, object global_table)
}
}
-
/////////////////////////////////////////////
// END tri-color marking section
/////////////////////////////////////////////
@@ -2626,8 +2649,7 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
thd->mutations = NULL;
thd->mutation_buflen = 128;
thd->mutation_count = 0;
- thd->mutations =
- vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
+ thd->mutations = vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
thd->globals_changed = 1;
thd->param_objs = NULL;
thd->exception_handler_stack = NULL;
@@ -2717,7 +2739,7 @@ void gc_thread_data_free(gc_thread_data * thd)
*
* This function assumes appropriate locks are already held.
*/
-void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
+void gc_heap_merge(gc_heap * hdest, gc_heap * hsrc)
{
gc_heap *last = gc_heap_last(hdest);
last->next = hsrc;
@@ -2730,7 +2752,7 @@ void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
*
* Assumes appropriate locks are already held.
*/
-void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
+void gc_merge_all_heaps(gc_thread_data * dest, gc_thread_data * src)
{
gc_heap *hdest, *hsrc;
int heap_type;
@@ -2740,14 +2762,14 @@ void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
hsrc = src->heap->heap[heap_type];
if (hdest && hsrc) {
gc_heap_merge(hdest, hsrc);
- ck_pr_add_ptr(&(dest->cached_heap_total_sizes[heap_type]),
- ck_pr_load_ptr(&(src->cached_heap_total_sizes[heap_type])));
- ck_pr_add_ptr(&(dest->cached_heap_free_sizes[heap_type]),
- ck_pr_load_ptr(&(src->cached_heap_free_sizes[heap_type])));
+ ck_pr_add_ptr(&(dest->cached_heap_total_sizes[heap_type]),
+ ck_pr_load_ptr(&(src->cached_heap_total_sizes[heap_type])));
+ ck_pr_add_ptr(&(dest->cached_heap_free_sizes[heap_type]),
+ ck_pr_load_ptr(&(src->cached_heap_free_sizes[heap_type])));
}
}
- ck_pr_add_int(&(dest->heap_num_huge_allocations),
- ck_pr_load_int(&(src->heap_num_huge_allocations)));
+ ck_pr_add_int(&(dest->heap_num_huge_allocations),
+ ck_pr_load_int(&(src->heap_num_huge_allocations)));
#if GC_DEBUG_TRACE
fprintf(stderr, "Finished merging old heap data\n");
#endif
@@ -2783,17 +2805,17 @@ void Cyc_apply_from_buf(void *data, int argc, object prim, object * buf);
* @param obj Object to copy
* @param thd Thread data object for the applicable mutator
*/
-void gc_recopy_obj(object obj, gc_thread_data *thd)
+void gc_recopy_obj(object obj, gc_thread_data * thd)
{
// Temporarily change obj type so we can copy it
object fwd = forward(obj);
tag_type tag = type_of(fwd);
type_of(obj) = tag;
- #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
fprintf(stderr, "\n!!! Recopying object %p with tag %d !!!\n\n", obj, tag);
- #endif
- gc_copy_obj(fwd, obj, thd); // Copy it again
- type_of(obj) = forward_tag; // Restore forwarding pointer tag on stack obj
+#endif
+ gc_copy_obj(fwd, obj, thd); // Copy it again
+ type_of(obj) = forward_tag; // Restore forwarding pointer tag on stack obj
}
/**
@@ -2808,7 +2830,8 @@ void gc_recopy_obj(object obj, gc_thread_data *thd)
* it was blocking, the mutator will move any remaining stack objects to
* the heap and longjmp.
*/
-void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied)
+void gc_mutator_thread_runnable(gc_thread_data * thd, object result,
+ object maybe_copied)
{
char stack_limit;
// Transition from blocked back to runnable using CAS.
@@ -2829,8 +2852,8 @@ void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object mayb
thd->gc_args[0] = result;
thd->gc_num_args = 1;
// Check if obj was copied while we slept
- if (maybe_copied &&
- is_object_type(maybe_copied) &&
+ if (maybe_copied &&
+ is_object_type(maybe_copied) &&
gc_is_stack_obj(&stack_limit, thd, maybe_copied) &&
type_of(maybe_copied) == forward_tag) {
gc_recopy_obj(maybe_copied, thd);
@@ -2849,7 +2872,7 @@ void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object mayb
thd->gc_args[0] = result;
Cyc_apply_from_buf(thd, 2, thd->gc_cont, thd->gc_args);
} else {
- object buf[1] = {result};
+ object buf[1] = { result };
(((closure) (thd->gc_cont))->fn) (thd, thd->gc_cont, 1, buf);
}
}
diff --git a/hashset.c b/hashset.c
index dedecfd6..2650baf7 100644
--- a/hashset.c
+++ b/hashset.c
@@ -23,125 +23,124 @@ static const unsigned int prime_2 = 5009;
hashset_t hashset_create()
{
- hashset_t set = calloc(1, sizeof(struct hashset_st));
+ hashset_t set = calloc(1, sizeof(struct hashset_st));
- if (set == NULL) {
- return NULL;
- }
- set->nbits = 3;
- set->capacity = (size_t)(1 << set->nbits);
- set->mask = set->capacity - 1;
- set->items = calloc(set->capacity, sizeof(size_t));
- if (set->items == NULL) {
- hashset_destroy(set);
- return NULL;
- }
- set->nitems = 0;
- set->n_deleted_items = 0;
- return set;
+ if (set == NULL) {
+ return NULL;
+ }
+ set->nbits = 3;
+ set->capacity = (size_t)(1 << set->nbits);
+ set->mask = set->capacity - 1;
+ set->items = calloc(set->capacity, sizeof(size_t));
+ if (set->items == NULL) {
+ hashset_destroy(set);
+ return NULL;
+ }
+ set->nitems = 0;
+ set->n_deleted_items = 0;
+ return set;
}
size_t hashset_num_items(hashset_t set)
{
- return set->nitems;
+ return set->nitems;
}
void hashset_destroy(hashset_t set)
{
- if (set) {
- free(set->items);
- }
- free(set);
+ if (set) {
+ free(set->items);
+ }
+ free(set);
}
static int hashset_add_member(hashset_t set, void *item)
{
- size_t value = (size_t)item;
- size_t ii;
+ size_t value = (size_t)item;
+ size_t ii;
- if (value == 0 || value == 1) {
- return -1;
- }
+ if (value == 0 || value == 1) {
+ return -1;
+ }
- ii = set->mask & (prime_1 * value);
+ ii = set->mask & (prime_1 * value);
- while (set->items[ii] != 0 && set->items[ii] != 1) {
- if (set->items[ii] == value) {
- return 0;
- } else {
- /* search free slot */
- ii = set->mask & (ii + prime_2);
- }
+ while (set->items[ii] != 0 && set->items[ii] != 1) {
+ if (set->items[ii] == value) {
+ return 0;
+ } else {
+ /* search free slot */
+ ii = set->mask & (ii + prime_2);
}
- set->nitems++;
- if (set->items[ii] == 1) {
- set->n_deleted_items--;
- }
- set->items[ii] = value;
- return 1;
+ }
+ set->nitems++;
+ if (set->items[ii] == 1) {
+ set->n_deleted_items--;
+ }
+ set->items[ii] = value;
+ return 1;
}
static void maybe_rehash(hashset_t set)
{
- size_t *old_items;
- size_t old_capacity, ii;
-
-
- if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
- old_items = set->items;
- old_capacity = set->capacity;
- set->nbits++;
- set->capacity = (size_t)(1 << set->nbits);
- set->mask = set->capacity - 1;
- set->items = calloc(set->capacity, sizeof(size_t));
- set->nitems = 0;
- set->n_deleted_items = 0;
- assert(set->items);
- for (ii = 0; ii < old_capacity; ii++) {
- hashset_add_member(set, (void *)old_items[ii]);
- }
- free(old_items);
+ size_t *old_items;
+ size_t old_capacity, ii;
+
+ if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
+ old_items = set->items;
+ old_capacity = set->capacity;
+ set->nbits++;
+ set->capacity = (size_t)(1 << set->nbits);
+ set->mask = set->capacity - 1;
+ set->items = calloc(set->capacity, sizeof(size_t));
+ set->nitems = 0;
+ set->n_deleted_items = 0;
+ assert(set->items);
+ for (ii = 0; ii < old_capacity; ii++) {
+ hashset_add_member(set, (void *)old_items[ii]);
}
+ free(old_items);
+ }
}
int hashset_add(hashset_t set, void *item)
{
- int rv = hashset_add_member(set, item);
- maybe_rehash(set);
- return rv;
+ int rv = hashset_add_member(set, item);
+ maybe_rehash(set);
+ return rv;
}
int hashset_remove(hashset_t set, void *item)
{
- size_t value = (size_t)item;
- size_t ii = set->mask & (prime_1 * value);
-
- while (set->items[ii] != 0) {
- if (set->items[ii] == value) {
- set->items[ii] = 1;
- set->nitems--;
- set->n_deleted_items++;
- return 1;
- } else {
- ii = set->mask & (ii + prime_2);
- }
+ size_t value = (size_t)item;
+ size_t ii = set->mask & (prime_1 * value);
+
+ while (set->items[ii] != 0) {
+ if (set->items[ii] == value) {
+ set->items[ii] = 1;
+ set->nitems--;
+ set->n_deleted_items++;
+ return 1;
+ } else {
+ ii = set->mask & (ii + prime_2);
}
- return 0;
+ }
+ return 0;
}
int hashset_is_member(hashset_t set, void *item)
{
- size_t value = (size_t)item;
- size_t ii = set->mask & (prime_1 * value);
-
- while (set->items[ii] != 0) {
- if (set->items[ii] == value) {
- return 1;
- } else {
- ii = set->mask & (ii + prime_2);
- }
+ size_t value = (size_t)item;
+ size_t ii = set->mask & (prime_1 * value);
+
+ while (set->items[ii] != 0) {
+ if (set->items[ii] == value) {
+ return 1;
+ } else {
+ ii = set->mask & (ii + prime_2);
}
- return 0;
+ }
+ return 0;
}
void hashset_to_array(hashset_t set, void **items)
@@ -154,4 +153,3 @@ void hashset_to_array(hashset_t set, void **items)
}
}
}
-
diff --git a/include/cyclone/bignum.h b/include/cyclone/bignum.h
index e87bb086..4f29952d 100644
--- a/include/cyclone/bignum.h
+++ b/include/cyclone/bignum.h
@@ -9,20 +9,20 @@
#include <limits.h>
#ifdef LTM_NO_FILE
-# warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
-# define MP_NO_FILE
+#warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
+#define MP_NO_FILE
#endif
#ifndef MP_NO_FILE
-# include <stdio.h>
+#include <stdio.h>
#endif
#ifdef MP_8BIT
-# ifdef _MSC_VER
-# pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.")
-# else
-# warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version."
-# endif
+#ifdef _MSC_VER
+#pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.")
+#else
+#warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version."
+#endif
#endif
#ifdef __cplusplus
@@ -31,7 +31,7 @@ extern "C" {
/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
#if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_64BIT)
-# define MP_32BIT
+#define MP_32BIT
#endif
/* detect 64-bit mode if possible */
@@ -41,19 +41,19 @@ extern "C" {
defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \
defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \
defined(__LP64__) || defined(_LP64) || defined(__64BIT__)
-# if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
-# if defined(__GNUC__) && !defined(__hppa)
+#if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
+#if defined(__GNUC__) && !defined(__hppa)
/* we support 128bit integers only via: __attribute__((mode(TI))) */
-# define MP_64BIT
-# else
+#define MP_64BIT
+#else
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
-# define MP_32BIT
-# endif
-# endif
+#define MP_32BIT
+#endif
+#endif
#endif
#ifdef MP_DIGIT_BIT
-# error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT
+#error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT
#endif
/* some default configurations.
@@ -66,36 +66,36 @@ extern "C" {
*/
#ifdef MP_8BIT
-typedef uint8_t mp_digit;
-typedef uint16_t private_mp_word;
-# define MP_DIGIT_BIT 7
+ typedef uint8_t mp_digit;
+ typedef uint16_t private_mp_word;
+#define MP_DIGIT_BIT 7
#elif defined(MP_16BIT)
-typedef uint16_t mp_digit;
-typedef uint32_t private_mp_word;
-# define MP_DIGIT_BIT 15
+ typedef uint16_t mp_digit;
+ typedef uint32_t private_mp_word;
+#define MP_DIGIT_BIT 15
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
-typedef uint64_t mp_digit;
+ typedef uint64_t mp_digit;
#if defined(__GNUC__)
-typedef unsigned long private_mp_word __attribute__((mode(TI)));
+ typedef unsigned long private_mp_word __attribute__((mode(TI)));
#endif
-# define MP_DIGIT_BIT 60
+#define MP_DIGIT_BIT 60
#else
-typedef uint32_t mp_digit;
-typedef uint64_t private_mp_word;
-# ifdef MP_31BIT
+ typedef uint32_t mp_digit;
+ typedef uint64_t private_mp_word;
+#ifdef MP_31BIT
/*
* This is an extension that uses 31-bit digits.
* Please be aware that not all functions support this size, especially s_mp_mul_digs_fast
* will be reduced to work on small numbers only:
* Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT.
*/
-# define MP_DIGIT_BIT 31
-# else
+#define MP_DIGIT_BIT 31
+#else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
-# define MP_DIGIT_BIT 28
-# define MP_28BIT
-# endif
+#define MP_DIGIT_BIT 28
+#define MP_28BIT
+#endif
#endif
/* mp_word is a private type */
@@ -107,68 +107,68 @@ typedef uint64_t private_mp_word;
#define MP_DIGIT_MAX MP_MASK
/* Primality generation flags */
-#define MP_PRIME_BBS 0x0001 /* BBS style prime */
-#define MP_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */
-#define MP_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */
+#define MP_PRIME_BBS 0x0001 /* BBS style prime */
+#define MP_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */
+#define MP_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */
#define LTM_PRIME_BBS (MP_DEPRECATED_PRAGMA("LTM_PRIME_BBS has been deprecated, use MP_PRIME_BBS") MP_PRIME_BBS)
#define LTM_PRIME_SAFE (MP_DEPRECATED_PRAGMA("LTM_PRIME_SAFE has been deprecated, use MP_PRIME_SAFE") MP_PRIME_SAFE)
#define LTM_PRIME_2MSB_ON (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON)
#ifdef MP_USE_ENUMS
-typedef enum {
- MP_ZPOS = 0, /* positive */
- MP_NEG = 1 /* negative */
-} mp_sign;
-typedef enum {
- MP_LT = -1, /* less than */
- MP_EQ = 0, /* equal */
- MP_GT = 1 /* greater than */
-} mp_ord;
-typedef enum {
- MP_NO = 0,
- MP_YES = 1
-} mp_bool;
-typedef enum {
- MP_OKAY = 0, /* no error */
- MP_ERR = -1, /* unknown error */
- MP_MEM = -2, /* out of mem */
- MP_VAL = -3, /* invalid input */
- MP_ITER = -4, /* maximum iterations reached */
- MP_BUF = -5 /* buffer overflow, supplied buffer too small */
-} mp_err;
-typedef enum {
- MP_LSB_FIRST = -1,
- MP_MSB_FIRST = 1
-} mp_order;
-typedef enum {
- MP_LITTLE_ENDIAN = -1,
- MP_NATIVE_ENDIAN = 0,
- MP_BIG_ENDIAN = 1
-} mp_endian;
+ typedef enum {
+ MP_ZPOS = 0, /* positive */
+ MP_NEG = 1 /* negative */
+ } mp_sign;
+ typedef enum {
+ MP_LT = -1, /* less than */
+ MP_EQ = 0, /* equal */
+ MP_GT = 1 /* greater than */
+ } mp_ord;
+ typedef enum {
+ MP_NO = 0,
+ MP_YES = 1
+ } mp_bool;
+ typedef enum {
+ MP_OKAY = 0, /* no error */
+ MP_ERR = -1, /* unknown error */
+ MP_MEM = -2, /* out of mem */
+ MP_VAL = -3, /* invalid input */
+ MP_ITER = -4, /* maximum iterations reached */
+ MP_BUF = -5 /* buffer overflow, supplied buffer too small */
+ } mp_err;
+ typedef enum {
+ MP_LSB_FIRST = -1,
+ MP_MSB_FIRST = 1
+ } mp_order;
+ typedef enum {
+ MP_LITTLE_ENDIAN = -1,
+ MP_NATIVE_ENDIAN = 0,
+ MP_BIG_ENDIAN = 1
+ } mp_endian;
#else
-typedef int mp_sign;
-#define MP_ZPOS 0 /* positive integer */
-#define MP_NEG 1 /* negative */
-typedef int mp_ord;
-#define MP_LT -1 /* less than */
-#define MP_EQ 0 /* equal to */
-#define MP_GT 1 /* greater than */
-typedef int mp_bool;
+ typedef int mp_sign;
+#define MP_ZPOS 0 /* positive integer */
+#define MP_NEG 1 /* negative */
+ typedef int mp_ord;
+#define MP_LT -1 /* less than */
+#define MP_EQ 0 /* equal to */
+#define MP_GT 1 /* greater than */
+ typedef int mp_bool;
#define MP_YES 1
#define MP_NO 0
-typedef int mp_err;
-#define MP_OKAY 0 /* no error */
-#define MP_ERR -1 /* unknown error */
-#define MP_MEM -2 /* out of mem */
-#define MP_VAL -3 /* invalid input */
+ typedef int mp_err;
+#define MP_OKAY 0 /* no error */
+#define MP_ERR -1 /* unknown error */
+#define MP_MEM -2 /* out of mem */
+#define MP_VAL -3 /* invalid input */
#define MP_RANGE (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL)
-#define MP_ITER -4 /* maximum iterations reached */
-#define MP_BUF -5 /* buffer overflow, supplied buffer too small */
-typedef int mp_order;
+#define MP_ITER -4 /* maximum iterations reached */
+#define MP_BUF -5 /* buffer overflow, supplied buffer too small */
+ typedef int mp_order;
#define MP_LSB_FIRST -1
#define MP_MSB_FIRST 1
-typedef int mp_endian;
+ typedef int mp_endian;
#define MP_LITTLE_ENDIAN -1
#define MP_NATIVE_ENDIAN 0
#define MP_BIG_ENDIAN 1
@@ -177,11 +177,8 @@ typedef int mp_endian;
/* tunable cutoffs */
#ifndef MP_FIXED_CUTOFFS
-extern int
-KARATSUBA_MUL_CUTOFF,
-KARATSUBA_SQR_CUTOFF,
-TOOM_MUL_CUTOFF,
-TOOM_SQR_CUTOFF;
+ extern int
+ KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF;
#endif
/* define this to use lower memory usage routines (exptmods mostly) */
@@ -189,14 +186,14 @@ TOOM_SQR_CUTOFF;
/* default precision */
#ifndef MP_PREC
-# ifndef MP_LOW_MEM
-# define PRIVATE_MP_PREC 32 /* default digits of precision */
-# elif defined(MP_8BIT)
-# define PRIVATE_MP_PREC 16 /* default digits of precision */
-# else
-# define PRIVATE_MP_PREC 8 /* default digits of precision */
-# endif
-# define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC)
+#ifndef MP_LOW_MEM
+#define PRIVATE_MP_PREC 32 /* default digits of precision */
+#elif defined(MP_8BIT)
+#define PRIVATE_MP_PREC 16 /* default digits of precision */
+#else
+#define PRIVATE_MP_PREC 8 /* default digits of precision */
+#endif
+#define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC)
#endif
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
@@ -204,9 +201,9 @@ TOOM_SQR_CUTOFF;
#define MP_WARRAY (MP_DEPRECATED_PRAGMA("MP_WARRAY is an internal macro") PRIVATE_MP_WARRAY)
#if defined(__GNUC__) && __GNUC__ >= 4
-# define MP_NULL_TERMINATED __attribute__((sentinel))
+#define MP_NULL_TERMINATED __attribute__((sentinel))
#else
-# define MP_NULL_TERMINATED
+#define MP_NULL_TERMINATED
#endif
/*
@@ -225,23 +222,23 @@ TOOM_SQR_CUTOFF;
* tommath.h, disabling the warnings.
*/
#ifndef MP_WUR
-# if defined(__GNUC__) && __GNUC__ >= 4
-# define MP_WUR __attribute__((warn_unused_result))
-# else
-# define MP_WUR
-# endif
+#if defined(__GNUC__) && __GNUC__ >= 4
+#define MP_WUR __attribute__((warn_unused_result))
+#else
+#define MP_WUR
+#endif
#endif
#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405)
-# define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
-# define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
-# define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
+#define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
+#define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
+#define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
#elif defined(_MSC_VER) && _MSC_VER >= 1500
-# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
-# define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
+#define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
+#define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
#else
-# define MP_DEPRECATED(s)
-# define MP_DEPRECATED_PRAGMA(s)
+#define MP_DEPRECATED(s)
+#define MP_DEPRECATED_PRAGMA(s)
#endif
#define DIGIT_BIT (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT)
@@ -250,193 +247,204 @@ TOOM_SQR_CUTOFF;
#define SIGN(m) (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign)
/* the infamous mp_int structure */
-typedef struct {
- int used, alloc;
- mp_sign sign;
- mp_digit *dp;
-} mp_int;
+ typedef struct {
+ int used, alloc;
+ mp_sign sign;
+ mp_digit *dp;
+ } mp_int;
/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
-typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat);
-typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback;
+ typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat);
+ typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source)
+ ltm_prime_callback;
/* error code to char* string */
-const char *mp_error_to_string(mp_err code) MP_WUR;
+ const char *mp_error_to_string(mp_err code) MP_WUR;
/* ---> init and deinit bignum functions <--- */
/* init a bignum */
-mp_err mp_init(mp_int *a) MP_WUR;
+ mp_err mp_init(mp_int * a) MP_WUR;
/* free a bignum */
-void mp_clear(mp_int *a);
+ void mp_clear(mp_int * a);
/* init a null terminated series of arguments */
-mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR;
+ mp_err mp_init_multi(mp_int * mp, ...) MP_NULL_TERMINATED MP_WUR;
/* clear a null terminated series of arguments */
-void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED;
+ void mp_clear_multi(mp_int * mp, ...) MP_NULL_TERMINATED;
/* exchange two ints */
-void mp_exch(mp_int *a, mp_int *b);
+ void mp_exch(mp_int * a, mp_int * b);
/* shrink ram required for a bignum */
-mp_err mp_shrink(mp_int *a) MP_WUR;
+ mp_err mp_shrink(mp_int * a) MP_WUR;
/* grow an int to a given size */
-mp_err mp_grow(mp_int *a, int size) MP_WUR;
+ mp_err mp_grow(mp_int * a, int size) MP_WUR;
/* init to a given number of digits */
-mp_err mp_init_size(mp_int *a, int size) MP_WUR;
+ mp_err mp_init_size(mp_int * a, int size) MP_WUR;
/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
-mp_bool mp_iseven(const mp_int *a) MP_WUR;
-mp_bool mp_isodd(const mp_int *a) MP_WUR;
+ mp_bool mp_iseven(const mp_int * a) MP_WUR;
+ mp_bool mp_isodd(const mp_int * a) MP_WUR;
#define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)
/* set to zero */
-void mp_zero(mp_int *a);
+ void mp_zero(mp_int * a);
/* get and set doubles */
-double mp_get_double(const mp_int *a) MP_WUR;
-mp_err mp_set_double(mp_int *a, double b) MP_WUR;
+ double mp_get_double(const mp_int * a) MP_WUR;
+ mp_err mp_set_double(mp_int * a, double b) MP_WUR;
/* get integer, set integer and init with integer (int32_t) */
-int32_t mp_get_i32(const mp_int *a) MP_WUR;
-void mp_set_i32(mp_int *a, int32_t b);
-mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR;
+ int32_t mp_get_i32(const mp_int * a) MP_WUR;
+ void mp_set_i32(mp_int * a, int32_t b);
+ mp_err mp_init_i32(mp_int * a, int32_t b) MP_WUR;
/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */
#define mp_get_u32(a) ((uint32_t)mp_get_i32(a))
-void mp_set_u32(mp_int *a, uint32_t b);
-mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR;
+ void mp_set_u32(mp_int * a, uint32_t b);
+ mp_err mp_init_u32(mp_int * a, uint32_t b) MP_WUR;
/* get integer, set integer and init with integer (int64_t) */
-int64_t mp_get_i64(const mp_int *a) MP_WUR;
-void mp_set_i64(mp_int *a, int64_t b);
-mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR;
+ int64_t mp_get_i64(const mp_int * a) MP_WUR;
+ void mp_set_i64(mp_int * a, int64_t b);
+ mp_err mp_init_i64(mp_int * a, int64_t b) MP_WUR;
/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */
#define mp_get_u64(a) ((uint64_t)mp_get_i64(a))
-void mp_set_u64(mp_int *a, uint64_t b);
-mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR;
+ void mp_set_u64(mp_int * a, uint64_t b);
+ mp_err mp_init_u64(mp_int * a, uint64_t b) MP_WUR;
/* get magnitude */
-uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR;
-uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR;
-unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR;
-unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR;
+ uint32_t mp_get_mag_u32(const mp_int * a) MP_WUR;
+ uint64_t mp_get_mag_u64(const mp_int * a) MP_WUR;
+ unsigned long mp_get_mag_ul(const mp_int * a) MP_WUR;
+ unsigned long long mp_get_mag_ull(const mp_int * a) MP_WUR;
/* get integer, set integer (long) */
-long mp_get_l(const mp_int *a) MP_WUR;
-void mp_set_l(mp_int *a, long b);
-mp_err mp_init_l(mp_int *a, long b) MP_WUR;
+ long mp_get_l(const mp_int * a) MP_WUR;
+ void mp_set_l(mp_int * a, long b);
+ mp_err mp_init_l(mp_int * a, long b) MP_WUR;
/* get integer, set integer (unsigned long) */
#define mp_get_ul(a) ((unsigned long)mp_get_l(a))
-void mp_set_ul(mp_int *a, unsigned long b);
-mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR;
+ void mp_set_ul(mp_int * a, unsigned long b);
+ mp_err mp_init_ul(mp_int * a, unsigned long b) MP_WUR;
/* get integer, set integer (long long) */
-long long mp_get_ll(const mp_int *a) MP_WUR;
-void mp_set_ll(mp_int *a, long long b);
-mp_err mp_init_ll(mp_int *a, long long b) MP_WUR;
+ long long mp_get_ll(const mp_int * a) MP_WUR;
+ void mp_set_ll(mp_int * a, long long b);
+ mp_err mp_init_ll(mp_int * a, long long b) MP_WUR;
/* get integer, set integer (unsigned long long) */
#define mp_get_ull(a) ((unsigned long long)mp_get_ll(a))
-void mp_set_ull(mp_int *a, unsigned long long b);
-mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR;
+ void mp_set_ull(mp_int * a, unsigned long long b);
+ mp_err mp_init_ull(mp_int * a, unsigned long long b) MP_WUR;
/* set to single unsigned digit, up to MP_DIGIT_MAX */
-void mp_set(mp_int *a, mp_digit b);
-mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR;
+ void mp_set(mp_int * a, mp_digit b);
+ mp_err mp_init_set(mp_int * a, mp_digit b) MP_WUR;
/* get integer, set integer and init with integer (deprecated) */
-MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR;
-MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR;
-MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned long long mp_get_long_long(const mp_int *a) MP_WUR;
-MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b);
-MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b);
-MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned long long b);
-MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR;
+ MP_DEPRECATED(mp_get_mag_u32 /
+ mp_get_u32) unsigned long mp_get_int(const mp_int * a) MP_WUR;
+ MP_DEPRECATED(mp_get_mag_ul /
+ mp_get_ul) unsigned long mp_get_long(const mp_int * a) MP_WUR;
+ MP_DEPRECATED(mp_get_mag_ull /
+ mp_get_ull) unsigned long long mp_get_long_long(const mp_int *
+ a) MP_WUR;
+ MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int * a, unsigned long b);
+ MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int * a, unsigned long b);
+ MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int * a,
+ unsigned long long b);
+ MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int * a,
+ unsigned long b) MP_WUR;
/* copy, b = a */
-mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_copy(const mp_int * a, mp_int * b) MP_WUR;
/* inits and copies, a = b */
-mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
+ mp_err mp_init_copy(mp_int * a, const mp_int * b) MP_WUR;
/* trim unused digits */
-void mp_clamp(mp_int *a);
-
+ void mp_clamp(mp_int * a);
/* export binary data */
-MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size,
- int endian, size_t nails, const mp_int *op) MP_WUR;
+ MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order,
+ size_t size, int endian,
+ size_t nails,
+ const mp_int * op) MP_WUR;
/* import binary data */
-MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order,
- size_t size, int endian, size_t nails,
- const void *op) MP_WUR;
+ MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int * rop, size_t count,
+ int order, size_t size, int endian,
+ size_t nails,
+ const void *op) MP_WUR;
/* unpack binary data */
-mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian,
- size_t nails, const void *op) MP_WUR;
+ mp_err mp_unpack(mp_int * rop, size_t count, mp_order order, size_t size,
+ mp_endian endian, size_t nails, const void *op) MP_WUR;
/* pack binary data */
-size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) MP_WUR;
-mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size,
- mp_endian endian, size_t nails, const mp_int *op) MP_WUR;
+ size_t mp_pack_count(const mp_int * a, size_t nails, size_t size) MP_WUR;
+ mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order,
+ size_t size, mp_endian endian, size_t nails,
+ const mp_int * op) MP_WUR;
/* ---> digit manipulation <--- */
/* right shift by "b" digits */
-void mp_rshd(mp_int *a, int b);
+ void mp_rshd(mp_int * a, int b);
/* left shift by "b" digits */
-mp_err mp_lshd(mp_int *a, int b) MP_WUR;
+ mp_err mp_lshd(mp_int * a, int b) MP_WUR;
/* c = a / 2**b, implemented as c = a >> b */
-mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR;
+ mp_err mp_div_2d(const mp_int * a, int b, mp_int * c, mp_int * d) MP_WUR;
/* b = a/2 */
-mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_div_2(const mp_int * a, mp_int * b) MP_WUR;
/* a/3 => 3c + d == a */
-mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR;
+ mp_err mp_div_3(const mp_int * a, mp_int * c, mp_digit * d) MP_WUR;
/* c = a * 2**b, implemented as c = a << b */
-mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
+ mp_err mp_mul_2d(const mp_int * a, int b, mp_int * c) MP_WUR;
/* b = a*2 */
-mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_mul_2(const mp_int * a, mp_int * b) MP_WUR;
/* c = a mod 2**b */
-mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
+ mp_err mp_mod_2d(const mp_int * a, int b, mp_int * c) MP_WUR;
/* computes a = 2**b */
-mp_err mp_2expt(mp_int *a, int b) MP_WUR;
+ mp_err mp_2expt(mp_int * a, int b) MP_WUR;
/* Counts the number of lsbs which are zero before the first zero bit */
-int mp_cnt_lsb(const mp_int *a) MP_WUR;
+ int mp_cnt_lsb(const mp_int * a) MP_WUR;
/* I Love Earth! */
/* makes a pseudo-random mp_int of a given size */
-mp_err mp_rand(mp_int *a, int digits) MP_WUR;
+ mp_err mp_rand(mp_int * a, int digits) MP_WUR;
/* makes a pseudo-random small int of a given size */
-MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR;
+ MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit * r) MP_WUR;
/* use custom random data source instead of source provided the platform */
-void mp_rand_source(mp_err(*source)(void *out, size_t size));
+ void mp_rand_source(mp_err(*source) (void *out, size_t size));
#ifdef MP_PRNG_ENABLE_LTM_RNG
-# warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead.
+#warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead.
/* A last resort to provide random data on systems without any of the other
* implemented ways to gather entropy.
* It is compatible with `rng_get_bytes()` from libtomcrypt so you could
* provide that one and then set `ltm_rng = rng_get_bytes;` */
-extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
-extern void (*ltm_rng_callback)(void);
+ extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen,
+ void(*callback)(void));
+ extern void (*ltm_rng_callback)(void);
#endif
/* ---> binary operations <--- */
@@ -445,225 +453,250 @@ extern void (*ltm_rng_callback)(void);
* if the bit is 1, MP_NO if it is 0 and MP_VAL
* in case of error
*/
-MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR;
+ MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int * a, int b) MP_WUR;
/* c = a XOR b (two complement) */
-MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
-mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int * a, const mp_int * b,
+ mp_int * c) MP_WUR;
+ mp_err mp_xor(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = a OR b (two complement) */
-MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
-mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int * a, const mp_int * b,
+ mp_int * c) MP_WUR;
+ mp_err mp_or(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = a AND b (two complement) */
-MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
-mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int * a, const mp_int * b,
+ mp_int * c) MP_WUR;
+ mp_err mp_and(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* b = ~a (bitwise not, two complement) */
-mp_err mp_complement(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_complement(const mp_int * a, mp_int * b) MP_WUR;
/* right shift with sign extension */
-MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
-mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR;
+ MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int * a, int b,
+ mp_int * c) MP_WUR;
+ mp_err mp_signed_rsh(const mp_int * a, int b, mp_int * c) MP_WUR;
/* ---> Basic arithmetic <--- */
/* b = -a */
-mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_neg(const mp_int * a, mp_int * b) MP_WUR;
/* b = |a| */
-mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_abs(const mp_int * a, mp_int * b) MP_WUR;
/* compare a to b */
-mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
+ mp_ord mp_cmp(const mp_int * a, const mp_int * b) MP_WUR;
/* compare |a| to |b| */
-mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
+ mp_ord mp_cmp_mag(const mp_int * a, const mp_int * b) MP_WUR;
/* c = a + b */
-mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_add(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = a - b */
-mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_sub(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = a * b */
-mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_mul(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* b = a*a */
-mp_err mp_sqr(const mp_int *a, mp_int *b) MP_WUR;
+ mp_err mp_sqr(const mp_int * a, mp_int * b) MP_WUR;
/* a/b => cb + d == a */
-mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR;
+ mp_err mp_div(const mp_int * a, const mp_int * b, mp_int * c,
+ mp_int * d) MP_WUR;
/* c = a mod b, 0 <= c < b */
-mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_mod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* Increment "a" by one like "a++". Changes input! */
-mp_err mp_incr(mp_int *a) MP_WUR;
+ mp_err mp_incr(mp_int * a) MP_WUR;
/* Decrement "a" by one like "a--". Changes input! */
-mp_err mp_decr(mp_int *a) MP_WUR;
+ mp_err mp_decr(mp_int * a) MP_WUR;
/* ---> single digit functions <--- */
/* compare against a single digit */
-mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR;
+ mp_ord mp_cmp_d(const mp_int * a, mp_digit b) MP_WUR;
/* c = a + b */
-mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+ mp_err mp_add_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
/* c = a - b */
-mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+ mp_err mp_sub_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
/* c = a * b */
-mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+ mp_err mp_mul_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
/* a/b => cb + d == a */
-mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR;
+ mp_err mp_div_d(const mp_int * a, mp_digit b, mp_int * c,
+ mp_digit * d) MP_WUR;
/* c = a mod b, 0 <= c < b */
-mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) MP_WUR;
+ mp_err mp_mod_d(const mp_int * a, mp_digit b, mp_digit * c) MP_WUR;
/* ---> number theory <--- */
/* d = a + b (mod c) */
-mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+ mp_err mp_addmod(const mp_int * a, const mp_int * b, const mp_int * c,
+ mp_int * d) MP_WUR;
/* d = a - b (mod c) */
-mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+ mp_err mp_submod(const mp_int * a, const mp_int * b, const mp_int * c,
+ mp_int * d) MP_WUR;
/* d = a * b (mod c) */
-mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+ mp_err mp_mulmod(const mp_int * a, const mp_int * b, const mp_int * c,
+ mp_int * d) MP_WUR;
/* c = a * a (mod b) */
-mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_sqrmod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = 1/a (mod b) */
-mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_invmod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* c = (a, b) */
-mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_gcd(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* produces value such that U1*a + U2*b = U3 */
-mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR;
+ mp_err mp_exteuclid(const mp_int * a, const mp_int * b, mp_int * U1,
+ mp_int * U2, mp_int * U3) MP_WUR;
/* c = [a, b] or (a*b)/(a, b) */
-mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+ mp_err mp_lcm(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
/* finds one of the b'th root of a, such that |c|**b <= |a|
*
* returns error if a < 0 and b is even
*/
-mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR;
-MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
-MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+ mp_err mp_root_u32(const mp_int * a, uint32_t b, mp_int * c) MP_WUR;
+ MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int * a, mp_digit b,
+ mp_int * c) MP_WUR;
+ MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int * a, mp_digit b,
+ mp_int * c, int fast) MP_WUR;
/* special sqrt algo */
-mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR;
+ mp_err mp_sqrt(const mp_int * arg, mp_int * ret) MP_WUR;
/* special sqrt (mod prime) */
-mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR;
+ mp_err mp_sqrtmod_prime(const mp_int * n, const mp_int * prime,
+ mp_int * ret) MP_WUR;
/* is number a square? */
-mp_err mp_is_square(const mp_int *arg, mp_bool *ret) MP_WUR;
+ mp_err mp_is_square(const mp_int * arg, mp_bool * ret) MP_WUR;
/* computes the jacobi c = (a | n) (or Legendre if b is prime) */
-MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR;
+ MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int * a,
+ const mp_int * n,
+ int *c) MP_WUR;
/* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */
-mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) MP_WUR;
+ mp_err mp_kronecker(const mp_int * a, const mp_int * p, int *c) MP_WUR;
/* used to setup the Barrett reduction for a given modulus b */
-mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR;
+ mp_err mp_reduce_setup(mp_int * a, const mp_int * b) MP_WUR;
/* Barrett Reduction, computes a (mod b) with a precomputed value c
*
* Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
* compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
*/
-mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR;
+ mp_err mp_reduce(mp_int * x, const mp_int * m, const mp_int * mu) MP_WUR;
/* setups the montgomery reduction */
-mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR;
+ mp_err mp_montgomery_setup(const mp_int * n, mp_digit * rho) MP_WUR;
/* computes a = B**n mod b without division or multiplication useful for
* normalizing numbers in a Montgomery system.
*/
-mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) MP_WUR;
+ mp_err mp_montgomery_calc_normalization(mp_int * a, const mp_int * b) MP_WUR;
/* computes x/R == x (mod N) via Montgomery Reduction */
-mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR;
+ mp_err mp_montgomery_reduce(mp_int * x, const mp_int * n,
+ mp_digit rho) MP_WUR;
/* returns 1 if a is a valid DR modulus */
-mp_bool mp_dr_is_modulus(const mp_int *a) MP_WUR;
+ mp_bool mp_dr_is_modulus(const mp_int * a) MP_WUR;
/* sets the value of "d" required for mp_dr_reduce */
-void mp_dr_setup(const mp_int *a, mp_digit *d);
+ void mp_dr_setup(const mp_int * a, mp_digit * d);
/* reduces a modulo n using the Diminished Radix method */
-mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR;
+ mp_err mp_dr_reduce(mp_int * x, const mp_int * n, mp_digit k) MP_WUR;
/* returns true if a can be reduced with mp_reduce_2k */
-mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR;
+ mp_bool mp_reduce_is_2k(const mp_int * a) MP_WUR;
/* determines k value for 2k reduction */
-mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR;
+ mp_err mp_reduce_2k_setup(const mp_int * a, mp_digit * d) MP_WUR;
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR;
+ mp_err mp_reduce_2k(mp_int * a, const mp_int * n, mp_digit d) MP_WUR;
/* returns true if a can be reduced with mp_reduce_2k_l */
-mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR;
+ mp_bool mp_reduce_is_2k_l(const mp_int * a) MP_WUR;
/* determines k value for 2k reduction */
-mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR;
+ mp_err mp_reduce_2k_setup_l(const mp_int * a, mp_int * d) MP_WUR;
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) MP_WUR;
+ mp_err mp_reduce_2k_l(mp_int * a, const mp_int * n, const mp_int * d) MP_WUR;
/* Y = G**X (mod P) */
-mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR;
+ mp_err mp_exptmod(const mp_int * G, const mp_int * X, const mp_int * P,
+ mp_int * Y) MP_WUR;
/* ---> Primes <--- */
/* number of primes */
#ifdef MP_8BIT
-# define PRIVATE_MP_PRIME_TAB_SIZE 31
+#define PRIVATE_MP_PRIME_TAB_SIZE 31
#else
-# define PRIVATE_MP_PRIME_TAB_SIZE 256
+#define PRIVATE_MP_PRIME_TAB_SIZE 256
#endif
#define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE)
/* table of first PRIME_SIZE primes */
-MP_DEPRECATED(internal) extern const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE];
+ MP_DEPRECATED(internal) extern const mp_digit
+ ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE];
/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
-MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR;
+ MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *
+ a,
+ mp_bool *
+ result) MP_WUR;
/* performs one Fermat test of "a" using base "b".
* Sets result to 0 if composite or 1 if probable prime
*/
-mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
+ mp_err mp_prime_fermat(const mp_int * a, const mp_int * b,
+ mp_bool * result) MP_WUR;
/* performs one Miller-Rabin test of "a" using base "b".
* Sets result to 0 if composite or 1 if probable prime
*/
-mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
+ mp_err mp_prime_miller_rabin(const mp_int * a, const mp_int * b,
+ mp_bool * result) MP_WUR;
/* This gives [for a given bit size] the number of trials required
* such that Miller-Rabin gives a prob of failure lower than 2^-96
*/
-int mp_prime_rabin_miller_trials(int size) MP_WUR;
+ int mp_prime_rabin_miller_trials(int size) MP_WUR;
/* performs one strong Lucas-Selfridge test of "a".
* Sets result to 0 if composite or 1 if probable prime
*/
-mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR;
+ mp_err mp_prime_strong_lucas_selfridge(const mp_int * a,
+ mp_bool * result) MP_WUR;
/* performs one Frobenius test of "a" as described by Paul Underwood.
* Sets result to 0 if composite or 1 if probable prime
*/
-mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR;
+ mp_err mp_prime_frobenius_underwood(const mp_int * N,
+ mp_bool * result) MP_WUR;
/* performs t random rounds of Miller-Rabin on "a" additional to
* bases 2 and 3. Also performs an initial sieve of trial
@@ -679,14 +712,14 @@ mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR;
*
* Sets result to 1 if probably prime, 0 otherwise
*/
-mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR;
+ mp_err mp_prime_is_prime(const mp_int * a, int t, mp_bool * result) MP_WUR;
/* finds the next prime after the number "a" using "t" trials
* of Miller-Rabin.
*
* bbs_style = 1 means the prime must be congruent to 3 mod 4
*/
-mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR;
+ mp_err mp_prime_next_prime(mp_int * a, int t, int bbs_style) MP_WUR;
/* makes a truly random prime of a given size (bytes),
* call with bbs = 1 if you want it to be congruent to 3 mod 4
@@ -712,49 +745,70 @@ mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR;
* so it can be NULL
*
*/
-MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags,
- private_mp_prime_callback cb, void *dat) MP_WUR;
-mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR;
+ MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int * a, int t,
+ int size, int flags,
+ private_mp_prime_callback
+ cb, void *dat) MP_WUR;
+ mp_err mp_prime_rand(mp_int * a, int t, int size, int flags) MP_WUR;
/* Integer logarithm to integer base */
-mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR;
+ mp_err mp_log_u32(const mp_int * a, uint32_t base, uint32_t * c) MP_WUR;
/* c = a**b */
-mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR;
-MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
-MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+ mp_err mp_expt_u32(const mp_int * a, uint32_t b, mp_int * c) MP_WUR;
+ MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int * a, mp_digit b,
+ mp_int * c) MP_WUR;
+ MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int * a, mp_digit b,
+ mp_int * c, int fast) MP_WUR;
/* ---> radix conversion <--- */
-int mp_count_bits(const mp_int *a) MP_WUR;
-
-
-MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR;
-MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
-MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR;
-MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
-
-MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int *a) MP_WUR;
-MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
-MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) MP_WUR;
-MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
-
-size_t mp_ubin_size(const mp_int *a) MP_WUR;
-mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR;
-mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;
-
-size_t mp_sbin_size(const mp_int *a) MP_WUR;
-mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR;
-mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;
-
-mp_err mp_read_radix(mp_int *a, const char *str, int radix) MP_WUR;
-MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR;
-MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR;
-mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR;
-mp_err mp_radix_size(const mp_int *a, int radix, int *size) MP_WUR;
+ int mp_count_bits(const mp_int * a) MP_WUR;
+
+ MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *
+ a) MP_WUR;
+ MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int * a,
+ const unsigned char
+ *b, int c) MP_WUR;
+ MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int * a,
+ unsigned char *b) MP_WUR;
+ MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int * a,
+ unsigned char *b,
+ unsigned long *outlen)
+ MP_WUR;
+
+ MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int * a) MP_WUR;
+ MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int * a,
+ const unsigned char *b,
+ int c) MP_WUR;
+ MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int * a,
+ unsigned char *b) MP_WUR;
+ MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int * a,
+ unsigned char *b,
+ unsigned long *outlen)
+ MP_WUR;
+
+ size_t mp_ubin_size(const mp_int * a) MP_WUR;
+ mp_err mp_from_ubin(mp_int * a, const unsigned char *buf, size_t size) MP_WUR;
+ mp_err mp_to_ubin(const mp_int * a, unsigned char *buf, size_t maxlen,
+ size_t *written) MP_WUR;
+
+ size_t mp_sbin_size(const mp_int * a) MP_WUR;
+ mp_err mp_from_sbin(mp_int * a, const unsigned char *buf, size_t size) MP_WUR;
+ mp_err mp_to_sbin(const mp_int * a, unsigned char *buf, size_t maxlen,
+ size_t *written) MP_WUR;
+
+ mp_err mp_read_radix(mp_int * a, const char *str, int radix) MP_WUR;
+ MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int * a, char *str,
+ int radix) MP_WUR;
+ MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int * a, char *str,
+ int radix, int maxlen) MP_WUR;
+ mp_err mp_to_radix(const mp_int * a, char *str, size_t maxlen,
+ size_t *written, int radix) MP_WUR;
+ mp_err mp_radix_size(const mp_int * a, int radix, int *size) MP_WUR;
#ifndef MP_NO_FILE
-mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR;
-mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR;
+ mp_err mp_fread(mp_int * a, int radix, FILE * stream) MP_WUR;
+ mp_err mp_fwrite(const mp_int * a, int radix, FILE * stream) MP_WUR;
#endif
#define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len)))
@@ -777,5 +831,4 @@ mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR;
#ifdef __cplusplus
}
#endif
-
#endif
diff --git a/include/cyclone/hashset.h b/include/cyclone/hashset.h
index a1244a47..24c76f93 100644
--- a/include/cyclone/hashset.h
+++ b/include/cyclone/hashset.h
@@ -24,52 +24,51 @@
extern "C" {
#endif
- struct hashset_st {
- size_t nbits;
- size_t mask;
+ struct hashset_st {
+ size_t nbits;
+ size_t mask;
- size_t capacity;
- size_t *items;
- size_t nitems;
- size_t n_deleted_items;
- };
+ size_t capacity;
+ size_t *items;
+ size_t nitems;
+ size_t n_deleted_items;
+ };
- typedef struct hashset_st *hashset_t;
+ typedef struct hashset_st *hashset_t;
- /* create hashset instance */
- hashset_t hashset_create(void);
+ /* create hashset instance */
+ hashset_t hashset_create(void);
- /* destroy hashset instance */
- void hashset_destroy(hashset_t set);
+ /* destroy hashset instance */
+ void hashset_destroy(hashset_t set);
- size_t hashset_num_items(hashset_t set);
+ size_t hashset_num_items(hashset_t set);
- /* add item into the hashset.
- *
- * @note 0 and 1 is special values, meaning nil and deleted items. the
- * function will return -1 indicating error.
- *
- * returns zero if the item already in the set and non-zero otherwise
- */
- int hashset_add(hashset_t set, void *item);
+ /* add item into the hashset.
+ *
+ * @note 0 and 1 is special values, meaning nil and deleted items. the
+ * function will return -1 indicating error.
+ *
+ * returns zero if the item already in the set and non-zero otherwise
+ */
+ int hashset_add(hashset_t set, void *item);
- /* remove item from the hashset
- *
- * returns non-zero if the item was removed and zero if the item wasn't
- * exist
- */
- int hashset_remove(hashset_t set, void *item);
+ /* remove item from the hashset
+ *
+ * returns non-zero if the item was removed and zero if the item wasn't
+ * exist
+ */
+ int hashset_remove(hashset_t set, void *item);
- /* check if existence of the item
- *
- * returns non-zero if the item exists and zero otherwise
- */
- int hashset_is_member(hashset_t set, void *item);
+ /* check if existence of the item
+ *
+ * returns non-zero if the item exists and zero otherwise
+ */
+ int hashset_is_member(hashset_t set, void *item);
- void hashset_to_array(hashset_t set, void **items);
+ void hashset_to_array(hashset_t set, void **items);
#ifdef __cplusplus
}
#endif
-
#endif
diff --git a/include/cyclone/runtime-main.h b/include/cyclone/runtime-main.h
index 0c882cd2..432163e6 100644
--- a/include/cyclone/runtime-main.h
+++ b/include/cyclone/runtime-main.h
@@ -12,7 +12,7 @@
long global_stack_size = 0;
long global_heap_size = 0;
-static void c_entry_pt(void *data, object clo, int argc, object *args);
+static void c_entry_pt(void *data, object clo, int argc, object * args);
static void Cyc_heap_init(long heap_size);
static void Cyc_heap_init(long heap_size)
diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index d76dee4a..82608b30 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -9,7 +9,6 @@
#ifndef CYCLONE_RUNTIME_H
#define CYCLONE_RUNTIME_H
-
/**
* The boolean True value.
* \ingroup objects
@@ -231,7 +230,8 @@ object Cyc_global_set(void *thd, object sym, object * glo, object value);
#define global_set_cps(thd,k,glo,value) Cyc_global_set_cps(thd, k, NULL, (object *)&glo, value)
#define global_set_cps_id(thd,k,id,glo,value) Cyc_global_set_cps(thd, k, id, (object *)&glo, value)
-object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, object value);
+object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo,
+ object value);
/**
* Variable argument count support
@@ -274,8 +274,8 @@ object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, obje
/**@{*/
object apply(void *data, object cont, object func, object args);
-void Cyc_apply(void *data, object cont, int argc, object *args);
-void dispatch_apply_va(void *data, object clo, int argc, object *args);
+void Cyc_apply(void *data, object cont, int argc, object * args);
+void dispatch_apply_va(void *data, object clo, int argc, object * args);
object apply_va(void *data, object cont, int argc, object func, ...);
void dispatch(void *data, int argc, function_type func, object clo, object cont,
object args);
@@ -288,7 +288,7 @@ void dispatch(void *data, int argc, function_type func, object clo, object cont,
*/
/**@{*/
object Cyc_string_cmp(void *data, object str1, object str2);
-void dispatch_string_91append(void *data, object clo, int _argc, object *args);
+void dispatch_string_91append(void *data, object clo, int _argc, object * args);
object Cyc_string2number_(void *d, object cont, object str);
object Cyc_string2number2_(void *data, object cont, int argc, object str, ...);
int binstr2int(const char *str);
@@ -342,12 +342,12 @@ object Cyc_set_cvar(object var, object value);
*/
/**@{*/
object Cyc_display(void *data, object, FILE * port);
-void dispatch_display_va(void *data, object clo, int argc, object *args);
+void dispatch_display_va(void *data, object clo, int argc, object * args);
object Cyc_display_va(void *data, int argc, object x, ...);
object Cyc_display_va_list(void *data, object x, object opts);
object Cyc_write_char(void *data, object c, object port);
object Cyc_write(void *data, object, FILE * port);
-void dispatch_write_va(void *data, object clo, int argc, object *args);
+void dispatch_write_va(void *data, object clo, int argc, object * args);
object Cyc_write_va(void *data, int argc, object x, ...);
object Cyc_write_va_list(void *data, object x, object opts);
port_type Cyc_stdout(void);
@@ -372,13 +372,13 @@ object Cyc_io_char_ready(void *data, object port);
object Cyc_write_u8(void *data, object c, object port);
object Cyc_io_read_u8(void *data, object cont, object port);
object Cyc_io_peek_u8(void *data, object cont, object port);
-object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end);
+object Cyc_write_bytevector(void *data, object bvec, object port, object start,
+ object end);
object Cyc_io_read_line(void *data, object cont, object port);
void Cyc_io_read_token(void *data, object cont, object port);
int Cyc_have_mstreams();
/**@}*/
-
/**
* \defgroup prim_num Numbers
* @brief Number functions
@@ -558,9 +558,11 @@ object Cyc_fast_list_3(object ptr, object a1, object a2, object a3);
object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4);
object Cyc_fast_vector_2(object ptr, object a1, object a2);
object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3);
-object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4);
-object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4, object a5);
-object Cyc_bit_unset(void *data, object n1, object n2);
+object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3,
+ object a4);
+object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4,
+ object a5);
+object Cyc_bit_unset(void *data, object n1, object n2);
object Cyc_bit_set(void *data, object n1, object n2);
object Cyc_num_op_va_list(void *data, int argc,
object(fn_op(void *, common_type *, object)),
@@ -568,14 +570,13 @@ object Cyc_num_op_va_list(void *data, int argc,
va_list ns, common_type * buf);
object Cyc_num_op_args(void *data, int argc,
object(fn_op(void *, common_type *, object)),
- int default_no_args, int default_one_arg,
- object *args,
- common_type * buf);
-void Cyc_int2bignum(int n, mp_int *bn);
+ int default_no_args, int default_one_arg,
+ object * args, common_type * buf);
+void Cyc_int2bignum(int n, mp_int * bn);
object Cyc_bignum_normalize(void *data, object n);
int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty);
void Cyc_make_rectangular(void *data, object k, object r, object i);
-double MRG32k3a (double seed);
+double MRG32k3a(double seed);
/**@}*/
/**
* \defgroup prim_eq Equality and type predicates
@@ -651,7 +652,8 @@ object Cyc_vector_ref(void *d, object v, object k);
object Cyc_vector_set(void *d, object v, object k, object obj);
object Cyc_vector_set_unsafe(void *d, object v, object k, object obj);
object Cyc_vector_set_cps(void *d, object cont, object v, object k, object obj);
-object Cyc_vector_set_unsafe_cps(void *d, object cont, object v, object k, object obj);
+object Cyc_vector_set_unsafe_cps(void *d, object cont, object v, object k,
+ object obj);
object Cyc_make_vector(void *data, object cont, int argc, object len, ...);
/**@}*/
@@ -686,7 +688,7 @@ object Cyc_installation_dir(void *data, object cont, object type);
object Cyc_compilation_environment(void *data, object cont, object var);
object Cyc_command_line_arguments(void *data, object cont);
object Cyc_system(object cmd);
-void Cyc_halt(void *data, object clo, int argc, object *args);
+void Cyc_halt(void *data, object clo, int argc, object * args);
object __halt(object obj);
object Cyc_io_delete_file(void *data, object filename);
object Cyc_io_file_exists(void *data, object filename);
@@ -704,7 +706,7 @@ time_t Cyc_file_last_modified_time(char *path);
object Cyc_spawn_thread(object thunk);
void Cyc_start_trampoline(gc_thread_data * thd);
void Cyc_end_thread(gc_thread_data * thd);
-void Cyc_exit_thread(void *data, object _, int argc, object *args);
+void Cyc_exit_thread(void *data, object _, int argc, object * args);
object Cyc_thread_sleep(void *data, object timeout);
/**@}*/
@@ -907,7 +909,8 @@ extern object Cyc_glo_call_cc;
* @brief Raise and handle Scheme exceptions
*/
/**@{*/
-object Cyc_default_exception_handler(void *data, object _, int argc, object *args);
+object Cyc_default_exception_handler(void *data, object _, int argc,
+ object * args);
object Cyc_current_exception_handler(void *data);
void Cyc_rt_raise(void *data, object err);
@@ -948,7 +951,7 @@ object register_library(const char *name);
/**@{*/
extern list global_table;
void add_global(const char *identifier, object * glo);
-void Cyc_set_globals_changed(gc_thread_data *thd);
+void Cyc_set_globals_changed(gc_thread_data * thd);
/**@}*/
/**
@@ -970,9 +973,9 @@ void Cyc_set_globals_changed(gc_thread_data *thd);
#define Cyc_utf8_encode_char(dest, dest_size, char_value) \
Cyc_utf8_encode(dest, dest_size, &char_value, 1)
-int Cyc_utf8_encode(char *dest, int sz, uint32_t *src, int srcsz);
-int Cyc_utf8_count_code_points(uint8_t* s);
-uint32_t Cyc_utf8_validate_stream(uint32_t *state, char *str, size_t len);
+int Cyc_utf8_encode(char *dest, int sz, uint32_t * src, int srcsz);
+int Cyc_utf8_count_code_points(uint8_t * s);
+uint32_t Cyc_utf8_validate_stream(uint32_t * state, char *str, size_t len);
uint32_t Cyc_utf8_validate(char *str, size_t len);
/**@}*/
@@ -994,6 +997,7 @@ static inline object Cyc_cdr(void *data, object lis)
Cyc_check_pair(data, lis);
return cdr(lis);
}
+
// Unsafe car/cdr
#define Cyc_car_unsafe(d, lis) car(lis)
#define Cyc_cdr_unsafe(d, lis) cdr(lis)
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index c87e8cde..c37ae282 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -46,31 +46,13 @@ typedef void *object;
*\ingroup objects
*/
enum object_tag {
- closure0_tag = 0
- , closure1_tag = 1
- , closureN_tag = 2
- , macro_tag = 3 // Keep closures here for quick type checking
- , boolean_tag = 4
- , bytevector_tag = 5
- , c_opaque_tag = 6
- , cond_var_tag = 7
- , cvar_tag = 8
- , double_tag = 9
- , eof_tag = 10
- , forward_tag = 11
- , integer_tag = 12
- , bignum_tag = 13
- , mutex_tag = 14
- , pair_tag = 15
- , port_tag = 16
- , primitive_tag = 17
- , string_tag = 18
- , symbol_tag = 19
- , vector_tag = 20
- , complex_num_tag = 21
- , atomic_tag = 22
- , void_tag = 23
- , record_tag = 24
+ closure0_tag = 0, closure1_tag = 1, closureN_tag = 2, macro_tag = 3 // Keep closures here for quick type checking
+ , boolean_tag = 4, bytevector_tag = 5, c_opaque_tag = 6, cond_var_tag =
+ 7, cvar_tag = 8, double_tag = 9, eof_tag = 10, forward_tag =
+ 11, integer_tag = 12, bignum_tag = 13, mutex_tag = 14, pair_tag =
+ 15, port_tag = 16, primitive_tag = 17, string_tag = 18, symbol_tag =
+ 19, vector_tag = 20, complex_num_tag = 21, atomic_tag = 22, void_tag =
+ 23, record_tag = 24
};
/**
@@ -113,13 +95,13 @@ typedef unsigned char tag_type;
// Parameters for size of a "page" on the heap (the second generation GC), in bytes.
/** Grow first page by adding this amount to it */
-#define GROW_HEAP_BY_SIZE (2 * 1024 * 1024)
+#define GROW_HEAP_BY_SIZE (2 * 1024 * 1024)
/** Size of the first page */
-#define INITIAL_HEAP_SIZE (3 * 1024 * 1024)
+#define INITIAL_HEAP_SIZE (3 * 1024 * 1024)
/** Normal size of a heap page */
-#define HEAP_SIZE (8 * 1024 * 1024)
+#define HEAP_SIZE (8 * 1024 * 1024)
// End heap page size parameters
////////////////////////////////
@@ -128,7 +110,7 @@ typedef unsigned char tag_type;
// Major GC tuning parameters
/** Start GC cycle if % heap space free below this percentage */
-#define GC_COLLECTION_THRESHOLD 0.0125 //0.05
+#define GC_COLLECTION_THRESHOLD 0.0125 //0.05
/** Start GC cycle if fewer than this many heap pages are unswept */
#define GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT 3
@@ -221,15 +203,15 @@ struct gc_heap_t {
/** Size of the heap page in bytes */
unsigned int size;
/** Keep empty page alive this many times before freeing */
- unsigned char ttl;
+ unsigned char ttl;
/** Bump: Track remaining space; this is useful for bump&pop style allocation */
unsigned int remaining;
/** For fixed-size heaps, only allocate blocks of this size */
unsigned block_size;
/** Lazy-sweep: Amount of heap data that is free */
- unsigned int free_size;
+ unsigned int free_size;
/** Lazy-sweep: Determine if the heap is full */
- unsigned char is_full;
+ unsigned char is_full;
/** Lazy-sweep: Determine if the heap has been swept */
unsigned char is_unswept;
/** Lazy-sweep: Start GC cycle if fewer than this many heap pages are unswept */
@@ -261,9 +243,9 @@ struct gc_heap_root_t {
*/
typedef struct gc_header_type_t gc_header_type;
struct gc_header_type_t {
- unsigned char mark; // mark bits
- unsigned char grayed:1; // stack object to be grayed when moved to heap
- unsigned char immutable:1; // Flag normally mutable obj (EG: pair) as read-only
+ unsigned char mark; // mark bits
+ unsigned char grayed:1; // stack object to be grayed when moved to heap
+ unsigned char immutable:1; // Flag normally mutable obj (EG: pair) as read-only
};
/** Get an object's `mark` value */
@@ -290,10 +272,10 @@ typedef enum { STAGE_CLEAR_OR_MARKING, STAGE_TRACING
// the collector swaps their values as an optimization.
/** Memory not to be collected by major GC, such as on the stack */
-#define gc_color_red 0
+#define gc_color_red 0
/** Unallocated memory */
-#define gc_color_blue 2
+#define gc_color_blue 2
/** Mark buffers */
typedef struct mark_buffer_t mark_buffer;
@@ -398,29 +380,31 @@ void gc_initialize(void);
void gc_add_new_unrunning_mutator(gc_thread_data * thd);
void gc_add_mutator(gc_thread_data * thd);
void gc_remove_mutator(gc_thread_data * thd);
-int gc_is_mutator_active(gc_thread_data *thd);
-int gc_is_mutator_new(gc_thread_data *thd);
+int gc_is_mutator_active(gc_thread_data * thd);
+int gc_is_mutator_new(gc_thread_data * thd);
void gc_sleep_ms(int ms);
-gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd);
-gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page);
-void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc);
-void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src);
+gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data * thd);
+gc_heap *gc_heap_free(gc_heap * page, gc_heap * prev_page);
+void gc_heap_merge(gc_heap * hdest, gc_heap * hsrc);
+void gc_merge_all_heaps(gc_thread_data * dest, gc_thread_data * src);
void gc_print_stats(gc_heap * h);
-gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd);
+gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data * thd);
char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);
-void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
- gc_thread_data * thd);
-void *gc_try_alloc_slow(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd);
+void *gc_try_alloc(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
+void *gc_try_alloc_slow(gc_heap * h_passed, gc_heap * h, size_t size, char *obj,
+ gc_thread_data * thd);
void *gc_alloc(gc_heap_root * h, size_t size, char *obj, gc_thread_data * thd,
int *heap_grown);
-void *gc_alloc_bignum(gc_thread_data *data);
+void *gc_alloc_bignum(gc_thread_data * data);
size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r);
gc_heap *gc_heap_last(gc_heap * h);
-void gc_heap_create_rest(gc_heap *h, gc_thread_data *thd);
-void *gc_try_alloc_rest(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
-void *gc_alloc_rest(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd, int *heap_grown);
-void gc_init_fixed_size_free_list(gc_heap *h);
+void gc_heap_create_rest(gc_heap * h, gc_thread_data * thd);
+void *gc_try_alloc_rest(gc_heap * h, size_t size, char *obj,
+ gc_thread_data * thd);
+void *gc_alloc_rest(gc_heap_root * hrt, size_t size, char *obj,
+ gc_thread_data * thd, int *heap_grown);
+void gc_init_fixed_size_free_list(gc_heap * h);
//size_t gc_heap_total_size(gc_heap * h);
//size_t gc_heap_total_free_size(gc_heap *h);
@@ -429,7 +413,7 @@ void gc_init_fixed_size_free_list(gc_heap *h);
void gc_request_mark_globals(void);
void gc_mark_globals(object globals, object global_table);
//size_t gc_sweep(gc_heap * h, size_t * sum_freed_ptr, gc_thread_data *thd);
-gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd);
+gc_heap *gc_sweep(gc_heap * h, gc_thread_data * thd);
void gc_thr_grow_move_buffer(gc_thread_data * d);
void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
long stack_size);
@@ -456,7 +440,8 @@ void gc_post_handshake(gc_status_type s);
void gc_wait_handshake();
void gc_start_collector();
void gc_mutator_thread_blocked(gc_thread_data * thd, object cont);
-void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied);
+void gc_mutator_thread_runnable(gc_thread_data * thd, object result,
+ object maybe_copied);
void Cyc_make_shared_object(void *data, object k, object obj);
#define set_thread_blocked(d, c) \
gc_mutator_thread_blocked(((gc_thread_data *)d), (c))
@@ -523,7 +508,6 @@ void Cyc_make_shared_object(void *data, object k, object obj);
*/
#define forward(obj) (((pair_type *) obj)->pair_car)
-
/**
* \defgroup gc_minor_mut Mutation table
* @brief Mutation table to support the minor GC write barrier
@@ -538,7 +522,8 @@ void clear_mutations(void *data);
* @brief Minor GC write barrier to ensure there are no references to stack objects from the heap.
*/
/**@{*/
-object transport_stack_value(gc_thread_data *data, object var, object value, int *run_gc);
+object transport_stack_value(gc_thread_data * data, object var, object value,
+ int *run_gc);
/**@}*/
/**@}*/
@@ -550,8 +535,9 @@ object transport_stack_value(gc_thread_data *data, object var, object value, int
* \defgroup ffi Foreign Function Interface
*/
/**@{*/
-object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *args);
-object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg);
+object Cyc_scm_call(gc_thread_data * parent_thd, object fnc, int argc,
+ object * args);
+object Cyc_scm_call_no_gc(gc_thread_data * parent_thd, object fnc, object arg);
/**@}*/
/**
@@ -659,10 +645,10 @@ typedef uint32_t char_type;
/**@{*/
/** Function type */
-typedef void (*function_type) (void *data, object clo, int argc, object *args);
+typedef void (*function_type)(void *data, object clo, int argc, object * args);
/** Non-CPS function type */
-typedef object (*inline_function_type) ();
+typedef object(*inline_function_type) ();
/**
* @brief C-variable integration type - wrapper around a Cyclone object pointer
@@ -913,11 +899,8 @@ typedef struct {
* and provides constants for each of the comparison operators.
*/
typedef enum {
- CYC_BN_LTE = -2
- , CYC_BN_LT = MP_LT
- , CYC_BN_EQ = MP_EQ
- , CYC_BN_GT = MP_GT
- , CYC_BN_GTE = 2
+ CYC_BN_LTE = -2, CYC_BN_LT = MP_LT, CYC_BN_EQ = MP_EQ, CYC_BN_GT =
+ MP_GT, CYC_BN_GTE = 2
} bn_cmp_type;
/**
@@ -1089,17 +1072,17 @@ typedef struct {
typedef struct {
gc_header_type hdr;
tag_type tag;
- void *unused; // Protect against forwarding pointer, ideally would not be needed.
+ void *unused; // Protect against forwarding pointer, ideally would not be needed.
FILE *fp;
int mode;
unsigned char flags;
unsigned int line_num;
unsigned int col_num;
unsigned int buf_idx;
- unsigned int tok_start; // Start of token in mem_buf (end is unknown yet)
- unsigned int tok_end; // End of token in tok_buf (start is tok_buf[0])
- char *tok_buf; // Alternative buffer for tokens
- size_t tok_buf_len;
+ unsigned int tok_start; // Start of token in mem_buf (end is unknown yet)
+ unsigned int tok_end; // End of token in tok_buf (start is tok_buf[0])
+ char *tok_buf; // Alternative buffer for tokens
+ size_t tok_buf_len;
char *mem_buf;
size_t mem_buf_len;
unsigned short read_len;
@@ -1168,10 +1151,22 @@ typedef struct {
} vector_type;
typedef vector_type *vector;
-typedef struct { vector_type v; object arr[2]; } vector_2_type;
-typedef struct { vector_type v; object arr[3]; } vector_3_type;
-typedef struct { vector_type v; object arr[4]; } vector_4_type;
-typedef struct { vector_type v; object arr[5]; } vector_5_type;
+typedef struct {
+ vector_type v;
+ object arr[2];
+} vector_2_type;
+typedef struct {
+ vector_type v;
+ object arr[3];
+} vector_3_type;
+typedef struct {
+ vector_type v;
+ object arr[4];
+} vector_4_type;
+typedef struct {
+ vector_type v;
+ object arr[5];
+} vector_5_type;
/** Create a new vector in the nursery */
#define make_empty_vector(v) \
@@ -1296,9 +1291,21 @@ typedef pair_type *pair;
(n))
//typedef list_1_type pair_type;
-typedef struct { pair_type a; pair_type b; } list_2_type;
-typedef struct { pair_type a; pair_type b; pair_type c;} list_3_type;
-typedef struct { pair_type a; pair_type b; pair_type c; pair_type d;} list_4_type;
+typedef struct {
+ pair_type a;
+ pair_type b;
+} list_2_type;
+typedef struct {
+ pair_type a;
+ pair_type b;
+ pair_type c;
+} list_3_type;
+typedef struct {
+ pair_type a;
+ pair_type b;
+ pair_type c;
+ pair_type d;
+} list_4_type;
/**
* Create a pair with a single value.
@@ -1438,7 +1445,7 @@ typedef closure0_type *macro;
* These objects are special and can be statically allocated as an optimization
*/
#define mclosure0(c, f) \
- static closure0_type c = { .hdr.mark = gc_color_red, .hdr.grayed = 0, .tag = closure0_tag, .fn = f, .num_args = -1 }; /* TODO: need a new macro that initializes num_args */
+ static closure0_type c = { .hdr.mark = gc_color_red, .hdr.grayed = 0, .tag = closure0_tag, .fn = f, .num_args = -1 }; /* TODO: need a new macro that initializes num_args */
#define maclosure0(c,f,na) \
closure0_type c; \
@@ -1527,7 +1534,7 @@ struct vpbuffer_t {
};
vpbuffer *vp_create(void);
-void vp_add(vpbuffer *v, void *obj);
+void vp_add(vpbuffer * v, void *obj);
/* Utility functions */
void **vpbuffer_realloc(void **buf, int *len);
@@ -1536,10 +1543,10 @@ void vpbuffer_free(void **buf);
/* Bignum utility functions */
int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty);
-void Cyc_int2bignum(int n, mp_int *bn);
+void Cyc_int2bignum(int n, mp_int * bn);
/* Remaining GC prototypes that require objects to be defined */
-void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src);
+void *gc_alloc_from_bignum(gc_thread_data * data, bignum_type * src);
/**
* Do a minor GC
@@ -1548,5 +1555,6 @@ void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src);
int gc_minor(void *data, object low_limit, object high_limit, closure cont,
object * args, int num_args);
-void Cyc_import_shared_object(void *data, object cont, object filename, object entry_pt_fnc);
+void Cyc_import_shared_object(void *data, object cont, object filename,
+ object entry_pt_fnc);
#endif /* CYCLONE_TYPES_H */
diff --git a/mstreams.c b/mstreams.c
index af5b5838..4ca81fec 100644
--- a/mstreams.c
+++ b/mstreams.c
@@ -41,7 +41,7 @@ int Cyc_have_mstreams()
#endif
}
-object Cyc_heap_alloc_port(void *data, port_type *p);
+object Cyc_heap_alloc_port(void *data, port_type * p);
port_type *Cyc_io_open_input_string(void *data, object str)
{
// Allocate port on the heap so the location of mem_buf does not change
@@ -49,7 +49,7 @@ port_type *Cyc_io_open_input_string(void *data, object str)
make_input_port(sp, NULL, CYC_IO_BUF_LEN);
Cyc_check_str(data, str);
- p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+ p = (port_type *) Cyc_heap_alloc_port(data, &sp);
errno = 0;
#if CYC_HAVE_FMEMOPEN
p->str_bv_in_mem_buf = malloc(sizeof(char) * (string_len(str) + 1));
@@ -57,8 +57,9 @@ port_type *Cyc_io_open_input_string(void *data, object str)
memcpy(p->str_bv_in_mem_buf, string_str(str), string_len(str));
p->fp = fmemopen(p->str_bv_in_mem_buf, string_len(str), "r");
#endif
- if (p->fp == NULL){
- Cyc_rt_raise2(data, "Unable to open input memory stream", obj_int2obj(errno));
+ if (p->fp == NULL) {
+ Cyc_rt_raise2(data, "Unable to open input memory stream",
+ obj_int2obj(errno));
}
return p;
}
@@ -70,16 +71,17 @@ port_type *Cyc_io_open_input_bytevector(void *data, object bv)
make_input_port(sp, NULL, CYC_IO_BUF_LEN);
Cyc_check_bvec(data, bv);
- p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+ p = (port_type *) Cyc_heap_alloc_port(data, &sp);
errno = 0;
#if CYC_HAVE_FMEMOPEN
- p->str_bv_in_mem_buf = malloc(sizeof(char) * ((bytevector)bv)->len);
- p->str_bv_in_mem_buf_len = ((bytevector)bv)->len;
- memcpy(p->str_bv_in_mem_buf, ((bytevector)bv)->data, ((bytevector)bv)->len);
- p->fp = fmemopen(p->str_bv_in_mem_buf, ((bytevector)bv)->len, "r");
+ p->str_bv_in_mem_buf = malloc(sizeof(char) * ((bytevector) bv)->len);
+ p->str_bv_in_mem_buf_len = ((bytevector) bv)->len;
+ memcpy(p->str_bv_in_mem_buf, ((bytevector) bv)->data, ((bytevector) bv)->len);
+ p->fp = fmemopen(p->str_bv_in_mem_buf, ((bytevector) bv)->len, "r");
#endif
- if (p->fp == NULL){
- Cyc_rt_raise2(data, "Unable to open input memory stream", obj_int2obj(errno));
+ if (p->fp == NULL) {
+ Cyc_rt_raise2(data, "Unable to open input memory stream",
+ obj_int2obj(errno));
}
return p;
}
@@ -89,20 +91,21 @@ port_type *Cyc_io_open_output_string(void *data)
// Allocate port on the heap so the location of mem_buf does not change
port_type *p;
make_port(sp, NULL, 0);
- p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+ p = (port_type *) Cyc_heap_alloc_port(data, &sp);
errno = 0;
#if CYC_HAVE_OPEN_MEMSTREAM
p->fp = open_memstream(&(p->str_bv_in_mem_buf), &(p->str_bv_in_mem_buf_len));
#endif
- if (p->fp == NULL){
- Cyc_rt_raise2(data, "Unable to open output memory stream", obj_int2obj(errno));
+ if (p->fp == NULL) {
+ Cyc_rt_raise2(data, "Unable to open output memory stream",
+ obj_int2obj(errno));
}
return p;
}
void Cyc_io_get_output_string(void *data, object cont, object port)
{
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
Cyc_check_port(data, port);
if (p->fp) {
fflush(p->fp);
@@ -112,14 +115,14 @@ void Cyc_io_get_output_string(void *data, object cont, object port)
}
{
make_string_with_len(s, p->str_bv_in_mem_buf, p->str_bv_in_mem_buf_len);
- s.num_cp = Cyc_utf8_count_code_points((uint8_t *)string_str(&s));
+ s.num_cp = Cyc_utf8_count_code_points((uint8_t *) string_str(&s));
return_closcall1(data, cont, &s);
}
}
void Cyc_io_get_output_bytevector(void *data, object cont, object port)
{
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
Cyc_check_port(data, port);
if (p->fp) {
fflush(p->fp);
@@ -130,8 +133,8 @@ void Cyc_io_get_output_bytevector(void *data, object cont, object port)
{
object bv;
alloc_bytevector(data, bv, p->str_bv_in_mem_buf_len);
- memcpy(((bytevector)bv)->data, p->str_bv_in_mem_buf, p->str_bv_in_mem_buf_len);
+ memcpy(((bytevector) bv)->data, p->str_bv_in_mem_buf,
+ p->str_bv_in_mem_buf_len);
return_closcall1(data, cont, bv);
}
}
-
diff --git a/runtime.c b/runtime.c
index 3b2733e6..3448cecb 100644
--- a/runtime.c
+++ b/runtime.c
@@ -24,13 +24,16 @@
static const int MAX_DEPTH = 512;
-static uint32_t Cyc_utf8_decode(uint32_t* state, uint32_t* codep, uint32_t byte);
-static int Cyc_utf8_count_code_points_and_bytes(uint8_t* s, char_type *codepoint, int *cpts, int *bytes);
+static uint32_t Cyc_utf8_decode(uint32_t * state, uint32_t * codep,
+ uint32_t byte);
+static int Cyc_utf8_count_code_points_and_bytes(uint8_t * s,
+ char_type * codepoint,
+ int *cpts, int *bytes);
/* Error checking section - type mismatch, num args, etc */
/* Type names to use for error messages */
const char *tag_names[] = {
- /*closure0_tag */ "procedure"
+ /*closure0_tag */ "procedure"
/*closure1_tag */ , "procedure"
/*closureN_tag */ , "procedure"
/*macro_tag */ , "macro"
@@ -51,10 +54,10 @@ const char *tag_names[] = {
/*string_tag */ , "string"
/*symbol_tag */ , "symbol"
/*vector_tag */ , "vector"
- /*complex_num_tag*/ , "complex number"
- /*atomic_tag*/ , "atomic"
- /*void_tag*/ , "void"
- /*record_tag*/ , "record"
+ /*complex_num_tag */ , "complex number"
+ /*atomic_tag */ , "atomic"
+ /*void_tag */ , "void"
+ /*record_tag */ , "record"
, "Reserved for future use"
};
@@ -63,7 +66,8 @@ void Cyc_invalid_type_error(void *data, int tag, object found)
char buf[256];
#if GC_DEBUG_TRACE
// Object address can be very useful for GC debugging
- snprintf(buf, 255, "Invalid type: expected %s, found (%p) ", tag_names[tag], found);
+ snprintf(buf, 255, "Invalid type: expected %s, found (%p) ", tag_names[tag],
+ found);
#else
snprintf(buf, 255, "Invalid type: expected %s, found ", tag_names[tag]);
#endif
@@ -101,21 +105,21 @@ void Cyc_check_bounds(void *data, const char *label, int len, int index)
#ifdef CYC_HIGH_RES_TIMERS
/* High resolution timers */
#include <time.h>
-long long hrt_get_current()
+long long hrt_get_current()
{
struct timespec now;
clock_gettime(CLOCK_MONOTONIC, &now);
- long long jiffy = (now.tv_sec)*1000000LL + now.tv_nsec/1000; // nano->microseconds
+ long long jiffy = (now.tv_sec) * 1000000LL + now.tv_nsec / 1000; // nano->microseconds
return jiffy;
}
-long long hrt_cmp_current(long long tstamp)
+long long hrt_cmp_current(long long tstamp)
{
long long now = hrt_get_current();
return (now - tstamp);
}
-void hrt_log_delta(const char *label, long long tstamp)
+void hrt_log_delta(const char *label, long long tstamp)
{
static long long initial = 1;
static long long initial_tstamp;
@@ -197,9 +201,9 @@ object Cyc_global_variables = NULL;
int _cyc_argc = 0;
char **_cyc_argv = NULL;
-static symbol_type __EOF = { {0}, eof_tag, ""}; // symbol_type in lieu of custom type
-static symbol_type __VOID = { {0}, void_tag, ""}; // symbol_type in lieu of custom type
-static symbol_type __RECORD = { {0}, record_tag, ""}; // symbol_type in lieu of custom type
+static symbol_type __EOF = { {0}, eof_tag, "" }; // symbol_type in lieu of custom type
+static symbol_type __VOID = { {0}, void_tag, "" }; // symbol_type in lieu of custom type
+static symbol_type __RECORD = { {0}, record_tag, "" }; // symbol_type in lieu of custom type
const object Cyc_EOF = &__EOF;
const object Cyc_VOID = &__VOID;
@@ -222,37 +226,36 @@ void pack_env_variables(void *data, object k)
object head = NULL;
tail = head;
for (; *env != NULL; env++) {
- char *e = *env,
- *eqpos = strchr(e, '=');
+ char *e = *env, *eqpos = strchr(e, '=');
pair_type *p = alloca(sizeof(pair_type));
pair_type *tmp = alloca(sizeof(pair_type));
string_type *sval = alloca(sizeof(string_type));
string_type *svar = alloca(sizeof(string_type));
- svar->hdr.mark = gc_color_red;
+ svar->hdr.mark = gc_color_red;
svar->hdr.grayed = 0;
svar->hdr.immutable = 0;
- svar->tag = string_tag;
+ svar->tag = string_tag;
svar->len = eqpos - e;
svar->str = alloca(sizeof(char) * (svar->len));
strncpy(svar->str, e, svar->len);
(svar->str)[svar->len] = '\0';
- svar->num_cp = Cyc_utf8_count_code_points((uint8_t *)svar->str);
+ svar->num_cp = Cyc_utf8_count_code_points((uint8_t *) svar->str);
if (eqpos) {
eqpos++;
}
- sval->hdr.mark = gc_color_red;
+ sval->hdr.mark = gc_color_red;
sval->hdr.grayed = 0;
sval->hdr.immutable = 0;
- sval->tag = string_tag;
+ sval->tag = string_tag;
sval->len = strlen(eqpos);
- svar->num_cp = Cyc_utf8_count_code_points((uint8_t *)eqpos);
+ svar->num_cp = Cyc_utf8_count_code_points((uint8_t *) eqpos);
sval->str = eqpos;
set_pair(tmp, svar, sval);
set_pair(p, tmp, NULL);
if (head == NULL) {
- tail = head = p;
+ tail = head = p;
} else {
cdr(tail) = p;
tail = p;
@@ -314,6 +317,7 @@ static bool set_insert(ck_hs_t * hs, const void *value)
h = CK_HS_HASH(hs, hs_hash, value);
return ck_hs_put(hs, h, value);
}
+
// End hashset supporting functions
/**
@@ -324,8 +328,7 @@ void gc_init_heap(long heap_size)
{
if (!ck_hs_init(&lib_table,
CK_HS_MODE_OBJECT | CK_HS_MODE_SPMC,
- hs_hash, hs_compare,
- &my_allocator, 32, 43423)) {
+ hs_hash, hs_compare, &my_allocator, 32, 43423)) {
fprintf(stderr, "Unable to initialize library table\n");
exit(1);
}
@@ -340,7 +343,6 @@ void gc_init_heap(long heap_size)
fprintf(stderr, "Unable to initialize symbol_table_lock mutex\n");
exit(1);
}
-
//ht_test(); // JAE - DEBUGGING!!
}
@@ -360,48 +362,50 @@ object Cyc_global_set(void *thd, object identifier, object * glo, object value)
return value;
}
-static void Cyc_global_set_cps_gc_return(void *data, object cont, int argc, object *args) //object glo_obj, object val, object next)
+static void Cyc_global_set_cps_gc_return(void *data, object cont, int argc, object * args) //object glo_obj, object val, object next)
{
object glo_obj = args[0];
object val = args[1];
object next = args[2];
- object *glo = (object *)glo_obj;
+ object *glo = (object *) glo_obj;
if (*glo != val) {
*(glo) = val;
}
- closcall1(data, (closure)next, val);
+ closcall1(data, (closure) next, val);
}
-object Cyc_global_set_cps(void *thd, object cont, object identifier, object * glo, object value)
+object Cyc_global_set_cps(void *thd, object cont, object identifier,
+ object * glo, object value)
{
int do_gc = 0;
- value = transport_stack_value(thd, NULL, value, &do_gc); // glo cannot be thread-local!
+ value = transport_stack_value(thd, NULL, value, &do_gc); // glo cannot be thread-local!
gc_mut_update((gc_thread_data *) thd, *glo, value);
if (do_gc) {
// Ensure global is a root. We need to do this here to ensure
// global and all its children are relocated to the heap.
cvar_type cv = { {0}, cvar_tag, glo };
gc_thread_data *data = (gc_thread_data *) thd;
- data->mutations = vpbuffer_add(data->mutations,
- &(data->mutation_buflen),
- data->mutation_count,
- &cv);
+ data->mutations = vpbuffer_add(data->mutations,
+ &(data->mutation_buflen),
+ data->mutation_count, &cv);
data->mutation_count++;
// Run GC, then do the actual assignment with heap objects
- mclosure0(clo, (function_type)Cyc_global_set_cps_gc_return);
- object buf[3]; buf[0] = (object)glo; buf[1] = value; buf[2] = cont;
+ mclosure0(clo, (function_type) Cyc_global_set_cps_gc_return);
+ object buf[3];
+ buf[0] = (object) glo;
+ buf[1] = value;
+ buf[2] = cont;
GC(data, &clo, buf, 3);
}
if (*glo != value) {
- *(glo) = value; // Already have heap objs, do assignment now
+ *(glo) = value; // Already have heap objs, do assignment now
}
return value;
}
-
static boolean_type t_boolean = { {0}, boolean_tag, "t" };
static boolean_type f_boolean = { {0}, boolean_tag, "f" };
-static symbol_type Cyc_void_symbol = { {0}, symbol_tag, ""};
+static symbol_type Cyc_void_symbol = { {0}, symbol_tag, "" };
const object boolean_t = &t_boolean;
const object boolean_f = &f_boolean;
@@ -426,14 +430,18 @@ void Cyc_st_print(void *data, FILE * out)
gc_thread_data *thd = (gc_thread_data *) data;
int n = 1;
int i = (thd->stack_trace_idx - 1);
- if (i < 0) { i = MAX_STACK_TRACES - 1; }
+ if (i < 0) {
+ i = MAX_STACK_TRACES - 1;
+ }
while (i != thd->stack_trace_idx) {
if (thd->stack_traces[i]) {
fprintf(out, "[%d] %s\n", n++, thd->stack_traces[i]);
}
i = (i - 1);
- if (i < 0) { i = MAX_STACK_TRACES - 1; }
+ if (i < 0) {
+ i = MAX_STACK_TRACES - 1;
+ }
}
}
@@ -461,7 +469,7 @@ static char *_strdup(const char *s)
static object find_symbol_by_name(const char *name)
{
- symbol_type tmp = { {0}, symbol_tag, name};
+ symbol_type tmp = { {0}, symbol_tag, name };
object result = set_get(&symbol_table, &tmp);
return result;
}
@@ -483,7 +491,7 @@ object add_symbol(symbol_type * psym)
static object add_symbol_by_name(const char *name)
{
- symbol_type sym = { {0}, symbol_tag, _strdup(name)};
+ symbol_type sym = { {0}, symbol_tag, _strdup(name) };
symbol_type *psym = malloc(sizeof(symbol_type));
memcpy(psym, &sym, sizeof(symbol_type));
return add_symbol(psym);
@@ -504,7 +512,7 @@ object find_or_add_symbol(const char *name)
/* Library table */
object is_library_loaded(const char *name)
{
- symbol_type tmp = { {0}, symbol_tag, name};
+ symbol_type tmp = { {0}, symbol_tag, name };
object result = set_get(&lib_table, &tmp);
if (result)
return boolean_t;
@@ -513,7 +521,7 @@ object is_library_loaded(const char *name)
object register_library(const char *name)
{
- symbol_type sym = { {0}, symbol_tag, _strdup(name)};
+ symbol_type sym = { {0}, symbol_tag, _strdup(name) };
symbol_type *psym = malloc(sizeof(symbol_type));
memcpy(psym, &sym, sizeof(symbol_type));
// Reuse mutex since lib inserts will be rare
@@ -522,8 +530,8 @@ object register_library(const char *name)
pthread_mutex_unlock(&symbol_table_lock);
return boolean_t;
}
-/* END Library table */
+/* END Library table */
/* Global table */
list global_table = NULL;
@@ -555,7 +563,7 @@ void debug_dump_globals()
}
}
-void Cyc_set_globals_changed(gc_thread_data *thd)
+void Cyc_set_globals_changed(gc_thread_data * thd)
{
thd->globals_changed = 1;
}
@@ -573,7 +581,8 @@ void Cyc_set_globals_changed(gc_thread_data *thd)
* @param run_gc OUT parameter, returns 1 if minor GC needs to be invoked
* @return Pointer to `var` object
*/
-object transport_stack_value(gc_thread_data *data, object var, object value, int *run_gc)
+object transport_stack_value(gc_thread_data * data, object var, object value,
+ int *run_gc)
{
char tmp;
int inttmp, *heap_grown = &inttmp;
@@ -583,46 +592,49 @@ object transport_stack_value(gc_thread_data *data, object var, object value, int
// a heap variable to point to a stack var.
if (!gc_is_stack_obj(&tmp, data, var) && gc_is_stack_obj(&tmp, data, value)) {
// Must move `value` to the heap to allow use by other threads
- switch(type_of(value)) {
- case string_tag:
- case bytevector_tag:
- if (immutable(value)) {
- // Safe to transport now
- object hp = gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data, heap_grown);
- return hp;
- }
- // Need to GC if obj is mutable, EG: a string could be mutated so we can't
- // have multiple copies of the object running around
- *run_gc = 1;
- return value;
- case double_tag:
- case port_tag:
- case c_opaque_tag:
- case complex_num_tag: {
+ switch (type_of(value)) {
+ case string_tag:
+ case bytevector_tag:
+ if (immutable(value)) {
+ // Safe to transport now
+ object hp =
+ gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data,
+ heap_grown);
+ return hp;
+ }
+ // Need to GC if obj is mutable, EG: a string could be mutated so we can't
+ // have multiple copies of the object running around
+ *run_gc = 1;
+ return value;
+ case double_tag:
+ case port_tag:
+ case c_opaque_tag:
+ case complex_num_tag:{
// These objects are immutable, transport now
- object hp = gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data, heap_grown);
+ object hp =
+ gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data,
+ heap_grown);
return hp;
}
// Objs w/children force minor GC to guarantee everything is relocated:
- case cvar_tag:
- case closure0_tag:
- case closure1_tag:
- case closureN_tag:
- case pair_tag:
- case vector_tag:
- *run_gc = 1;
- return value;
- default:
- // Other object types are not stack-allocated so should never get here
- printf("Invalid shared object type %d\n", type_of(value));
- exit(1);
+ case cvar_tag:
+ case closure0_tag:
+ case closure1_tag:
+ case closureN_tag:
+ case pair_tag:
+ case vector_tag:
+ *run_gc = 1;
+ return value;
+ default:
+ // Other object types are not stack-allocated so should never get here
+ printf("Invalid shared object type %d\n", type_of(value));
+ exit(1);
}
}
return value;
}
-
/* Mutation table functions
*
* Keep track of mutations (EG: set-car!) so we can avoid having heap
@@ -647,21 +659,18 @@ void add_mutation(void *data, object var, int index, object value)
// as a container to store "real" stack values that must be moved
// by the collector. In this case we pass -2 to force collection of
// these objects regardless of whether var is on the heap.
- if ( (!gc_is_stack_obj(&tmp, data, var) &&
- gc_is_stack_obj(&tmp, data, value)) ||
- index == -2) {
- thd->mutations = vpbuffer_add(thd->mutations,
- &(thd->mutation_buflen),
- thd->mutation_count,
- var);
+ if ((!gc_is_stack_obj(&tmp, data, var) &&
+ gc_is_stack_obj(&tmp, data, value)) || index == -2) {
+ thd->mutations = vpbuffer_add(thd->mutations,
+ &(thd->mutation_buflen),
+ thd->mutation_count, var);
thd->mutation_count++;
if (index >= 0) {
// For vectors only, add index as another var. That way
// the write barrier only needs to inspect the mutated index.
- thd->mutations = vpbuffer_add(thd->mutations,
- &(thd->mutation_buflen),
- thd->mutation_count,
- obj_int2obj(index));
+ thd->mutations = vpbuffer_add(thd->mutations,
+ &(thd->mutation_buflen),
+ thd->mutation_count, obj_int2obj(index));
thd->mutation_count++;
}
}
@@ -687,7 +696,8 @@ object Cyc_glo_eval_from_c = NULL;
* @param argc Unused, just here to maintain calling convention
* @param args Argument buffer, index 0 is object containing data for the error
*/
-object Cyc_default_exception_handler(void *data, object _, int argc, object *args)
+object Cyc_default_exception_handler(void *data, object _, int argc,
+ object * args)
{
object err = args[0];
int is_msg = 1;
@@ -699,9 +709,7 @@ object Cyc_default_exception_handler(void *data, object _, int argc, object *arg
// Error is list of form (type arg1 ... argn)
err = cdr(err); // skip type field
for (; (err != NULL); err = cdr(err)) { // output with no enclosing parens
- if (is_msg &&
- is_object_type(car(err)) &&
- type_of(car(err)) == string_tag) {
+ if (is_msg && is_object_type(car(err)) && type_of(car(err)) == string_tag) {
is_msg = 0;
Cyc_display(data, car(err), stderr);
if (cdr(err)) {
@@ -799,9 +807,9 @@ static int equal(object x, object y, int depth)
if (obj_is_int(x))
return (obj_is_int(y) && x == y) ||
(is_object_type(y) &&
- (
- (type_of(y) == integer_tag && integer_value(y) == obj_obj2int(x)) ||
- (type_of(y) == bignum_tag && Cyc_bignum_cmp(MP_EQ, x, -1, y, bignum_tag))
+ ((type_of(y) == integer_tag && integer_value(y) == obj_obj2int(x)) ||
+ (type_of(y) == bignum_tag
+ && Cyc_bignum_cmp(MP_EQ, x, -1, y, bignum_tag))
));
switch (type_of(x)) {
case string_tag:
@@ -817,10 +825,12 @@ static int equal(object x, object y, int depth)
type_of(y) == vector_tag &&
((vector) x)->num_elements == ((vector) y)->num_elements) {
int i;
- if (x == y) return 1;
+ if (x == y)
+ return 1;
for (i = 0; i < ((vector) x)->num_elements; i++) {
- if (_equalp(((vector) x)->elements[i], ((vector) y)->elements[i], depth + 1) ==
- boolean_f)
+ if (_equalp
+ (((vector) x)->elements[i], ((vector) y)->elements[i],
+ depth + 1) == boolean_f)
return 0;
}
return 1;
@@ -832,33 +842,33 @@ static int equal(object x, object y, int depth)
((bytevector) x)->len == ((bytevector) y)->len) {
int i;
for (i = 0; i < ((bytevector) x)->len; i++) {
- if (((bytevector)x)->data[i] != ((bytevector)y)->data[i]) {
+ if (((bytevector) x)->data[i] != ((bytevector) y)->data[i]) {
return 0;
}
}
return 1;
}
return 0;
- case bignum_tag: {
- int ty = -1;
- if (is_value_type(y)) {
- if (!obj_is_int(y)) {
- return 0;
+ case bignum_tag:{
+ int ty = -1;
+ if (is_value_type(y)) {
+ if (!obj_is_int(y)) {
+ return 0;
+ }
+ } else {
+ ty = type_of(y);
}
- } else {
- ty = type_of(y);
- }
-
- return Cyc_bignum_cmp(MP_EQ, x, bignum_tag, y, ty);
- // return (is_object_type(y) &&
- // type_of(y) == bignum_tag &&
- // MP_EQ == mp_cmp(&bignum_value(x), &bignum_value(y)));
- }
- //case integer_tag:
- // return (obj_is_int(y) && obj_obj2int(y) == integer_value(x)) ||
- // (is_object_type(y) &&
- // type_of(y) == integer_tag &&
- // ((integer_type *) x)->value == ((integer_type *) y)->value);
+
+ return Cyc_bignum_cmp(MP_EQ, x, bignum_tag, y, ty);
+ // return (is_object_type(y) &&
+ // type_of(y) == bignum_tag &&
+ // MP_EQ == mp_cmp(&bignum_value(x), &bignum_value(y)));
+ }
+ //case integer_tag:
+ // return (obj_is_int(y) && obj_obj2int(y) == integer_value(x)) ||
+ // (is_object_type(y) &&
+ // type_of(y) == integer_tag &&
+ // ((integer_type *) x)->value == ((integer_type *) y)->value);
case complex_num_tag:
return (is_object_type(y) &&
type_of(y) == complex_num_tag &&
@@ -906,8 +916,8 @@ object Cyc_has_vector_cycle(object vec)
{
int i;
// TODO: this is not generic enough
- for (i = 0; i < ((vector)vec)->num_elements; i++) {
- if (((vector)vec)->elements[i] == vec) {
+ for (i = 0; i < ((vector) vec)->num_elements; i++) {
+ if (((vector) vec)->elements[i] == vec) {
return boolean_t;
}
}
@@ -950,7 +960,7 @@ object Cyc_has_cycle(object lst)
object Cyc_is_list(object lst)
{
object slow_lst, fast_lst;
- if (lst == NULL){
+ if (lst == NULL) {
return boolean_t;
} else if (is_value_type(lst)) {
return boolean_f;
@@ -963,13 +973,13 @@ object Cyc_is_list(object lst)
if (fast_lst == NULL)
return boolean_t;
if (Cyc_is_pair(fast_lst) == boolean_f)
- return boolean_f; // Improper list
+ return boolean_f; // Improper list
if ((cdr(fast_lst)) == NULL)
return boolean_t;
if (Cyc_is_pair(cdr(fast_lst)) == boolean_f)
- return boolean_f; // Improper
+ return boolean_f; // Improper
if (slow_lst == fast_lst)
- return boolean_t; // Cycle; we have a list
+ return boolean_t; // Cycle; we have a list
slow_lst = cdr(slow_lst);
fast_lst = cddr(fast_lst);
@@ -999,7 +1009,7 @@ int double2buffer(char *buf, int buf_size, double num)
}
}
-void dispatch_display_va(void *data, object cont, int argc, object *args)
+void dispatch_display_va(void *data, object cont, int argc, object * args)
{
object x = args[0];
object opts = boolean_f;
@@ -1106,12 +1116,12 @@ object _Cyc_display(void *data, object x, FILE * port, int depth)
case integer_tag:
fprintf(port, "%d", ((integer_type *) x)->value);
break;
- case double_tag: {
- char buf[33];
- double2buffer(buf, 32, ((double_type *) x)->value);
- fprintf(port, "%s", buf);
- break;
- }
+ case double_tag:{
+ char buf[33];
+ double2buffer(buf, 32, ((double_type *) x)->value);
+ fprintf(port, "%s", buf);
+ break;
+ }
case string_tag:
fprintf(port, "%s", ((string_type *) x)->str);
break;
@@ -1183,52 +1193,49 @@ object _Cyc_display(void *data, object x, FILE * port, int depth)
}
fprintf(port, ")");
break;
- case bignum_tag: {
- int bufsz;
- char *buf;
- size_t written;
+ case bignum_tag:{
+ int bufsz;
+ char *buf;
+ size_t written;
- BIGNUM_CALL(mp_radix_size(&bignum_value(x), 10, &bufsz));
+ BIGNUM_CALL(mp_radix_size(&bignum_value(x), 10, &bufsz));
- buf = alloca(bufsz);
- if (mp_to_radix(&bignum_value(x), buf, bufsz, &written,10) != 0) {
- fprintf(port, "Error displaying bignum!");
- exit(1);
+ buf = alloca(bufsz);
+ if (mp_to_radix(&bignum_value(x), buf, bufsz, &written, 10) != 0) {
+ fprintf(port, "Error displaying bignum!");
+ exit(1);
+ }
+ fprintf(port, "%s", buf);
+ break;
}
- fprintf(port, "%s", buf);
- break;
- }
- case complex_num_tag: {
- char rbuf[33], ibuf[33];
- const char *plus="+", *empty="";
- double dreal = creal(((complex_num_type *) x)->value);
- double dimag = cimag(((complex_num_type *) x)->value);
- double2buffer(rbuf, 32, dreal);
- double2buffer(ibuf, 32, dimag);
- if (dreal == 0.0) {
- fprintf(port, "%si", ibuf);
- } else {
- fprintf(port, "%s%s%si",
- rbuf,
- (dimag < 0.0) ? empty : plus,
- ibuf);
+ case complex_num_tag:{
+ char rbuf[33], ibuf[33];
+ const char *plus = "+", *empty = "";
+ double dreal = creal(((complex_num_type *) x)->value);
+ double dimag = cimag(((complex_num_type *) x)->value);
+ double2buffer(rbuf, 32, dreal);
+ double2buffer(ibuf, 32, dimag);
+ if (dreal == 0.0) {
+ fprintf(port, "%si", ibuf);
+ } else {
+ fprintf(port, "%s%s%si", rbuf, (dimag < 0.0) ? empty : plus, ibuf);
+ }
+ break;
}
- break;
- }
default:
fprintf(port, "Cyc_display: bad tag x=%d\n", ((closure) x)->tag);
exit(1);
}
-done:
+ done:
return quote_void;
}
-object Cyc_display(void *data, object x, FILE * port)
+object Cyc_display(void *data, object x, FILE * port)
{
return _Cyc_display(data, x, port, 0);
}
-void dispatch_write_va(void *data, object clo, int argc, object *args)
+void dispatch_write_va(void *data, object clo, int argc, object * args)
{
object x = args[0];
object opts = boolean_f;
@@ -1256,7 +1263,7 @@ object Cyc_write_va(void *data, int argc, object x, ...)
object Cyc_write_va_list(void *data, object x, object opts)
{
- FILE *fp = stdout; // OK since this is the internal version of write
+ FILE *fp = stdout; // OK since this is the internal version of write
if (opts != boolean_f) {
Cyc_check_port(data, opts);
fp = ((port_type *) opts)->fp;
@@ -1280,20 +1287,38 @@ static object _Cyc_write(void *data, object x, FILE * port, int depth)
if (obj_is_char(x)) {
char_type c = obj_obj2char(x);
switch (c) {
- case 0: fprintf(port, "#\\null"); break;
- case 7: fprintf(port, "#\\alarm"); break;
- case 8: fprintf(port, "#\\backspace"); break;
- case 9: fprintf(port, "#\\tab"); break;
- case 10: fprintf(port, "#\\newline"); break;
- case 13: fprintf(port, "#\\return"); break;
- case 27: fprintf(port, "#\\escape"); break;
- case 32: fprintf(port, "#\\space"); break;
- case 127: fprintf(port, "#\\delete"); break;
- default: {
- char cbuf[5];
- Cyc_utf8_encode_char(cbuf, 5, c);
- fprintf(port, "#\\%s", cbuf);
+ case 0:
+ fprintf(port, "#\\null");
+ break;
+ case 7:
+ fprintf(port, "#\\alarm");
+ break;
+ case 8:
+ fprintf(port, "#\\backspace");
+ break;
+ case 9:
+ fprintf(port, "#\\tab");
+ break;
+ case 10:
+ fprintf(port, "#\\newline");
break;
+ case 13:
+ fprintf(port, "#\\return");
+ break;
+ case 27:
+ fprintf(port, "#\\escape");
+ break;
+ case 32:
+ fprintf(port, "#\\space");
+ break;
+ case 127:
+ fprintf(port, "#\\delete");
+ break;
+ default:{
+ char cbuf[5];
+ Cyc_utf8_encode_char(cbuf, 5, c);
+ fprintf(port, "#\\%s", cbuf);
+ break;
}
}
return quote_void;
@@ -1303,30 +1328,48 @@ static object _Cyc_write(void *data, object x, FILE * port, int depth)
return quote_void;
}
switch (type_of(x)) {
- case string_tag: {
- //fprintf(port, "\"%s\"", ((string_type *) x)->str);
- char *s = string_str(x);
- fputc('"', port);
- while (*s){
- switch(*s){
- case '\a': fprintf(port, "\\a"); break;
- case '\b': fprintf(port, "\\b"); break;
- case '\f': fprintf(port, "\\f"); break;
- case '\n': fprintf(port, "\\n"); break;
- case '\r': fprintf(port, "\\r"); break;
- case '\t': fprintf(port, "\\t"); break;
- case '\v': fprintf(port, "\\v"); break;
- case '\\': fprintf(port, "\\\\"); break;
- case '\"': fprintf(port, "\\\""); break;
- default:
- fputc(*s, port);
- break;
+ case string_tag:{
+ //fprintf(port, "\"%s\"", ((string_type *) x)->str);
+ char *s = string_str(x);
+ fputc('"', port);
+ while (*s) {
+ switch (*s) {
+ case '\a':
+ fprintf(port, "\\a");
+ break;
+ case '\b':
+ fprintf(port, "\\b");
+ break;
+ case '\f':
+ fprintf(port, "\\f");
+ break;
+ case '\n':
+ fprintf(port, "\\n");
+ break;
+ case '\r':
+ fprintf(port, "\\r");
+ break;
+ case '\t':
+ fprintf(port, "\\t");
+ break;
+ case '\v':
+ fprintf(port, "\\v");
+ break;
+ case '\\':
+ fprintf(port, "\\\\");
+ break;
+ case '\"':
+ fprintf(port, "\\\"");
+ break;
+ default:
+ fputc(*s, port);
+ break;
+ }
+ s++;
}
- s++;
+ fputc('"', port);
+ break;
}
- fputc('"', port);
- break;
- }
case vector_tag:
has_cycle = Cyc_has_cycle(x);
fprintf(port, "#(");
@@ -1384,7 +1427,7 @@ static object _Cyc_write(void *data, object x, FILE * port, int depth)
default:
Cyc_display(data, x, port);
}
-done:
+ done:
return quote_void;
}
@@ -1400,7 +1443,7 @@ object Cyc_write_char(void *data, object c, object port)
Cyc_check_port(data, port);
if (obj_is_char(c)) {
FILE *fp = ((port_type *) port)->fp;
- if (fp){
+ if (fp) {
char cbuf[5];
char_type unbox = obj_obj2char(c);
Cyc_utf8_encode_char(cbuf, 5, unbox);
@@ -1417,7 +1460,7 @@ object Cyc_write_u8(void *data, object c, object port)
Cyc_check_port(data, port);
if (obj_is_int(c)) {
FILE *fp = ((port_type *) port)->fp;
- if (fp){
+ if (fp) {
int i = obj_obj2int(c);
putc(i, fp);
}
@@ -1427,7 +1470,8 @@ object Cyc_write_u8(void *data, object c, object port)
return quote_void;
}
-object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end)
+object Cyc_write_bytevector(void *data, object bvec, object port, object start,
+ object end)
{
Cyc_check_port(data, port);
Cyc_check_bvec(data, bvec);
@@ -1440,10 +1484,10 @@ object Cyc_write_bytevector(void *data, object bvec, object port, object start,
int s = obj_obj2int(start);
int e = obj_obj2int(end);
- if (s < 0) {
- s = 0;
- } else if (s > bv->len) {
- s = bv->len;
+ if (s < 0) {
+ s = 0;
+ } else if (s > bv->len) {
+ s = bv->len;
}
if (e < 0 || e > bv->len) {
@@ -1454,9 +1498,8 @@ object Cyc_write_bytevector(void *data, object bvec, object port, object start,
s = e;
}
- size_t rv = fwrite(
- bytes + s,
- sizeof(char), e - s, fp);
+ size_t rv = fwrite(bytes + s,
+ sizeof(char), e - s, fp);
return obj_int2obj(rv);
}
@@ -1548,57 +1591,58 @@ list assoc_cdr(void *data, object x, list l)
}
return boolean_f;
}
+
/* END member and assoc */
-object Cyc_fast_list_2(object ptr, object a1, object a2)
+object Cyc_fast_list_2(object ptr, object a1, object a2)
{
- list_2_type *l = (list_2_type *)ptr;
- set_pair( ((pair)(&(l->b))), a2, NULL);
- set_pair( ((pair)(&(l->a))), a1, ((pair)(&(l->b))));
+ list_2_type *l = (list_2_type *) ptr;
+ set_pair(((pair) (&(l->b))), a2, NULL);
+ set_pair(((pair) (&(l->a))), a1, ((pair) (&(l->b))));
return ptr;
}
-object Cyc_fast_list_3(object ptr, object a1, object a2, object a3)
+object Cyc_fast_list_3(object ptr, object a1, object a2, object a3)
{
- list_3_type *l = (list_3_type *)ptr;
- set_pair( ((pair)(&(l->c))), a3, NULL);
- set_pair( ((pair)(&(l->b))), a2, ((pair)(&(l->c))));
- set_pair( ((pair)(&(l->a))), a1, ((pair)(&(l->b))));
+ list_3_type *l = (list_3_type *) ptr;
+ set_pair(((pair) (&(l->c))), a3, NULL);
+ set_pair(((pair) (&(l->b))), a2, ((pair) (&(l->c))));
+ set_pair(((pair) (&(l->a))), a1, ((pair) (&(l->b))));
return ptr;
}
-object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4)
+object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4)
{
- list_4_type *l = (list_4_type *)ptr;
- set_pair( ((pair)(&(l->d))), a4, NULL);
- set_pair( ((pair)(&(l->c))), a3, ((pair)(&(l->d))));
- set_pair( ((pair)(&(l->b))), a2, ((pair)(&(l->c))));
- set_pair( ((pair)(&(l->a))), a1, ((pair)(&(l->b))));
+ list_4_type *l = (list_4_type *) ptr;
+ set_pair(((pair) (&(l->d))), a4, NULL);
+ set_pair(((pair) (&(l->c))), a3, ((pair) (&(l->d))));
+ set_pair(((pair) (&(l->b))), a2, ((pair) (&(l->c))));
+ set_pair(((pair) (&(l->a))), a1, ((pair) (&(l->b))));
return ptr;
}
-object Cyc_fast_vector_2(object ptr, object a1, object a2)
+object Cyc_fast_vector_2(object ptr, object a1, object a2)
{
- vector_2_type *v = (vector_2_type *)ptr;
- v->v.hdr.mark = gc_color_red;
- v->v.hdr.grayed = 0;
- v->v.hdr.immutable = 0;
- v->v.tag = vector_tag;
- v->v.num_elements = 2;
+ vector_2_type *v = (vector_2_type *) ptr;
+ v->v.hdr.mark = gc_color_red;
+ v->v.hdr.grayed = 0;
+ v->v.hdr.immutable = 0;
+ v->v.tag = vector_tag;
+ v->v.num_elements = 2;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
return ptr;
}
-object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3)
+object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3)
{
- vector_3_type *v = (vector_3_type *)ptr;
- v->v.hdr.mark = gc_color_red;
- v->v.hdr.grayed = 0;
- v->v.hdr.immutable = 0;
- v->v.tag = vector_tag;
- v->v.num_elements = 3;
+ vector_3_type *v = (vector_3_type *) ptr;
+ v->v.hdr.mark = gc_color_red;
+ v->v.hdr.grayed = 0;
+ v->v.hdr.immutable = 0;
+ v->v.tag = vector_tag;
+ v->v.num_elements = 3;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
@@ -1606,14 +1650,14 @@ object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3)
return ptr;
}
-object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4)
+object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4)
{
- vector_4_type *v = (vector_4_type *)ptr;
- v->v.hdr.mark = gc_color_red;
- v->v.hdr.grayed = 0;
- v->v.hdr.immutable = 0;
- v->v.tag = vector_tag;
- v->v.num_elements = 4;
+ vector_4_type *v = (vector_4_type *) ptr;
+ v->v.hdr.mark = gc_color_red;
+ v->v.hdr.grayed = 0;
+ v->v.hdr.immutable = 0;
+ v->v.tag = vector_tag;
+ v->v.num_elements = 4;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
@@ -1622,14 +1666,15 @@ object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4)
return ptr;
}
-object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4, object a5)
+object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4,
+ object a5)
{
- vector_5_type *v = (vector_5_type *)ptr;
- v->v.hdr.mark = gc_color_red;
- v->v.hdr.grayed = 0;
- v->v.hdr.immutable = 0;
- v->v.tag = vector_tag;
- v->v.num_elements = 5;
+ vector_5_type *v = (vector_5_type *) ptr;
+ v->v.hdr.mark = gc_color_red;
+ v->v.hdr.grayed = 0;
+ v->v.hdr.immutable = 0;
+ v->v.tag = vector_tag;
+ v->v.num_elements = 5;
v->v.elements = v->arr;
v->v.elements[0] = a1;
v->v.elements[1] = a2;
@@ -1640,15 +1685,13 @@ object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4,
}
// Internal function, do not use this anywhere outside the runtime
-object Cyc_heap_alloc_port(void *data, port_type *stack_p)
+object Cyc_heap_alloc_port(void *data, port_type * stack_p)
{
object p = NULL;
int heap_grown;
- p = gc_alloc(((gc_thread_data *)data)->heap,
+ p = gc_alloc(((gc_thread_data *) data)->heap,
sizeof(port_type),
- (char *)stack_p,
- (gc_thread_data *)data,
- &heap_grown);
+ (char *)stack_p, (gc_thread_data *) data, &heap_grown);
return p;
}
@@ -1659,10 +1702,9 @@ object _equalp(object x, object y, int depth)
{
int second_cycle = 0;
object slow_lis = x, fast_lis = NULL;
- object pcar_x = &second_cycle, pcar_y = &second_cycle; // never a car value
+ object pcar_x = &second_cycle, pcar_y = &second_cycle; // never a car value
- if (Cyc_is_pair(x) == boolean_t &&
- Cyc_is_pair(cdr(x)) == boolean_t){
+ if (Cyc_is_pair(x) == boolean_t && Cyc_is_pair(cdr(x)) == boolean_t) {
fast_lis = cdr(x);
}
@@ -1675,8 +1717,7 @@ object _equalp(object x, object y, int depth)
return boolean_f;
// Both objects are lists at this point, compare cars
- if (pcar_x == car(x) &&
- pcar_y == car(y)) {
+ if (pcar_x == car(x) && pcar_y == car(y)) {
// do nothing, already equal
} else {
if (boolean_f == _equalp(car(x), car(y), depth + 1))
@@ -1689,11 +1730,9 @@ object _equalp(object x, object y, int depth)
if (fast_lis == NULL ||
Cyc_is_pair(fast_lis) == boolean_f ||
cdr(fast_lis) == NULL ||
- Cyc_is_pair(cdr(fast_lis)) == boolean_f ||
- cddr(fast_lis) == NULL){
+ Cyc_is_pair(cdr(fast_lis)) == boolean_f || cddr(fast_lis) == NULL) {
continue;
}
-
// If there is a cycle, handle it
if (slow_lis == fast_lis) {
// if this is y, both lists have cycles and are equal, return #t
@@ -1743,8 +1782,7 @@ object Cyc_num_cmp_va_list(void *data, int argc,
}
object Cyc_num_cmp_list(void *data, int argc,
- int (fn_op(void *, object, object)),
- object *args)
+ int (fn_op(void *, object, object)), object * args)
{
int i;
object n, next;
@@ -1790,10 +1828,10 @@ object Cyc_bignum_normalize(void *data, object n)
return result;
}
-void Cyc_int2bignum(int n, mp_int *bn)
+void Cyc_int2bignum(int n, mp_int * bn)
{
mp_set_ul(bn, abs(n));
- if (n < 0) {
+ if (n < 0) {
BIGNUM_CALL(mp_neg(bn, bn));
}
}
@@ -1805,13 +1843,13 @@ int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty)
if (tx == bignum_tag && ty == bignum_tag) {
cmp = mp_cmp(&bignum_value(x), &bignum_value(y));
- } else if (tx == bignum_tag && ty == -1) { \
+ } else if (tx == bignum_tag && ty == -1) {
// JAE TODO: make a macro out of this, and use for other BN calls
mp_init(&tmp) ? fprintf(stderr, "Error initializing bignum"), exit(1) : 0;
Cyc_int2bignum(obj_obj2int(y), &tmp);
cmp = mp_cmp(&bignum_value(x), &tmp);
mp_clear(&tmp);
- } else if (tx == -1 && ty == bignum_tag) { \
+ } else if (tx == -1 && ty == bignum_tag) {
BIGNUM_CALL(mp_init(&tmp));
Cyc_int2bignum(obj_obj2int(x), &tmp);
cmp = mp_cmp(&tmp, &bignum_value(y));
@@ -1821,8 +1859,8 @@ int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty)
}
return (cmp == type) ||
- ((type == CYC_BN_GTE && cmp > MP_LT) ||
- (type == CYC_BN_LTE && cmp < MP_GT));
+ ((type == CYC_BN_GTE && cmp > MP_LT) ||
+ (type == CYC_BN_LTE && cmp < MP_GT));
}
#define declare_num_cmp(FUNC, FUNC_OP, FUNC_FAST_OP, FUNC_APPLY, OP, BN_CMP) \
@@ -1987,11 +2025,16 @@ bad_arg_type_error: \
} \
}
-declare_num_cmp(Cyc_num_eq, Cyc_num_eq_op, Cyc_num_fast_eq_op, dispatch_num_eq, ==, CYC_BN_EQ);
-declare_num_cmp(Cyc_num_gt, Cyc_num_gt_op, Cyc_num_fast_gt_op, dispatch_num_gt, >, CYC_BN_GT);
-declare_num_cmp(Cyc_num_lt, Cyc_num_lt_op, Cyc_num_fast_lt_op, dispatch_num_lt, <, CYC_BN_LT);
-declare_num_cmp(Cyc_num_gte, Cyc_num_gte_op, Cyc_num_fast_gte_op, dispatch_num_gte, >=, CYC_BN_GTE);
-declare_num_cmp(Cyc_num_lte, Cyc_num_lte_op, Cyc_num_fast_lte_op, dispatch_num_lte, <=, CYC_BN_LTE);
+declare_num_cmp(Cyc_num_eq, Cyc_num_eq_op, Cyc_num_fast_eq_op, dispatch_num_eq,
+ ==, CYC_BN_EQ);
+declare_num_cmp(Cyc_num_gt, Cyc_num_gt_op, Cyc_num_fast_gt_op, dispatch_num_gt,
+ >, CYC_BN_GT);
+declare_num_cmp(Cyc_num_lt, Cyc_num_lt_op, Cyc_num_fast_lt_op, dispatch_num_lt,
+ <, CYC_BN_LT);
+declare_num_cmp(Cyc_num_gte, Cyc_num_gte_op, Cyc_num_fast_gte_op,
+ dispatch_num_gte, >=, CYC_BN_GTE);
+declare_num_cmp(Cyc_num_lte, Cyc_num_lte_op, Cyc_num_fast_lte_op,
+ dispatch_num_lte, <=, CYC_BN_LTE);
object Cyc_is_number(object o)
{
@@ -2006,12 +2049,7 @@ object Cyc_is_number(object o)
object Cyc_is_real(object o)
{
- if ((o != NULL) && (obj_is_int(o) ||
- (!is_value_type(o) && (type_of(o) == integer_tag
- || type_of(o) == bignum_tag
- || type_of(o) == double_tag
- || (type_of(o) == complex_num_tag &&
- cimag(complex_num_value(o)) == 0.0))))) // Per R7RS
+ if ((o != NULL) && (obj_is_int(o) || (!is_value_type(o) && (type_of(o) == integer_tag || type_of(o) == bignum_tag || type_of(o) == double_tag || (type_of(o) == complex_num_tag && cimag(complex_num_value(o)) == 0.0))))) // Per R7RS
return boolean_t;
return boolean_f;
}
@@ -2019,10 +2057,11 @@ object Cyc_is_real(object o)
object Cyc_is_integer(object o)
{
if ((o != NULL) && (obj_is_int(o) ||
- (!is_value_type(o) && type_of(o) == integer_tag) ||
- (!is_value_type(o) && type_of(o) == bignum_tag)
- || (!is_value_type(o) && type_of(o) == double_tag && double_value(o) == round(double_value(o)))
- )) // Per R7RS
+ (!is_value_type(o) && type_of(o) == integer_tag) ||
+ (!is_value_type(o) && type_of(o) == bignum_tag)
+ || (!is_value_type(o) && type_of(o) == double_tag
+ && double_value(o) == round(double_value(o)))
+ )) // Per R7RS
return boolean_t;
return boolean_f;
}
@@ -2030,10 +2069,9 @@ object Cyc_is_integer(object o)
object Cyc_is_record(object o)
{
vector v = o;
- if (is_object_type(o) &&
+ if (is_object_type(o) &&
v->tag == vector_tag &&
- v->num_elements > 0 &&
- v->elements[0] == Cyc_RECORD_MARKER) {
+ v->num_elements > 0 && v->elements[0] == Cyc_RECORD_MARKER) {
return boolean_t;
}
return boolean_f;
@@ -2064,10 +2102,9 @@ object Cyc_eqv(object x, object y)
{
if (Cyc_eq(x, y) == boolean_t) {
return boolean_t;
- } else if (Cyc_is_number(x) == boolean_t &&
- equalp(x, y) == boolean_t) {
+ } else if (Cyc_is_number(x) == boolean_t && equalp(x, y) == boolean_t) {
return boolean_t;
- } else {
+ } else {
return boolean_f;
}
}
@@ -2078,9 +2115,7 @@ object Cyc_is_immutable(object obj)
(type_of(obj) == pair_tag ||
type_of(obj) == vector_tag ||
type_of(obj) == bytevector_tag ||
- type_of(obj) == string_tag
- ) &&
- !immutable(obj) ) {
+ type_of(obj) == string_tag) && !immutable(obj)) {
return boolean_f;
}
return boolean_t;
@@ -2149,14 +2184,15 @@ object Cyc_vector_set_unsafe(void *data, object v, object k, object obj)
// Prevent the possibility of a race condition by doing the actual mutation
// after all relevant objects have been relocated to the heap
-static void Cyc_set_car_cps_gc_return(void *data, object _, int argc, object *args)
+static void Cyc_set_car_cps_gc_return(void *data, object _, int argc,
+ object * args)
{
object l = args[0];
object val = args[1];
object next = args[2];
car(l) = val;
- closcall1(data, (closure)next, l);
+ closcall1(data, (closure) next, l);
}
object Cyc_set_car_cps(void *data, object cont, object l, object val)
@@ -2170,26 +2206,30 @@ object Cyc_set_car_cps(void *data, object cont, object l, object val)
int do_gc = 0;
val = transport_stack_value(data, l, val, &do_gc);
gc_mut_update((gc_thread_data *) data, car(l), val);
- add_mutation(data, l, -1, val); // Ensure val is transported
- if (do_gc) { // GC and then do assignment
- mclosure0(clo, (function_type)Cyc_set_car_cps_gc_return);
- object buf[3]; buf[0] = l; buf[1] = val; buf[2] = cont;
+ add_mutation(data, l, -1, val); // Ensure val is transported
+ if (do_gc) { // GC and then do assignment
+ mclosure0(clo, (function_type) Cyc_set_car_cps_gc_return);
+ object buf[3];
+ buf[0] = l;
+ buf[1] = val;
+ buf[2] = cont;
GC(data, &clo, buf, 3);
return NULL;
} else {
- car(l) = val; // Assign now since we have heap objects
+ car(l) = val; // Assign now since we have heap objects
return l;
}
}
-static void Cyc_set_cdr_cps_gc_return(void *data, object _, int argc, object *args)
+static void Cyc_set_cdr_cps_gc_return(void *data, object _, int argc,
+ object * args)
{
object l = args[0];
object val = args[1];
object next = args[2];
cdr(l) = val;
- closcall1(data, (closure)next, l);
+ closcall1(data, (closure) next, l);
}
object Cyc_set_cdr_cps(void *data, object cont, object l, object val)
@@ -2204,30 +2244,35 @@ object Cyc_set_cdr_cps(void *data, object cont, object l, object val)
val = transport_stack_value(data, l, val, &do_gc);
gc_mut_update((gc_thread_data *) data, cdr(l), val);
- add_mutation(data, l, -1, val); // Ensure val is transported
- if (do_gc) { // GC and then to assignment
- mclosure0(clo, (function_type)Cyc_set_cdr_cps_gc_return);
- object buf[3]; buf[0] = l; buf[1] = val; buf[2] = cont;
+ add_mutation(data, l, -1, val); // Ensure val is transported
+ if (do_gc) { // GC and then to assignment
+ mclosure0(clo, (function_type) Cyc_set_cdr_cps_gc_return);
+ object buf[3];
+ buf[0] = l;
+ buf[1] = val;
+ buf[2] = cont;
GC(data, &clo, buf, 3);
return NULL;
} else {
- cdr(l) = val; // Assign now since we have heap objects
+ cdr(l) = val; // Assign now since we have heap objects
return l;
}
}
-static void Cyc_vector_set_cps_gc_return(void *data, object _, int argc, object *args)
+static void Cyc_vector_set_cps_gc_return(void *data, object _, int argc,
+ object * args)
{
- object vec = args[0];
- object idx = args[1];
- object val = args[2];
+ object vec = args[0];
+ object idx = args[1];
+ object val = args[2];
object next = args[3];
int i = obj_obj2int(idx);
((vector) vec)->elements[i] = val;
- closcall1(data, (closure)next, vec);
+ closcall1(data, (closure) next, vec);
}
-object Cyc_vector_set_cps(void *data, object cont, object v, object k, object obj)
+object Cyc_vector_set_cps(void *data, object cont, object v, object k,
+ object obj)
{
int idx;
Cyc_check_vec(data, v);
@@ -2244,31 +2289,40 @@ object Cyc_vector_set_cps(void *data, object cont, object v, object k, object ob
gc_mut_update((gc_thread_data *) data, ((vector) v)->elements[idx], obj);
add_mutation(data, v, idx, obj);
- if (do_gc) { // GC and then do assignment
- mclosure0(clo, (function_type)Cyc_vector_set_cps_gc_return);
- object buf[4]; buf[0] = v; buf[1] = k; buf[2] = obj; buf[3] = cont;
+ if (do_gc) { // GC and then do assignment
+ mclosure0(clo, (function_type) Cyc_vector_set_cps_gc_return);
+ object buf[4];
+ buf[0] = v;
+ buf[1] = k;
+ buf[2] = obj;
+ buf[3] = cont;
GC(data, &clo, buf, 4);
return NULL;
} else {
- ((vector) v)->elements[idx] = obj; // Assign now since we have heap objs
- return v; // Let caller pass this to cont
+ ((vector) v)->elements[idx] = obj; // Assign now since we have heap objs
+ return v; // Let caller pass this to cont
}
}
-object Cyc_vector_set_unsafe_cps(void *data, object cont, object v, object k, object obj)
+object Cyc_vector_set_unsafe_cps(void *data, object cont, object v, object k,
+ object obj)
{
int idx = obj_obj2int(k);
int do_gc = 0;
obj = transport_stack_value(data, v, obj, &do_gc);
gc_mut_update((gc_thread_data *) data, ((vector) v)->elements[idx], obj);
add_mutation(data, v, idx, obj);
- if (do_gc) { // GC and then do assignment
- mclosure0(clo, (function_type)Cyc_vector_set_cps_gc_return);
- object buf[4]; buf[0] = v; buf[1] = k; buf[2] = obj; buf[3] = cont;
+ if (do_gc) { // GC and then do assignment
+ mclosure0(clo, (function_type) Cyc_vector_set_cps_gc_return);
+ object buf[4];
+ buf[0] = v;
+ buf[1] = k;
+ buf[2] = obj;
+ buf[3] = cont;
GC(data, &clo, buf, 4);
return NULL;
} else {
- ((vector) v)->elements[idx] = obj; // Assign now since we have heap objs
+ ((vector) v)->elements[idx] = obj; // Assign now since we have heap objs
return v;
}
}
@@ -2290,9 +2344,7 @@ object Cyc_vector_ref(void *data, object v, object k)
object _unsafe_Cyc_vector_ref(object v, object k)
{
int idx;
- if (Cyc_is_vector(v) == boolean_f ||
- Cyc_is_fixnum(k) == boolean_f)
- {
+ if (Cyc_is_vector(v) == boolean_f || Cyc_is_fixnum(k) == boolean_f) {
return NULL;
}
@@ -2346,7 +2398,7 @@ char *int_to_binary(char *b, int x)
return b;
}
- while (i){
+ while (i) {
if (x & i) {
*b++ = '1';
leading_zeros = 0;
@@ -2386,7 +2438,8 @@ object Cyc_number2string2(void *data, object cont, int argc, object n, ...)
// TODO: just temporary, need to handle this better
Cyc_rt_raise2(data, "number->string - bignum is too large to convert", n);
}
- BIGNUM_CALL(mp_to_radix(&bignum_value(n), buffer, 1024, &written, base_num));
+ BIGNUM_CALL(mp_to_radix
+ (&bignum_value(n), buffer, 1024, &written, base_num));
} else {
if (base_num == 2) {
val = obj_is_int(n) ?
@@ -2412,7 +2465,7 @@ object Cyc_number2string2(void *data, object cont, int argc, object n, ...)
double2buffer(buffer, 1024, ((double_type *) n)->value);
} else if (type_of(n) == complex_num_tag) {
char rbuf[33], ibuf[33];
- const char *plus="+", *empty="";
+ const char *plus = "+", *empty = "";
double dreal = creal(((complex_num_type *) n)->value);
double dimag = cimag(((complex_num_type *) n)->value);
double2buffer(rbuf, 32, dreal);
@@ -2420,10 +2473,8 @@ object Cyc_number2string2(void *data, object cont, int argc, object n, ...)
if (dreal == 0.0) {
snprintf(buffer, 1024, "%si", ibuf);
} else {
- snprintf(buffer, 1024, "%s%s%si",
- rbuf,
- (dimag < 0.0) ? empty : plus,
- ibuf);
+ snprintf(buffer, 1024, "%s%s%si",
+ rbuf, (dimag < 0.0) ? empty : plus, ibuf);
}
} else {
Cyc_rt_raise2(data, "number->string - Unexpected object", n);
@@ -2475,7 +2526,7 @@ object Cyc_list2string(void *data, object cont, object lst)
}
if (!ch) {
len++;
- num_cp++; // Failsafe?
+ num_cp++; // Failsafe?
} else {
Cyc_utf8_encode_char(cbuf, 5, ch);
len += strlen(cbuf);
@@ -2487,15 +2538,15 @@ object Cyc_list2string(void *data, object cont, object lst)
{
object str;
alloc_string(data, str, len, num_cp);
- buf = ((string_type *)str)->str;
+ buf = ((string_type *) str)->str;
while ((lst != NULL)) {
cbox = car(lst);
- ch = obj_obj2char(cbox); // Already validated, can assume chars now
+ ch = obj_obj2char(cbox); // Already validated, can assume chars now
if (!ch) {
i++;
} else {
Cyc_utf8_encode_char(&(buf[i]), 5, ch);
- i += strlen(buf+i);
+ i += strlen(buf + i);
}
lst = cdr(lst);
}
@@ -2524,7 +2575,7 @@ object Cyc_string2number2_(void *data, object cont, int argc, object str, ...)
} else if (base_num == 8) {
result = (int)strtol(string_str(str), NULL, 8);
} else if (base_num == 10) {
- Cyc_string2number_(data, cont, str); // Default processing
+ Cyc_string2number_(data, cont, str); // Default processing
} else if (base_num == 16) {
result = (int)strtol(string_str(str), NULL, 16);
}
@@ -2532,16 +2583,16 @@ object Cyc_string2number2_(void *data, object cont, int argc, object str, ...)
if (result <= 0 || result > CYC_FIXNUM_MAX) {
mp_int tmp;
alloc_bignum(data, bn);
- if (MP_OKAY != mp_read_radix(&(bignum_value(bn)), string_str(str), base_num)) {
+ if (MP_OKAY !=
+ mp_read_radix(&(bignum_value(bn)), string_str(str), base_num)) {
Cyc_rt_raise2(data, "Error converting string to bignum", str);
}
-
// If result is mp_zero and str does not contain a 0, then fail
BIGNUM_CALL(mp_init(&tmp));
mp_zero(&tmp);
if (MP_EQ == mp_cmp(&(bignum_value(bn)), &tmp) &&
NULL == strchr(string_str(str), '0')) {
- _return_closcall1(data, cont, boolean_f);
+ _return_closcall1(data, cont, boolean_f);
}
_return_closcall1(data, cont, Cyc_bignum_normalize(data, bn));
@@ -2554,11 +2605,11 @@ object Cyc_string2number2_(void *data, object cont, int argc, object str, ...)
}
typedef enum {
- STR2INT_SUCCESS,
- STR2INT_OVERFLOW,
- STR2INT_UNDERFLOW,
- STR2INT_INCONVERTIBLE,
- STR2INT_RATIONAL
+ STR2INT_SUCCESS,
+ STR2INT_OVERFLOW,
+ STR2INT_UNDERFLOW,
+ STR2INT_INCONVERTIBLE,
+ STR2INT_RATIONAL
} str2int_errno;
/*
@@ -2581,35 +2632,36 @@ Convert string s to int out.
@return Indicates if the operation succeeded, or why it failed.
*/
-static str2int_errno str2int(int *out, char *s, int base)
+static str2int_errno str2int(int *out, char *s, int base)
{
- char *end;
- if (s[0] == '\0' || isspace((unsigned char) s[0]))
- return STR2INT_INCONVERTIBLE;
- errno = 0;
- long l = strtol(s, &end, base);
- /* Both checks are needed because INT_MAX == LONG_MAX is possible. */
- if (l > CYC_FIXNUM_MAX /*INT_MAX*/ || (errno == ERANGE && l == LONG_MAX)) {
- return STR2INT_OVERFLOW;
- }
- if (l < CYC_FIXNUM_MIN /*INT_MIN*/ || (errno == ERANGE && l == LONG_MIN)) {
- return STR2INT_UNDERFLOW;
- }
- if (*end == '/') {
- return STR2INT_RATIONAL;
- }
- if (*end != '\0') {
- return STR2INT_INCONVERTIBLE;
- }
- *out = l;
- return STR2INT_SUCCESS;
+ char *end;
+ if (s[0] == '\0' || isspace((unsigned char)s[0]))
+ return STR2INT_INCONVERTIBLE;
+ errno = 0;
+ long l = strtol(s, &end, base);
+ /* Both checks are needed because INT_MAX == LONG_MAX is possible. */
+ if (l > CYC_FIXNUM_MAX /*INT_MAX */ || (errno == ERANGE && l == LONG_MAX)) {
+ return STR2INT_OVERFLOW;
+ }
+ if (l < CYC_FIXNUM_MIN /*INT_MIN */ || (errno == ERANGE && l == LONG_MIN)) {
+ return STR2INT_UNDERFLOW;
+ }
+ if (*end == '/') {
+ return STR2INT_RATIONAL;
+ }
+ if (*end != '\0') {
+ return STR2INT_INCONVERTIBLE;
+ }
+ *out = l;
+ return STR2INT_SUCCESS;
}
int str_is_bignum(str2int_errno errnum, char *c)
{
- if (errnum == STR2INT_INCONVERTIBLE) return 0; // Unexpected chars for int
+ if (errnum == STR2INT_INCONVERTIBLE)
+ return 0; // Unexpected chars for int
- for (;*c; c++) {
+ for (; *c; c++) {
if (!isdigit(*c) && *c != '-') {
return 0;
}
@@ -2652,7 +2704,6 @@ double string2rational(void *data, char *s)
if (MP_OKAY != mp_read_radix(&(bignum_value(bn_denom)), denom, 10)) {
Cyc_rt_raise2(data, "Error converting string to bignum", denom);
}
-
// Prevent memory leak
free(nom);
@@ -2678,7 +2729,7 @@ object Cyc_string2number_(void *data, object cont, object str)
// Could still be a rational if numerator is
// bignum, so in that case do one more scan
((rv == STR2INT_OVERFLOW || rv == STR2INT_UNDERFLOW) &&
- strchr(s, '/') != NULL)) {
+ strchr(s, '/') != NULL)) {
double d = string2rational(data, s);
make_double(result, d);
_return_closcall1(data, cont, &result);
@@ -2733,10 +2784,10 @@ object Cyc_string_cmp(void *data, object str1, object str2)
((string_type *) str2)->str));
}
-void dispatch_string_91append(void *data, object clo, int _argc, object *_args)
+void dispatch_string_91append(void *data, object clo, int _argc, object * _args)
{
- int argc = _argc - 1; // Skip continuation
- object *args = _args + 1; // Skip continuation
+ int argc = _argc - 1; // Skip continuation
+ object *args = _args + 1; // Skip continuation
int i = 0, total_cp = 0, total_len = 1;
int *len = alloca(sizeof(int) * argc);
char *buffer, *bufferp, **str = alloca(sizeof(char *) * argc);
@@ -2744,15 +2795,15 @@ void dispatch_string_91append(void *data, object clo, int _argc, object *_args)
for (i = 0; i < argc; i++) {
tmp = args[i];
Cyc_check_str(data, tmp);
- str[i] = ((string_type *)tmp)->str;
+ str[i] = ((string_type *) tmp)->str;
len[i] = string_len((tmp));
total_len += len[i];
total_cp += string_num_cp((tmp));
}
buffer = bufferp = alloca(sizeof(char) * total_len);
for (i = 0; i < argc; i++) {
- memcpy(bufferp, str[i], len[i]);
- bufferp += len[i];
+ memcpy(bufferp, str[i], len[i]);
+ bufferp += len[i];
}
*bufferp = '\0';
make_string(result, buffer);
@@ -2770,7 +2821,7 @@ object Cyc_string_append(void *data, object cont, int argc, object str1, ...)
object tmp;
if (argc > 0) {
Cyc_check_str(data, str1);
- str[i] = ((string_type *)str1)->str;
+ str[i] = ((string_type *) str1)->str;
len[i] = string_len((str1));
total_len += len[i];
total_cp += string_num_cp((str1));
@@ -2778,15 +2829,15 @@ object Cyc_string_append(void *data, object cont, int argc, object str1, ...)
for (i = 1; i < argc; i++) {
tmp = va_arg(ap, object);
Cyc_check_str(data, tmp);
- str[i] = ((string_type *)tmp)->str;
+ str[i] = ((string_type *) tmp)->str;
len[i] = string_len((tmp));
total_len += len[i];
total_cp += string_num_cp((tmp));
}
buffer = bufferp = alloca(sizeof(char) * total_len);
for (i = 0; i < argc; i++) {
- memcpy(bufferp, str[i], len[i]);
- bufferp += len[i];
+ memcpy(bufferp, str[i], len[i]);
+ bufferp += len[i];
}
*bufferp = '\0';
make_string(result, buffer);
@@ -2848,9 +2899,9 @@ object Cyc_string_set(void *data, object str, object k, object chr)
int i = 0, count, prev_cp_bytes = 0, cp_idx;
// Find index to change, and how many bytes it is
- for (count = 0; *tmp; ++tmp){
+ for (count = 0; *tmp; ++tmp) {
prev_cp_bytes++;
- if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t)*tmp)){
+ if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t) * tmp)) {
if (count == idx) {
break;
}
@@ -2862,9 +2913,8 @@ object Cyc_string_set(void *data, object str, object k, object chr)
}
cp_idx = i;
if (state != CYC_UTF8_ACCEPT) {
- Cyc_rt_raise2(data, "string-set! - invalid character at index", k);
+ Cyc_rt_raise2(data, "string-set! - invalid character at index", k);
}
-
// Perform actual mutation
//
// Now we know length of start (both in codepoints and bytes),
@@ -2890,12 +2940,14 @@ object Cyc_string_set(void *data, object str, object k, object chr)
// Null terminate the shorter string.
// Ensure string_len is not reduced because original
// value still matters for GC purposes
- raw[len - (prev_cp_bytes - buf_len)] = '\0';
+ raw[len - (prev_cp_bytes - buf_len)] = '\0';
}
// - 3) TODO: buf_len > prev_cp_bytes, will need to allocate more memory (!!)
else {
// TODO: maybe we can try a little harder here, at least in some cases
- Cyc_rt_raise2(data, "string-set! - Unable to allocate memory to store multibyte character", chr);
+ Cyc_rt_raise2(data,
+ "string-set! - Unable to allocate memory to store multibyte character",
+ chr);
}
}
return str;
@@ -2916,7 +2968,6 @@ object Cyc_string_ref(void *data, object str, object k)
if (idx < 0 || idx >= len) {
Cyc_rt_raise2(data, "string-ref - invalid index", k);
}
-
// Take fast path if all chars are just 1 byte
if (string_num_cp(str) == string_len(str)) {
return obj_char2obj(raw[idx]);
@@ -2925,14 +2976,15 @@ object Cyc_string_ref(void *data, object str, object k)
uint32_t state = 0;
int count;
- for (count = 0; *raw; ++raw){
- if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t)*raw)){
- if (count == idx) break; // Reached requested index
+ for (count = 0; *raw; ++raw) {
+ if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t) * raw)) {
+ if (count == idx)
+ break; // Reached requested index
count += 1;
}
}
if (state != CYC_UTF8_ACCEPT)
- Cyc_rt_raise2(data, "string-ref - invalid character at index", k);
+ Cyc_rt_raise2(data, "string-ref - invalid character at index", k);
return obj_char2obj(codepoint);
}
}
@@ -2964,7 +3016,7 @@ object Cyc_substring(void *data, object cont, object str, object start,
e = len;
}
- if (string_num_cp(str) == string_len(str)){ // Fast path for ASCII
+ if (string_num_cp(str) == string_len(str)) { // Fast path for ASCII
make_string_with_len(sub, raw + s, e - s);
_return_closcall1(data, cont, &sub);
} else {
@@ -2972,9 +3024,9 @@ object Cyc_substring(void *data, object cont, object str, object start,
char_type codepoint;
uint32_t state = 0;
int num_ch, cur_ch_bytes = 0, start_i = 0, end_i = 0;
- for (num_ch = 0; *tmp; ++tmp){
+ for (num_ch = 0; *tmp; ++tmp) {
cur_ch_bytes++;
- if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t)*tmp)){
+ if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t) * tmp)) {
end_i += cur_ch_bytes;
num_ch += 1;
cur_ch_bytes = 0;
@@ -2988,7 +3040,7 @@ object Cyc_substring(void *data, object cont, object str, object start,
}
}
if (state != CYC_UTF8_ACCEPT)
- Cyc_rt_raise2(data, "substring - invalid character in string", str);
+ Cyc_rt_raise2(data, "substring - invalid character in string", str);
make_utf8_string_with_len(sub, raw + start_i, end_i - start_i, e - s);
_return_closcall1(data, cont, &sub);
}
@@ -3035,7 +3087,7 @@ object Cyc_installation_dir(void *data, object cont, object type)
*/
object Cyc_compilation_environment(void *data, object cont, object var)
{
- if (Cyc_is_symbol(var) == boolean_t){
+ if (Cyc_is_symbol(var) == boolean_t) {
if (strncmp(((symbol) var)->desc, "cc-prog", 8) == 0) {
char buf[1024];
snprintf(buf, sizeof(buf), "%s", CYC_CC_PROG);
@@ -3070,9 +3122,7 @@ object Cyc_compilation_environment(void *data, object cont, object var)
_return_closcall1(data, cont, &str);
}
}
- Cyc_rt_raise2(data,
- "Cyc-compilation-environment - unrecognized symbol",
- var);
+ Cyc_rt_raise2(data, "Cyc-compilation-environment - unrecognized symbol", var);
return NULL;
}
@@ -3129,17 +3179,14 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
// TODO: mark this thread as potentially blocking before doing
// the allocation????
int heap_grown;
- v = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(vector_type) + element_vec_size,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((vector) v)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ v = gc_alloc(((gc_thread_data *) data)->heap, sizeof(vector_type) + element_vec_size, boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data, &heap_grown);
+ ((vector) v)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((vector) v)->hdr.grayed = 0;
((vector) v)->hdr.immutable = 0;
- ((vector) v)->tag = double_tag; // Avoid race conditions w/GC tracing
- ((vector) v)->num_elements = 0; // until array is filled
- ((vector) v)->elements = (object *)(((char *)v) + sizeof(vector_type));
+ ((vector) v)->tag = double_tag; // Avoid race conditions w/GC tracing
+ ((vector) v)->num_elements = 0; // until array is filled
+ ((vector) v)->elements = (object *) (((char *)v) + sizeof(vector_type));
// Use write barrier to ensure fill is moved to heap if it is on the stack
// Otherwise if next minor GC misses fill it could be catastrophic
car(&tmp_pair) = fill;
@@ -3157,8 +3204,8 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
((vector) v)->elements = NULL;
if (ulen > 0) {
- ((vector) v)->elements =
- (object *) alloca(sizeof(object) * ((vector) v)->num_elements);
+ ((vector) v)->elements =
+ (object *) alloca(sizeof(object) * ((vector) v)->num_elements);
}
}
@@ -3187,12 +3234,9 @@ object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...)
if (length >= MAX_STACK_OBJ) {
int heap_grown;
- bv = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(bytevector_type) + length,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((bytevector) bv)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ bv = gc_alloc(((gc_thread_data *) data)->heap, sizeof(bytevector_type) + length, boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data, &heap_grown);
+ ((bytevector) bv)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((bytevector) bv)->hdr.grayed = 0;
((bytevector) bv)->hdr.immutable = 0;
((bytevector) bv)->tag = bytevector_tag;
@@ -3218,17 +3262,17 @@ object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...)
// carg TODO: need to test each of these "dispatch" functions for
// off-by-one errors! I think there are bugs in each of them
-void dispatch_bytevector(void *data, object clo, int _argc, object *_args)
+void dispatch_bytevector(void *data, object clo, int _argc, object * _args)
{
- int argc = _argc - 1; // Skip continuation
- object *args = _args + 1; // Skip continuation
+ int argc = _argc - 1; // Skip continuation
+ object *args = _args + 1; // Skip continuation
int i, val;
object tmp;
char *buffer;
make_empty_bytevector(bv);
if (argc > 0) {
buffer = alloca(sizeof(char) * argc);
- for(i = 0; i < argc; i++) {
+ for (i = 0; i < argc; i++) {
tmp = args[i];
Cyc_check_num(data, tmp);
val = unbox_number(tmp);
@@ -3253,7 +3297,7 @@ object Cyc_bytevector(void *data, object cont, int argc, object bval, ...)
val = unbox_number(bval);
buffer[i] = val;
va_start(ap, bval);
- for(i = 1; i < argc; i++) {
+ for (i = 1; i < argc; i++) {
tmp = va_arg(ap, object);
Cyc_check_num(data, tmp);
val = unbox_number(tmp);
@@ -3266,10 +3310,11 @@ object Cyc_bytevector(void *data, object cont, int argc, object bval, ...)
_return_closcall1(data, cont, &bv);
}
-void dispatch_bytevector_91append(void *data, object clo, int _argc, object *_args)
+void dispatch_bytevector_91append(void *data, object clo, int _argc,
+ object * _args)
{
- int argc = _argc - 1; // Skip continuation
- object *args = _args + 1; // Skip continuation
+ int argc = _argc - 1; // Skip continuation
+ object *args = _args + 1; // Skip continuation
int i = 0, buf_idx = 0, total_length = 0;
object tmp;
char *buffer;
@@ -3279,12 +3324,12 @@ void dispatch_bytevector_91append(void *data, object clo, int _argc, object *_ar
if (argc > 0) {
buffers = alloca(sizeof(char *) * argc);
lengths = alloca(sizeof(int) * argc);
- for(i = 0; i < argc; i++) {
+ for (i = 0; i < argc; i++) {
tmp = args[i];
Cyc_check_bvec(data, tmp);
- total_length += ((bytevector)tmp)->len;
- lengths[i] = ((bytevector)tmp)->len;
- buffers[i] = ((bytevector)tmp)->data;
+ total_length += ((bytevector) tmp)->len;
+ lengths[i] = ((bytevector) tmp)->len;
+ buffers[i] = ((bytevector) tmp)->data;
}
buffer = alloca(sizeof(char) * total_length);
for (i = 0; i < argc; i++) {
@@ -3310,16 +3355,16 @@ object Cyc_bytevector_append(void *data, object cont, int argc, object bv, ...)
buffers = alloca(sizeof(char *) * argc);
lengths = alloca(sizeof(int) * argc);
Cyc_check_bvec(data, bv);
- total_length = ((bytevector)bv)->len;
- lengths[0] = ((bytevector)bv)->len;
- buffers[0] = ((bytevector)bv)->data;
+ total_length = ((bytevector) bv)->len;
+ lengths[0] = ((bytevector) bv)->len;
+ buffers[0] = ((bytevector) bv)->data;
va_start(ap, bv);
- for(i = 1; i < argc; i++) {
+ for (i = 1; i < argc; i++) {
tmp = va_arg(ap, object);
Cyc_check_bvec(data, tmp);
- total_length += ((bytevector)tmp)->len;
- lengths[i] = ((bytevector)tmp)->len;
- buffers[i] = ((bytevector)tmp)->data;
+ total_length += ((bytevector) tmp)->len;
+ lengths[i] = ((bytevector) tmp)->len;
+ buffers[i] = ((bytevector) tmp)->data;
}
va_end(ap);
buffer = alloca(sizeof(char) * total_length);
@@ -3357,18 +3402,20 @@ object Cyc_bytevector_copy(void *data, object cont, object bv, object start,
if (len >= MAX_STACK_OBJ) {
int heap_grown;
- object result = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(bytevector_type) + len,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((bytevector) result)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ object result = gc_alloc(((gc_thread_data *) data)->heap,
+ sizeof(bytevector_type) + len,
+ boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data,
+ &heap_grown);
+ ((bytevector) result)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((bytevector) result)->hdr.grayed = 0;
((bytevector) result)->hdr.immutable = 0;
((bytevector) result)->tag = bytevector_tag;
((bytevector) result)->len = len;
- ((bytevector) result)->data = (char *)(((char *)result) + sizeof(bytevector_type));
- memcpy(&(((bytevector) result)->data[0]), &(((bytevector) bv)->data)[s], len);
+ ((bytevector) result)->data =
+ (char *)(((char *)result) + sizeof(bytevector_type));
+ memcpy(&(((bytevector) result)->data[0]), &(((bytevector) bv)->data)[s],
+ len);
_return_closcall1(data, cont, result);
} else {
make_empty_bytevector(result);
@@ -3406,9 +3453,10 @@ object Cyc_utf82string(void *data, object cont, object bv, object start,
{
object st;
alloc_string(data, st, len, len);
- memcpy(((string_type *)st)->str, &buf[s], len);
- ((string_type *)st)->str[len] = '\0';
- ((string_type *)st)->num_cp = Cyc_utf8_count_code_points((uint8_t *)(((string_type *)st)->str));
+ memcpy(((string_type *) st)->str, &buf[s], len);
+ ((string_type *) st)->str[len] = '\0';
+ ((string_type *) st)->num_cp =
+ Cyc_utf8_count_code_points((uint8_t *) (((string_type *) st)->str));
_return_closcall1(data, cont, st);
}
}
@@ -3434,22 +3482,22 @@ object Cyc_string2utf8(void *data, object cont, object str, object start,
if (e < 0 || e < s || e > string_num_cp(str)) {
Cyc_rt_raise2(data, "string->utf8 - invalid end", end);
}
-
// Fast path
if (string_num_cp(str) == string_len(str)) {
if (len >= MAX_STACK_OBJ) {
int heap_grown;
- object bv = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(bytevector_type) + len,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((bytevector) bv)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ object bv = gc_alloc(((gc_thread_data *) data)->heap,
+ sizeof(bytevector_type) + len,
+ boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data,
+ &heap_grown);
+ ((bytevector) bv)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((bytevector) bv)->hdr.grayed = 0;
((bytevector) bv)->hdr.immutable = 0;
((bytevector) bv)->tag = bytevector_tag;
((bytevector) bv)->len = len;
- ((bytevector) bv)->data = (char *)(((char *)bv) + sizeof(bytevector_type));
+ ((bytevector) bv)->data =
+ (char *)(((char *)bv) + sizeof(bytevector_type));
memcpy(&(((bytevector) bv)->data[0]), &(string_str(str))[s], len);
_return_closcall1(data, cont, bv);
} else {
@@ -3465,9 +3513,9 @@ object Cyc_string2utf8(void *data, object cont, object str, object start,
uint32_t state = 0;
int num_ch, cur_ch_bytes = 0, start_i = 0, end_i = 0;
// Figure out start / end indices
- for (num_ch = 0; *tmp; ++tmp){
+ for (num_ch = 0; *tmp; ++tmp) {
cur_ch_bytes++;
- if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t)*tmp)){
+ if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t) * tmp)) {
end_i += cur_ch_bytes;
num_ch += 1;
cur_ch_bytes = 0;
@@ -3483,17 +3531,18 @@ object Cyc_string2utf8(void *data, object cont, object str, object start,
len = end_i - start_i;
if (len >= MAX_STACK_OBJ) {
int heap_grown;
- object bv = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(bytevector_type) + len,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((bytevector) bv)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ object bv = gc_alloc(((gc_thread_data *) data)->heap,
+ sizeof(bytevector_type) + len,
+ boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data,
+ &heap_grown);
+ ((bytevector) bv)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((bytevector) bv)->hdr.grayed = 0;
((bytevector) bv)->hdr.immutable = 0;
((bytevector) bv)->tag = bytevector_tag;
((bytevector) bv)->len = len;
- ((bytevector) bv)->data = (char *)(((char *)bv) + sizeof(bytevector_type));
+ ((bytevector) bv)->data =
+ (char *)(((char *)bv) + sizeof(bytevector_type));
memcpy(&(((bytevector) bv)->data[0]), &(string_str(str))[start_i], len);
_return_closcall1(data, cont, bv);
} else {
@@ -3571,17 +3620,14 @@ object Cyc_list2vector(void *data, object cont, object l)
element_vec_size = sizeof(object) * len;
if (element_vec_size >= MAX_STACK_OBJ) {
int heap_grown;
- v = gc_alloc(((gc_thread_data *)data)->heap,
- sizeof(vector_type) + element_vec_size,
- boolean_f, // OK to populate manually over here
- (gc_thread_data *)data,
- &heap_grown);
- ((vector) v)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+ v = gc_alloc(((gc_thread_data *) data)->heap, sizeof(vector_type) + element_vec_size, boolean_f, // OK to populate manually over here
+ (gc_thread_data *) data, &heap_grown);
+ ((vector) v)->hdr.mark = ((gc_thread_data *) data)->gc_alloc_color;
((vector) v)->hdr.grayed = 0;
((vector) v)->hdr.immutable = 0;
- ((vector) v)->tag = double_tag; // Avoid race with GC tracing until
- ((vector) v)->num_elements = 0; // array is initialized
- ((vector) v)->elements = (object *)(((char *)v) + sizeof(vector_type));
+ ((vector) v)->tag = double_tag; // Avoid race with GC tracing until
+ ((vector) v)->num_elements = 0; // array is initialized
+ ((vector) v)->elements = (object *) (((char *)v) + sizeof(vector_type));
// TODO: do we need to worry about stack object in the list????
//// Use write barrier to ensure fill is moved to heap if it is on the stack
//// Otherwise if next minor GC misses fill it could be catastrophic
@@ -3625,9 +3671,9 @@ object FUNC(void *data, object a, object b) \
return boolean_t; \
return boolean_f; \
}
-declare_char_comp(Cyc_char_eq_op, ==);
-declare_char_comp(Cyc_char_gt_op, > );
-declare_char_comp(Cyc_char_lt_op, < );
+declare_char_comp(Cyc_char_eq_op, ==);
+declare_char_comp(Cyc_char_gt_op, >);
+declare_char_comp(Cyc_char_lt_op, <);
declare_char_comp(Cyc_char_gte_op, >=);
declare_char_comp(Cyc_char_lte_op, <=);
@@ -3645,7 +3691,7 @@ object Cyc_integer2char(void *data, object n)
return obj_char2obj(val);
}
-void Cyc_halt(void *data, object clo, int argc, object *args)
+void Cyc_halt(void *data, object clo, int argc, object * args)
{
object obj = boolean_f;
if (argc > 0) {
@@ -3667,7 +3713,7 @@ void Cyc_halt(void *data, object clo, int argc, object *args)
object __halt(object obj)
{
- object buf[1] = {obj};
+ object buf[1] = { obj };
Cyc_halt(NULL, NULL, 1, buf);
return NULL;
}
@@ -3691,16 +3737,16 @@ static int Cyc_checked_mul(int x, int y, int *result)
// Avoid undefined behavior by detecting overflow prior to multiplication
// Based on code from Hacker's Delight and CHICKEN scheme
unsigned int xu, yu, c;
- c = (1UL<<30UL) - 1;
+ c = (1UL << 30UL) - 1;
xu = x < 0 ? -x : x;
yu = y < 0 ? -y : y;
- if (yu != 0 && xu > (c / yu)) return 1; // Overflow
+ if (yu != 0 && xu > (c / yu))
+ return 1; // Overflow
*result = x * y;
- return (*result > CYC_FIXNUM_MAX) ||
- (*result < CYC_FIXNUM_MIN);
+ return (*result > CYC_FIXNUM_MAX) || (*result < CYC_FIXNUM_MIN);
}
#define declare_num_op(FUNC, FUNC_OP, FUNC_APPLY, OP, INT_OP, BN_OP, NO_ARG, ONE_ARG, DIV) \
@@ -3832,13 +3878,12 @@ void FUNC_APPLY(void *data, object clo, int argc, object *args) { \
return_closcall1(data, clo, result); \
}
-object Cyc_fast_sum(void *data, object ptr, object x, object y) {
+object Cyc_fast_sum(void *data, object ptr, object x, object y)
+{
// x is int (assume value types for integers)
- if (obj_is_int(x)){
- if (obj_is_int(y)){
- int xx = obj_obj2int(x),
- yy = obj_obj2int(y),
- z;
+ if (obj_is_int(x)) {
+ if (obj_is_int(y)) {
+ int xx = obj_obj2int(x), yy = obj_obj2int(y), z;
if (Cyc_checked_add(xx, yy, &z) == 0) {
return obj_int2obj(z);
@@ -3858,13 +3903,13 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
assign_double(ptr, (double)(obj_obj2int(x)) + double_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- mp_int bnx;
- BIGNUM_CALL(mp_init(&bnx));
- Cyc_int2bignum(obj_obj2int(x), &bnx);
- alloc_bignum(data, bn);
- BIGNUM_CALL(mp_add(&bnx, &bignum_value(y), &bignum_value(bn)));
- mp_clear(&bnx);
- return bn;
+ mp_int bnx;
+ BIGNUM_CALL(mp_init(&bnx));
+ Cyc_int2bignum(obj_obj2int(x), &bnx);
+ alloc_bignum(data, bn);
+ BIGNUM_CALL(mp_add(&bnx, &bignum_value(y), &bignum_value(bn)));
+ mp_clear(&bnx);
+ return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
assign_complex_num(ptr, ((obj_obj2int(x)) + complex_num_value(y)));
return ptr;
@@ -3872,7 +3917,7 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_double(ptr, double_value(x) + (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -3888,7 +3933,7 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
}
// x is bignum
if (is_object_type(x) && type_of(x) == bignum_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
mp_int bny;
BIGNUM_CALL(mp_init(&bny));
Cyc_int2bignum(obj_obj2int(y), &bny);
@@ -3901,16 +3946,19 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
alloc_bignum(data, bn);
- BIGNUM_CALL(mp_add(&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
+ BIGNUM_CALL(mp_add
+ (&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
- assign_complex_num(ptr, mp_get_double(&bignum_value(x)) + complex_num_value(y));
+ assign_complex_num(ptr,
+ mp_get_double(&bignum_value(x)) +
+ complex_num_value(y));
return ptr;
}
}
// x is complex
if (is_object_type(x) && type_of(x) == complex_num_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_complex_num(ptr, complex_num_value(x) + (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -3920,7 +3968,9 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
assign_complex_num(ptr, complex_num_value(x) + complex_num_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- assign_complex_num(ptr, complex_num_value(x) + mp_get_double(&bignum_value(y)));
+ assign_complex_num(ptr,
+ complex_num_value(x) +
+ mp_get_double(&bignum_value(y)));
return ptr;
}
}
@@ -3933,13 +3983,12 @@ object Cyc_fast_sum(void *data, object ptr, object x, object y) {
return NULL;
}
-object Cyc_fast_sub(void *data, object ptr, object x, object y) {
+object Cyc_fast_sub(void *data, object ptr, object x, object y)
+{
// x is int (assume value types for integers)
- if (obj_is_int(x)){
- if (obj_is_int(y)){
- int xx = obj_obj2int(x),
- yy = obj_obj2int(y),
- z;
+ if (obj_is_int(x)) {
+ if (obj_is_int(y)) {
+ int xx = obj_obj2int(x), yy = obj_obj2int(y), z;
if (Cyc_checked_sub(xx, yy, &z) == 0) {
return obj_int2obj(z);
} else {
@@ -3958,13 +4007,13 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
assign_double(ptr, (double)(obj_obj2int(x)) - double_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- mp_int bnx;
- BIGNUM_CALL(mp_init(&bnx));
- Cyc_int2bignum(obj_obj2int(x), &bnx);
- alloc_bignum(data, bn);
- BIGNUM_CALL(mp_sub(&bnx, &bignum_value(y), &bignum_value(bn)));
- mp_clear(&bnx);
- return bn;
+ mp_int bnx;
+ BIGNUM_CALL(mp_init(&bnx));
+ Cyc_int2bignum(obj_obj2int(x), &bnx);
+ alloc_bignum(data, bn);
+ BIGNUM_CALL(mp_sub(&bnx, &bignum_value(y), &bignum_value(bn)));
+ mp_clear(&bnx);
+ return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
assign_complex_num(ptr, ((obj_obj2int(x)) - complex_num_value(y)));
return ptr;
@@ -3972,7 +4021,7 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_double(ptr, double_value(x) - (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -3988,7 +4037,7 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
}
// x is bignum
if (is_object_type(x) && type_of(x) == bignum_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
mp_int bny;
BIGNUM_CALL(mp_init(&bny));
Cyc_int2bignum(obj_obj2int(y), &bny);
@@ -4001,16 +4050,19 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
alloc_bignum(data, bn);
- BIGNUM_CALL(mp_sub(&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
+ BIGNUM_CALL(mp_sub
+ (&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
- assign_complex_num(ptr, mp_get_double(&bignum_value(x)) - complex_num_value(y));
+ assign_complex_num(ptr,
+ mp_get_double(&bignum_value(x)) -
+ complex_num_value(y));
return ptr;
}
}
// x is complex
if (is_object_type(x) && type_of(x) == complex_num_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_complex_num(ptr, complex_num_value(x) - (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4020,7 +4072,9 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
assign_complex_num(ptr, complex_num_value(x) - complex_num_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- assign_complex_num(ptr, complex_num_value(x) - mp_get_double(&bignum_value(y)));
+ assign_complex_num(ptr,
+ complex_num_value(x) -
+ mp_get_double(&bignum_value(y)));
return ptr;
}
}
@@ -4033,13 +4087,12 @@ object Cyc_fast_sub(void *data, object ptr, object x, object y) {
return NULL;
}
-object Cyc_fast_mul(void *data, object ptr, object x, object y) {
+object Cyc_fast_mul(void *data, object ptr, object x, object y)
+{
// x is int (assume value types for integers)
- if (obj_is_int(x)){
- if (obj_is_int(y)){
- int xx = obj_obj2int(x),
- yy = obj_obj2int(y),
- z;
+ if (obj_is_int(x)) {
+ if (obj_is_int(y)) {
+ int xx = obj_obj2int(x), yy = obj_obj2int(y), z;
if (Cyc_checked_mul(xx, yy, &z) == 0) {
return obj_int2obj(z);
} else {
@@ -4058,13 +4111,13 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
assign_double(ptr, (double)(obj_obj2int(x)) * double_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- mp_int bnx;
- BIGNUM_CALL(mp_init(&bnx));
- Cyc_int2bignum(obj_obj2int(x), &bnx);
- alloc_bignum(data, bn);
- BIGNUM_CALL(mp_mul(&bnx, &bignum_value(y), &bignum_value(bn)));
- mp_clear(&bnx);
- return bn;
+ mp_int bnx;
+ BIGNUM_CALL(mp_init(&bnx));
+ Cyc_int2bignum(obj_obj2int(x), &bnx);
+ alloc_bignum(data, bn);
+ BIGNUM_CALL(mp_mul(&bnx, &bignum_value(y), &bignum_value(bn)));
+ mp_clear(&bnx);
+ return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
assign_complex_num(ptr, ((obj_obj2int(x)) * complex_num_value(y)));
return ptr;
@@ -4072,7 +4125,7 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_double(ptr, double_value(x) * (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4088,7 +4141,7 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
}
// x is bignum
if (is_object_type(x) && type_of(x) == bignum_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
mp_int bny;
BIGNUM_CALL(mp_init(&bny));
Cyc_int2bignum(obj_obj2int(y), &bny);
@@ -4101,16 +4154,19 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
alloc_bignum(data, bn);
- BIGNUM_CALL(mp_mul(&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
+ BIGNUM_CALL(mp_mul
+ (&bignum_value(x), &bignum_value(y), &bignum_value(bn)));
return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
- assign_complex_num(ptr, mp_get_double(&bignum_value(x)) * complex_num_value(y));
+ assign_complex_num(ptr,
+ mp_get_double(&bignum_value(x)) *
+ complex_num_value(y));
return ptr;
}
}
// x is complex
if (is_object_type(x) && type_of(x) == complex_num_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_complex_num(ptr, complex_num_value(x) * (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4120,7 +4176,9 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
assign_complex_num(ptr, complex_num_value(x) * complex_num_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- assign_complex_num(ptr, complex_num_value(x) * mp_get_double(&bignum_value(y)));
+ assign_complex_num(ptr,
+ complex_num_value(x) *
+ mp_get_double(&bignum_value(y)));
return ptr;
}
}
@@ -4133,11 +4191,14 @@ object Cyc_fast_mul(void *data, object ptr, object x, object y) {
return NULL;
}
-object Cyc_fast_div(void *data, object ptr, object x, object y) {
+object Cyc_fast_div(void *data, object ptr, object x, object y)
+{
// x is int (assume value types for integers)
- if (obj_is_int(x)){
- if (obj_is_int(y)){
- if (obj_obj2int(y) == 0) { goto divbyzero; }
+ if (obj_is_int(x)) {
+ if (obj_is_int(y)) {
+ if (obj_obj2int(y) == 0) {
+ goto divbyzero;
+ }
// Overflow can occur if y = 0 || (x = 0x80000000 && y = -1)
// We already check for 0 above and the invalid value of x would
// be a bignum, so no futher checks are required.
@@ -4152,13 +4213,13 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
assign_double(ptr, (double)(obj_obj2int(x)) / double_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- mp_int bnx;
- BIGNUM_CALL(mp_init(&bnx));
- Cyc_int2bignum(obj_obj2int(x), &bnx);
- alloc_bignum(data, bn);
- BIGNUM_CALL(mp_div(&bnx, &bignum_value(y), &bignum_value(bn), NULL));
- mp_clear(&bnx);
- return bn;
+ mp_int bnx;
+ BIGNUM_CALL(mp_init(&bnx));
+ Cyc_int2bignum(obj_obj2int(x), &bnx);
+ alloc_bignum(data, bn);
+ BIGNUM_CALL(mp_div(&bnx, &bignum_value(y), &bignum_value(bn), NULL));
+ mp_clear(&bnx);
+ return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
assign_complex_num(ptr, ((obj_obj2int(x)) / complex_num_value(y)));
return ptr;
@@ -4166,7 +4227,7 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
}
// x is double
if (is_object_type(x) && type_of(x) == double_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_double(ptr, double_value(x) / (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4182,7 +4243,7 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
}
// x is bignum
if (is_object_type(x) && type_of(x) == bignum_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
mp_int bny;
BIGNUM_CALL(mp_init(&bny));
Cyc_int2bignum(obj_obj2int(y), &bny);
@@ -4195,16 +4256,20 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
alloc_bignum(data, bn);
- BIGNUM_CALL(mp_div(&bignum_value(x), &bignum_value(y), &bignum_value(bn), NULL));
+ BIGNUM_CALL(mp_div
+ (&bignum_value(x), &bignum_value(y), &bignum_value(bn),
+ NULL));
return bn;
} else if (is_object_type(y) && type_of(y) == complex_num_tag) {
- assign_complex_num(ptr, mp_get_double(&bignum_value(x)) / complex_num_value(y));
+ assign_complex_num(ptr,
+ mp_get_double(&bignum_value(x)) /
+ complex_num_value(y));
return ptr;
}
}
// x is complex
if (is_object_type(x) && type_of(x) == complex_num_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
assign_complex_num(ptr, complex_num_value(x) / (double)(obj_obj2int(y)));
return ptr;
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4214,7 +4279,9 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
assign_complex_num(ptr, complex_num_value(x) / complex_num_value(y));
return ptr;
} else if (is_object_type(y) && type_of(y) == bignum_tag) {
- assign_complex_num(ptr, complex_num_value(x) / mp_get_double(&bignum_value(y)));
+ assign_complex_num(ptr,
+ complex_num_value(x) /
+ mp_get_double(&bignum_value(y)));
return ptr;
}
}
@@ -4224,7 +4291,7 @@ object Cyc_fast_div(void *data, object ptr, object x, object y) {
make_pair(c1, x, &c2);
make_pair(c0, &s, &c1);
Cyc_rt_raise(data, &c0);
-divbyzero:
+ divbyzero:
Cyc_rt_raise_msg(data, "Divide by zero");
return NULL;
}
@@ -4282,7 +4349,7 @@ object Cyc_div_op(void *data, common_type * x, object y)
BIGNUM_CALL(mp_div(&bn_tmp2, &bignum_value(y), &(x->bignum_t.bn), NULL));
mp_clear(&bn_tmp2);
} else if (tx == double_tag && ty == bignum_tag) {
- x->double_t.value = x->double_t.value / mp_get_double(&bignum_value(y));
+ x->double_t.value = x->double_t.value / mp_get_double(&bignum_value(y));
} else if (tx == bignum_tag && ty == -1) {
BIGNUM_CALL(mp_init(&bn_tmp2));
Cyc_int2bignum(obj_obj2int(y), &bn_tmp2);
@@ -4294,41 +4361,46 @@ object Cyc_div_op(void *data, common_type * x, object y)
x->double_t.hdr.mark = gc_color_red;
x->double_t.hdr.grayed = 0;
x->double_t.tag = double_tag;
- x->double_t.value = d / ((double_type *)y)->value;
+ x->double_t.value = d / ((double_type *) y)->value;
} else if (tx == bignum_tag && ty == bignum_tag) {
- BIGNUM_CALL(mp_div(&(x->bignum_t.bn), &bignum_value(y), &(x->bignum_t.bn), NULL));
+ BIGNUM_CALL(mp_div
+ (&(x->bignum_t.bn), &bignum_value(y), &(x->bignum_t.bn), NULL));
} else if (tx == complex_num_tag && ty == complex_num_tag) {
- x->complex_num_t.value = x->complex_num_t.value / ((complex_num_type *)y)->value;
+ x->complex_num_t.value =
+ x->complex_num_t.value / ((complex_num_type *) y)->value;
} else if (tx == complex_num_tag && ty == -1) {
- x->complex_num_t.value = x->complex_num_t.value / (obj_obj2int(y));
+ x->complex_num_t.value = x->complex_num_t.value / (obj_obj2int(y));
} else if (tx == complex_num_tag && ty == integer_tag) {
- x->complex_num_t.value = x->complex_num_t.value / ((integer_type *)y)->value;
+ x->complex_num_t.value =
+ x->complex_num_t.value / ((integer_type *) y)->value;
} else if (tx == complex_num_tag && ty == bignum_tag) {
- x->complex_num_t.value = x->complex_num_t.value / mp_get_double(&bignum_value(y));
+ x->complex_num_t.value =
+ x->complex_num_t.value / mp_get_double(&bignum_value(y));
} else if (tx == complex_num_tag && ty == double_tag) {
- x->complex_num_t.value = x->complex_num_t.value / complex_num_value(y);
+ x->complex_num_t.value = x->complex_num_t.value / complex_num_value(y);
} else if (tx == integer_tag && ty == complex_num_tag) {
- x->complex_num_t.hdr.mark = gc_color_red;
- x->complex_num_t.hdr.grayed = 0;
- x->complex_num_t.tag = complex_num_tag;
- x->complex_num_t.value = x->integer_t.value / ((complex_num_type *)y)->value;
+ x->complex_num_t.hdr.mark = gc_color_red;
+ x->complex_num_t.hdr.grayed = 0;
+ x->complex_num_t.tag = complex_num_tag;
+ x->complex_num_t.value =
+ x->integer_t.value / ((complex_num_type *) y)->value;
} else if (tx == bignum_tag && ty == complex_num_tag) {
- double d = mp_get_double(&(x->bignum_t.bn));
- mp_clear(&(x->bignum_t.bn));
- x->complex_num_t.hdr.mark = gc_color_red;
- x->complex_num_t.hdr.grayed = 0;
- x->complex_num_t.tag = complex_num_tag;
- x->complex_num_t.value = d / ((complex_num_type *)y)->value;
+ double d = mp_get_double(&(x->bignum_t.bn));
+ mp_clear(&(x->bignum_t.bn));
+ x->complex_num_t.hdr.mark = gc_color_red;
+ x->complex_num_t.hdr.grayed = 0;
+ x->complex_num_t.tag = complex_num_tag;
+ x->complex_num_t.value = d / ((complex_num_type *) y)->value;
} else if (tx == double_tag && ty == complex_num_tag) {
- x->complex_num_t.hdr.mark = gc_color_red;
- x->complex_num_t.hdr.grayed = 0;
- x->complex_num_t.tag = complex_num_tag;
- x->complex_num_t.value = x->double_t.value / complex_num_value(y);
+ x->complex_num_t.hdr.mark = gc_color_red;
+ x->complex_num_t.hdr.grayed = 0;
+ x->complex_num_t.tag = complex_num_tag;
+ x->complex_num_t.value = x->double_t.value / complex_num_value(y);
} else {
goto bad_arg_type_error;
}
return x;
-bad_arg_type_error:
+ bad_arg_type_error:
{
make_string(s, "Bad argument type");
make_pair(c1, y, NULL);
@@ -4349,7 +4421,7 @@ object Cyc_div(void *data, object cont, int argc, object n, ...)
_return_closcall1(data, cont, result);
}
-void dispatch_div(void *data, object clo, int argc, object *args)
+void dispatch_div(void *data, object clo, int argc, object * args)
{
common_type buffer;
object result;
@@ -4358,15 +4430,17 @@ void dispatch_div(void *data, object clo, int argc, object *args)
return_closcall1(data, clo, result);
}
-declare_num_op(Cyc_sum, Cyc_sum_op, dispatch_sum, +, Cyc_checked_add, mp_add, 0, 0, 0);
-declare_num_op(Cyc_sub, Cyc_sub_op, dispatch_sub, -, Cyc_checked_sub, mp_sub, -1, 0, 0);
-declare_num_op(Cyc_mul, Cyc_mul_op, dispatch_mul, *, Cyc_checked_mul, mp_mul, 1, 1, 0);
+declare_num_op(Cyc_sum, Cyc_sum_op, dispatch_sum, +, Cyc_checked_add, mp_add, 0,
+ 0, 0);
+declare_num_op(Cyc_sub, Cyc_sub_op, dispatch_sub, -, Cyc_checked_sub, mp_sub,
+ -1, 0, 0);
+declare_num_op(Cyc_mul, Cyc_mul_op, dispatch_mul, *, Cyc_checked_mul, mp_mul, 1,
+ 1, 0);
object Cyc_num_op_args(void *data, int argc,
object(fn_op(void *, common_type *, object)),
- int default_no_args, int default_one_arg,
- object *args,
- common_type * buf)
+ int default_no_args, int default_one_arg,
+ object * args, common_type * buf)
{
int i;
object n;
@@ -4425,10 +4499,10 @@ object Cyc_num_op_args(void *data, int argc,
if (type_of(&tmp) == integer_tag) {
buf->integer_t.tag = integer_tag;
buf->integer_t.value = integer_value(&tmp);
- } else if (type_of(&tmp) == double_tag){
+ } else if (type_of(&tmp) == double_tag) {
buf->double_t.tag = double_tag;
buf->double_t.value = double_value(&tmp);
- } else if (type_of(&tmp) == complex_num_tag){
+ } else if (type_of(&tmp) == complex_num_tag) {
buf->complex_num_t.tag = complex_num_tag;
buf->complex_num_t.value = complex_num_value(&tmp);
} else {
@@ -4452,7 +4526,7 @@ object Cyc_num_op_args(void *data, int argc,
}
return buf;
-bad_arg_type_error:
+ bad_arg_type_error:
{
make_string(s, "Bad argument type");
make_pair(c1, n, NULL);
@@ -4521,10 +4595,10 @@ object Cyc_num_op_va_list(void *data, int argc,
if (type_of(&tmp) == integer_tag) {
buf->integer_t.tag = integer_tag;
buf->integer_t.value = integer_value(&tmp);
- } else if (type_of(&tmp) == double_tag){
+ } else if (type_of(&tmp) == double_tag) {
buf->double_t.tag = double_tag;
buf->double_t.value = double_value(&tmp);
- } else if (type_of(&tmp) == complex_num_tag){
+ } else if (type_of(&tmp) == complex_num_tag) {
buf->complex_num_t.tag = complex_num_tag;
buf->complex_num_t.value = complex_num_value(&tmp);
} else {
@@ -4548,7 +4622,7 @@ object Cyc_num_op_va_list(void *data, int argc,
}
return buf;
-bad_arg_type_error:
+ bad_arg_type_error:
{
make_string(s, "Bad argument type");
make_pair(c1, n, NULL);
@@ -4566,14 +4640,16 @@ void Cyc_expt_double(void *data, object cont, double x, double y)
void Cyc_expt(void *data, object cont, object x, object y)
{
- if (obj_is_int(x)){
- if (obj_is_int(y)){
+ if (obj_is_int(x)) {
+ if (obj_is_int(y)) {
if (obj_obj2int(y) < 0) {
- Cyc_expt_double(data, cont, (double)obj_obj2int(x), (double)obj_obj2int(y));
+ Cyc_expt_double(data, cont, (double)obj_obj2int(x),
+ (double)obj_obj2int(y));
} else {
alloc_bignum(data, bn);
Cyc_int2bignum(obj_obj2int(x), &(bn->bn));
- BIGNUM_CALL(mp_expt_u32(&bignum_value(bn), obj_obj2int(y), &bignum_value(bn)));
+ BIGNUM_CALL(mp_expt_u32
+ (&bignum_value(bn), obj_obj2int(y), &bignum_value(bn)));
return_closcall1(data, cont, Cyc_bignum_normalize(data, bn));
}
} else if (is_object_type(y) && type_of(y) == double_tag) {
@@ -4584,7 +4660,7 @@ void Cyc_expt(void *data, object cont, object x, object y)
}
if (is_object_type(x) && type_of(x) == double_tag) {
make_double(d, 0.0);
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
d.value = (double)obj_obj2int(y);
} else if (is_object_type(y) && type_of(y) == double_tag) {
d.value = double_value(y);
@@ -4595,16 +4671,19 @@ void Cyc_expt(void *data, object cont, object x, object y)
return_closcall1(data, cont, &d);
}
if (is_object_type(x) && type_of(x) == bignum_tag) {
- if (obj_is_int(y)){
+ if (obj_is_int(y)) {
if (obj_obj2int(y) < 0) {
- Cyc_expt_double(data, cont, mp_get_double(&bignum_value(x)), (double)obj_obj2int(y));
+ Cyc_expt_double(data, cont, mp_get_double(&bignum_value(x)),
+ (double)obj_obj2int(y));
} else {
alloc_bignum(data, bn);
- BIGNUM_CALL(mp_expt_u32(&bignum_value(x), obj_obj2int(y), &bignum_value(bn)));
+ BIGNUM_CALL(mp_expt_u32
+ (&bignum_value(x), obj_obj2int(y), &bignum_value(bn)));
return_closcall1(data, cont, Cyc_bignum_normalize(data, bn));
}
} else if (is_object_type(y) && type_of(y) == double_tag) {
- Cyc_expt_double(data, cont, mp_get_double(&bignum_value(x)), double_value(y));
+ Cyc_expt_double(data, cont, mp_get_double(&bignum_value(x)),
+ double_value(y));
//make_double(d, 0.0);
//d.value = pow(mp_get_double(&bignum_value(x)), double_value(y));
//return_closcall1(data, cont, &d);
@@ -4620,9 +4699,12 @@ void Cyc_expt(void *data, object cont, object x, object y)
Cyc_rt_raise(data, &c0);
}
-void Cyc_bignum_remainder(void *data, object cont, object num1, object num2, object rem)
+void Cyc_bignum_remainder(void *data, object cont, object num1, object num2,
+ object rem)
{
- BIGNUM_CALL(mp_div(&bignum_value(num1), &bignum_value(num2), NULL, &bignum_value(rem)));
+ BIGNUM_CALL(mp_div
+ (&bignum_value(num1), &bignum_value(num2), NULL,
+ &bignum_value(rem)));
return_closcall1(data, cont, Cyc_bignum_normalize(data, rem));
}
@@ -4632,73 +4714,68 @@ void Cyc_remainder(void *data, object cont, object num1, object num2)
double ii = 0, jj = 0;
object result;
if (obj_is_int(num1)) {
- if (obj_is_int(num2)){
+ if (obj_is_int(num2)) {
i = obj_obj2int(num1);
j = obj_obj2int(num2);
- }
- else if (is_object_type(num2) && type_of(num2) == bignum_tag){
+ } else if (is_object_type(num2) && type_of(num2) == bignum_tag) {
alloc_bignum(data, bn);
Cyc_int2bignum(obj_obj2int(num1), &(bn->bn));
Cyc_bignum_remainder(data, cont, bn, num2, bn);
- }
- else if (is_object_type(num2) && type_of(num2) == double_tag){
+ } else if (is_object_type(num2) && type_of(num2) == double_tag) {
ii = obj_obj2int(num1);
- jj = ((double_type *)num2)->value;
+ jj = ((double_type *) num2)->value;
goto handledouble;
- }
- else {
+ } else {
goto typeerror;
}
} else if (is_object_type(num1) && type_of(num1) == bignum_tag) {
- if (obj_is_int(num2)){
+ if (obj_is_int(num2)) {
alloc_bignum(data, bn);
Cyc_int2bignum(obj_obj2int(num2), &(bn->bn));
Cyc_bignum_remainder(data, cont, num1, bn, bn);
- }
- else if (is_object_type(num2) && type_of(num2) == bignum_tag){
+ } else if (is_object_type(num2) && type_of(num2) == bignum_tag) {
alloc_bignum(data, rem);
Cyc_bignum_remainder(data, cont, num1, num2, rem);
- }
- else if (is_object_type(num2) && type_of(num2) == double_tag){
+ } else if (is_object_type(num2) && type_of(num2) == double_tag) {
ii = mp_get_double(&bignum_value(num1));
- jj = ((double_type *)num2)->value;
+ jj = ((double_type *) num2)->value;
goto handledouble;
- }
- else {
+ } else {
goto typeerror;
}
- } else if (is_object_type(num1) && type_of(num1) == double_tag){
- if (obj_is_int(num2)){
- ii = ((double_type *)num1)->value;
+ } else if (is_object_type(num1) && type_of(num1) == double_tag) {
+ if (obj_is_int(num2)) {
+ ii = ((double_type *) num1)->value;
jj = obj_obj2int(num2);
goto handledouble;
- }
- else if (is_object_type(num2) && type_of(num2) == bignum_tag){
- ii = ((double_type *)num1)->value;
+ } else if (is_object_type(num2) && type_of(num2) == bignum_tag) {
+ ii = ((double_type *) num1)->value;
jj = mp_get_double(&bignum_value(num2));
goto handledouble;
- }
- else if (is_object_type(num2) && type_of(num2) == double_tag){
- ii = ((double_type *)num1)->value;
- jj = ((double_type *)num2)->value;
+ } else if (is_object_type(num2) && type_of(num2) == double_tag) {
+ ii = ((double_type *) num1)->value;
+ jj = ((double_type *) num2)->value;
goto handledouble;
- }
- else {
+ } else {
goto typeerror;
}
} else {
goto typeerror;
}
- if (j == 0) { Cyc_rt_raise_msg(data, "Divide by zero"); }
+ if (j == 0) {
+ Cyc_rt_raise_msg(data, "Divide by zero");
+ }
result = obj_int2obj(i % j);
- return_closcall1(data, cont, result);
-handledouble:
+ return_closcall1(data, cont, result);
+ handledouble:
{
- if (jj == 0) { Cyc_rt_raise_msg(data, "Divide by zero"); }
+ if (jj == 0) {
+ Cyc_rt_raise_msg(data, "Divide by zero");
+ }
make_double(dresult, fmod(ii, jj));
- return_closcall1(data, cont, &dresult);
+ return_closcall1(data, cont, &dresult);
}
-typeerror:
+ typeerror:
{
make_string(s, "Bad argument type");
make_pair(c2, num2, NULL);
@@ -4796,21 +4873,21 @@ object Cyc_io_close_port(void *data, object port)
if (stream)
fclose(stream);
((port_type *) port)->fp = NULL;
-
- if (((port_type *)port)->mem_buf != NULL){
- free( ((port_type *)port)->mem_buf );
- ((port_type *)port)->mem_buf = NULL;
- ((port_type *)port)->mem_buf_len = 0;
+
+ if (((port_type *) port)->mem_buf != NULL) {
+ free(((port_type *) port)->mem_buf);
+ ((port_type *) port)->mem_buf = NULL;
+ ((port_type *) port)->mem_buf_len = 0;
}
- if (((port_type *)port)->str_bv_in_mem_buf != NULL){
- free( ((port_type *)port)->str_bv_in_mem_buf );
- ((port_type *)port)->str_bv_in_mem_buf = NULL;
- ((port_type *)port)->str_bv_in_mem_buf_len = 0;
+ if (((port_type *) port)->str_bv_in_mem_buf != NULL) {
+ free(((port_type *) port)->str_bv_in_mem_buf);
+ ((port_type *) port)->str_bv_in_mem_buf = NULL;
+ ((port_type *) port)->str_bv_in_mem_buf_len = 0;
}
- if (((port_type *)port)->tok_buf != NULL){
- free( ((port_type *)port)->tok_buf );
- ((port_type *)port)->tok_buf = NULL;
- ((port_type *)port)->tok_buf_len = 0;
+ if (((port_type *) port)->tok_buf != NULL) {
+ free(((port_type *) port)->tok_buf);
+ ((port_type *) port)->tok_buf = NULL;
+ ((port_type *) port)->tok_buf_len = 0;
}
}
return port;
@@ -4854,13 +4931,13 @@ object Cyc_io_file_exists(void *data, object filename)
return boolean_f;
}
-time_t Cyc_file_last_modified_time(char *path) {
- struct stat attr;
- stat(path, &attr);
- return(attr.st_mtime);
+time_t Cyc_file_last_modified_time(char *path)
+{
+ struct stat attr;
+ stat(path, &attr);
+ return (attr.st_mtime);
}
-
// Functions internal to the runtime that use malloc
list malloc_make_pair(object a, object d)
{
@@ -4885,13 +4962,13 @@ cvar_type *mcvar(object * var)
return c;
}
-void _Cyc_91global_91vars(void *data, object clo, int argc, object *args)
+void _Cyc_91global_91vars(void *data, object clo, int argc, object * args)
{
object cont = args[0];
return_closcall1(data, cont, Cyc_global_variables);
}
-void _car(void *data, object clo, int argc, object *args)
+void _car(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "car", argc - 1, 1);
{
@@ -4901,7 +4978,7 @@ void _car(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, car(var));
}}
-void _cdr(void *data, object clo, int argc, object *args)
+void _cdr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4909,7 +4986,7 @@ void _cdr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, cdr(args[1]));
}
-void _caar(void *data, object clo, int argc, object *args)
+void _caar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4917,7 +4994,7 @@ void _caar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caar(data, args[1]));
}
-void _cadr(void *data, object clo, int argc, object *args)
+void _cadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4925,7 +5002,7 @@ void _cadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cadr(data, args[1]));
}
-void _cdar(void *data, object clo, int argc, object *args)
+void _cdar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4933,7 +5010,7 @@ void _cdar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdar(data, args[1]));
}
-void _cddr(void *data, object clo, int argc, object *args)
+void _cddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4941,7 +5018,7 @@ void _cddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cddr(data, args[1]));
}
-void _caaar(void *data, object clo, int argc, object *args)
+void _caaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4949,7 +5026,7 @@ void _caaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caaar(data, args[1]));
}
-void _caadr(void *data, object clo, int argc, object *args)
+void _caadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4957,7 +5034,7 @@ void _caadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caadr(data, args[1]));
}
-void _cadar(void *data, object clo, int argc, object *args)
+void _cadar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cadar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4965,7 +5042,7 @@ void _cadar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cadar(data, args[1]));
}
-void _caddr(void *data, object clo, int argc, object *args)
+void _caddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4973,7 +5050,7 @@ void _caddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caddr(data, args[1]));
}
-void _cdaar(void *data, object clo, int argc, object *args)
+void _cdaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4981,7 +5058,7 @@ void _cdaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdaar(data, args[1]));
}
-void _cdadr(void *data, object clo, int argc, object *args)
+void _cdadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4989,7 +5066,7 @@ void _cdadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdadr(data, args[1]));
}
-void _cddar(void *data, object clo, int argc, object *args)
+void _cddar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cddar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -4997,7 +5074,7 @@ void _cddar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cddar(data, args[1]));
}
-void _cdddr(void *data, object clo, int argc, object *args)
+void _cdddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5005,7 +5082,7 @@ void _cdddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdddr(data, args[1]));
}
-void _caaaar(void *data, object clo, int argc, object *args)
+void _caaaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caaaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5013,7 +5090,7 @@ void _caaaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caaaar(data, args[1]));
}
-void _caaadr(void *data, object clo, int argc, object *args)
+void _caaadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caaadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5021,7 +5098,7 @@ void _caaadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caaadr(data, args[1]));
}
-void _caadar(void *data, object clo, int argc, object *args)
+void _caadar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caadar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5029,7 +5106,7 @@ void _caadar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caadar(data, args[1]));
}
-void _caaddr(void *data, object clo, int argc, object *args)
+void _caaddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caaddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5037,7 +5114,7 @@ void _caaddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caaddr(data, args[1]));
}
-void _cadaar(void *data, object clo, int argc, object *args)
+void _cadaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cadaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5045,7 +5122,7 @@ void _cadaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cadaar(data, args[1]));
}
-void _cadadr(void *data, object clo, int argc, object *args)
+void _cadadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cadadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5053,7 +5130,7 @@ void _cadadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cadadr(data, args[1]));
}
-void _caddar(void *data, object clo, int argc, object *args)
+void _caddar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "caddar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5061,7 +5138,7 @@ void _caddar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_caddar(data, args[1]));
}
-void _cadddr(void *data, object clo, int argc, object *args)
+void _cadddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cadddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5069,7 +5146,7 @@ void _cadddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cadddr(data, args[1]));
}
-void _cdaaar(void *data, object clo, int argc, object *args)
+void _cdaaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdaaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5077,7 +5154,7 @@ void _cdaaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdaaar(data, args[1]));
}
-void _cdaadr(void *data, object clo, int argc, object *args)
+void _cdaadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdaadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5085,7 +5162,7 @@ void _cdaadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdaadr(data, args[1]));
}
-void _cdadar(void *data, object clo, int argc, object *args)
+void _cdadar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdadar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5093,7 +5170,7 @@ void _cdadar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdadar(data, args[1]));
}
-void _cdaddr(void *data, object clo, int argc, object *args)
+void _cdaddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdaddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5101,7 +5178,7 @@ void _cdaddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdaddr(data, args[1]));
}
-void _cddaar(void *data, object clo, int argc, object *args)
+void _cddaar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cddaar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5109,7 +5186,7 @@ void _cddaar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cddaar(data, args[1]));
}
-void _cddadr(void *data, object clo, int argc, object *args)
+void _cddadr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cddadr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5117,7 +5194,7 @@ void _cddadr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cddadr(data, args[1]));
}
-void _cdddar(void *data, object clo, int argc, object *args)
+void _cdddar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cdddar", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5125,7 +5202,7 @@ void _cdddar(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cdddar(data, args[1]));
}
-void _cddddr(void *data, object clo, int argc, object *args)
+void _cddddr(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cddddr", argc - 1, 1);
Cyc_check_pair(data, args[1]);
@@ -5133,7 +5210,7 @@ void _cddddr(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_cddddr(data, args[1]));
}
-void _cons(void *data, object clo, int argc, object *args)
+void _cons(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "cons", argc - 1, 2);
{
@@ -5142,28 +5219,28 @@ void _cons(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, &c);
}}
-void _eq_127(void *data, object clo, int argc, object *args)
+void _eq_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "eq?", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, Cyc_eq(args[1], args[2]));
}
-void _eqv_127(void *data, object clo, int argc, object *args)
+void _eqv_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "eqv?", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, Cyc_eqv(args[1], args[2]));
}
-void _equal_127(void *data, object clo, int argc, object *args)
+void _equal_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "equal?", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, equalp(args[1], args[2]));
}
-void _length(void *data, object clo, int argc, object *args)
+void _length(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "length", argc - 1, 1);
{
@@ -5172,7 +5249,7 @@ void _length(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _bytevector_91length(void *data, object clo, int argc, object *args)
+void _bytevector_91length(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "bytevector-length", argc - 1, 1);
{
@@ -5181,7 +5258,7 @@ void _bytevector_91length(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _bytevector_91u8_91ref(void *data, object clo, int argc, object *args)
+void _bytevector_91u8_91ref(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "bytevector-u8-ref", argc - 1, 2);
{
@@ -5190,7 +5267,7 @@ void _bytevector_91u8_91ref(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, c);
}}
-void _bytevector_91u8_91set_67(void *data, object clo, int argc, object *args)
+void _bytevector_91u8_91set_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "bytevector-u8-set!", argc - 1, 3);
{
@@ -5199,40 +5276,40 @@ void _bytevector_91u8_91set_67(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, bv);
}}
-void _bytevector(void *data, object clo, int argc, object *args)
+void _bytevector(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_bytevector(data, cont, argc, args);
}
-void _bytevector_91append(void *data, object clo, int argc, object *args)
+void _bytevector_91append(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_bytevector_91append(data, cont, argc, args);
}
-void _Cyc_91bytevector_91copy(void *data, object clo, int argc, object *args)
+void _Cyc_91bytevector_91copy(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-bytevector-copy", argc - 1, 3);
object cont = args[0];
Cyc_bytevector_copy(data, cont, args[1], args[2], args[3]);
}
-void _Cyc_91string_91_125utf8(void *data, object clo, int argc, object *args)
+void _Cyc_91string_91_125utf8(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-string->utf8", argc - 1, 3);
object cont = args[0];
Cyc_string2utf8(data, cont, args[1], args[2], args[3]);
}
-void _Cyc_91utf8_91_125string(void *data, object clo, int argc, object *args)
+void _Cyc_91utf8_91_125string(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-utf8->string", argc - 1, 3);
object cont = args[0];
Cyc_utf82string(data, cont, args[1], args[2], args[3]);
}
-void _vector_91length(void *data, object clo, int argc, object *args)
+void _vector_91length(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "vector-length", argc - 1, 1);
{
@@ -5241,35 +5318,35 @@ void _vector_91length(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _null_127(void *data, object clo, int argc, object *args)
+void _null_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "null?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_null(args[1]));
}
-void _set_91car_67(void *data, object clo, int argc, object *args)
+void _set_91car_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "set-car!", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, Cyc_set_car_cps(data, cont, args[1], args[2]));
}
-void _set_91cdr_67(void *data, object clo, int argc, object *args)
+void _set_91cdr_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "set-cdr!", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, Cyc_set_cdr_cps(data, cont, args[1], args[2]));
}
-void _Cyc_91has_91cycle_127(void *data, object clo, int argc, object *args)
+void _Cyc_91has_91cycle_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-has-cycle?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_has_cycle(args[1]));
}
-void _Cyc_91spawn_91thread_67(void *data, object clo, int argc, object *args)
+void _Cyc_91spawn_91thread_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-spawn-thread!", argc - 1, 1);
// TODO: validate argument type?
@@ -5277,24 +5354,24 @@ void _Cyc_91spawn_91thread_67(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, Cyc_spawn_thread(args[1]));
}
-void _Cyc_91end_91thread_67(void *data, object clo, int argc, object *args)
+void _Cyc_91end_91thread_67(void *data, object clo, int argc, object * args)
{
gc_thread_data *d = data;
vector_type *v = d->scm_thread_obj;
- v->elements[7] = args[0]; // Store thread result
+ v->elements[7] = args[0]; // Store thread result
Cyc_end_thread((gc_thread_data *) data);
object cont = args[0];
return_closcall1(data, cont, boolean_f);
}
-void __87(void *data, object clo, int argc, object *args)
+void __87(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_sum(data, cont, argc, args);
}
-void __91(void *data, object clo, int argc, object *args)
+void __91(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "-", argc - 1, 1);
{
@@ -5302,13 +5379,13 @@ void __91(void *data, object clo, int argc, object *args)
dispatch_sub(data, cont, argc, args);
}}
-void __85(void *data, object clo, int argc, object *args)
+void __85(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_mul(data, cont, argc, args);
}
-void __95(void *data, object clo, int argc, object *args)
+void __95(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "/", argc - 1, 1);
{
@@ -5316,147 +5393,147 @@ void __95(void *data, object clo, int argc, object *args)
dispatch_div(data, cont, argc, args);
}}
-void _Cyc_91cvar_127(void *data, object clo, int argc, object *args)
+void _Cyc_91cvar_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-cvar?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_cvar(args[1]));
}
-void _Cyc_91opaque_127(void *data, object clo, int argc, object *args)
+void _Cyc_91opaque_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-opaque?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_opaque(args[1]));
}
-void _boolean_127(void *data, object clo, int argc, object *args)
+void _boolean_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "boolean?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_boolean(args[1]));
}
-void _char_127(void *data, object clo, int argc, object *args)
+void _char_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "char?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_char(args[1]));
}
-void _eof_91object_127(void *data, object clo, int argc, object *args)
+void _eof_91object_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "eof_91object?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_eof_object(args[1]));
}
-void _number_127(void *data, object clo, int argc, object *args)
+void _number_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "number?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_number(args[1]));
}
-void _real_127(void *data, object clo, int argc, object *args)
+void _real_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "real?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_real(args[1]));
}
-void _integer_127(void *data, object clo, int argc, object *args)
+void _integer_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "integer?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_integer(args[1]));
}
-void _pair_127(void *data, object clo, int argc, object *args)
+void _pair_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "pair?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_pair(args[1]));
}
-void _procedure_127(void *data, object clo, int argc, object *args)
+void _procedure_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "procedure?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_procedure(data, args[1]));
}
-void _macro_127(void *data, object clo, int argc, object *args)
+void _macro_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "macro?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_macro(args[1]));
}
-void _Cyc_91macro_127(void *data, object clo, int argc, object *args)
+void _Cyc_91macro_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-macro?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_macro(args[1]));
}
-void _port_127(void *data, object clo, int argc, object *args)
+void _port_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "port?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_port(args[1]));
}
-void _bytevector_127(void *data, object clo, int argc, object *args)
+void _bytevector_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "bytevector?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_bytevector(args[1]));
}
-void _vector_127(void *data, object clo, int argc, object *args)
+void _vector_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "vector?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_vector_not_record_type(args[1]));
}
-void _string_127(void *data, object clo, int argc, object *args)
+void _string_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_string(args[1]));
}
-void _symbol_127(void *data, object clo, int argc, object *args)
+void _symbol_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "symbol?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_is_symbol(args[1]));
}
-void _Cyc_91get_91cvar(void *data, object clo, int argc, object *args)
+void _Cyc_91get_91cvar(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-get-cvar", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_get_cvar(args[1]));
}
-void _Cyc_91set_91cvar_67(void *data, object clo, int argc, object *args)
+void _Cyc_91set_91cvar_67(void *data, object clo, int argc, object * args)
{
printf("not implemented\n");
exit(1);
}
/* Note we cannot use _exit (per convention) because it is reserved by C */
-void _cyc_exit(void *data, object clo, int argc, object *args)
+void _cyc_exit(void *data, object clo, int argc, object * args)
{
if (args == NULL)
__halt(NULL);
__halt(args[1]);
}
-void __75halt(void *data, object clo, int argc, object *args)
+void __75halt(void *data, object clo, int argc, object * args)
{
#if DEBUG_SHOW_DIAG
gc_print_stats(Cyc_heap);
@@ -5464,95 +5541,95 @@ void __75halt(void *data, object clo, int argc, object *args)
exit(0);
}
-void _cell_91get(void *data, object clo, int argc, object *args)
+void _cell_91get(void *data, object clo, int argc, object * args)
{
printf("not implemented\n");
exit(1);
}
-void _set_91global_67(void *data, object clo, int argc, object *args)
+void _set_91global_67(void *data, object clo, int argc, object * args)
{
printf("not implemented\n");
exit(1);
}
-void _set_91cell_67(void *data, object clo, int argc, object *args)
+void _set_91cell_67(void *data, object clo, int argc, object * args)
{
printf("not implemented\n");
exit(1);
}
-void _cell(void *data, object clo, int argc, object *args)
+void _cell(void *data, object clo, int argc, object * args)
{
printf("not implemented\n");
exit(1);
}
-void __123(void *data, object clo, int argc, object *args)
+void __123(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_num_eq(data, cont, argc, args);
}
-void __125(void *data, object clo, int argc, object *args)
+void __125(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_num_gt(data, cont, argc, args);
}
-void __121(void *data, object clo, int argc, object *args)
+void __121(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_num_lt(data, cont, argc, args);
}
-void __125_123(void *data, object clo, int argc, object *args)
+void __125_123(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_num_gte(data, cont, argc, args);
}
-void __121_123(void *data, object clo, int argc, object *args)
+void __121_123(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_num_lte(data, cont, argc, args);
}
-void _apply(void *data, object clo, int argc, object *args)
+void _apply(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_apply_va(data, cont, argc, args);
}
-void _assq(void *data, object clo, int argc, object *args)
+void _assq(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "assq", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, assq(data, args[1], args[2]));
}
-void _assv(void *data, object clo, int argc, object *args)
+void _assv(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "assv", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, assv(data, args[1], args[2]));
}
-void _memq(void *data, object clo, int argc, object *args)
+void _memq(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "memq", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, memqp(data, args[1], args[2]));
}
-void _memv(void *data, object clo, int argc, object *args)
+void _memv(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "memv", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, memvp(data, args[1], args[2]));
}
-void _char_91_125integer(void *data, object clo, int argc, object *args)
+void _char_91_125integer(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "char->integer", argc - 1, 1);
{
@@ -5561,14 +5638,14 @@ void _char_91_125integer(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _integer_91_125char(void *data, object clo, int argc, object *args)
+void _integer_91_125char(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "integer->char", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_integer2char(data, args[1]));
}
-void _string_91_125number(void *data, object clo, int argc, object *args)
+void _string_91_125number(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string->number", argc - 1, 1);
{
@@ -5581,7 +5658,7 @@ void _string_91_125number(void *data, object clo, int argc, object *args)
}
}
-void _string_91length(void *data, object clo, int argc, object *args)
+void _string_91length(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string-length", argc - 1, 1);
{
@@ -5590,14 +5667,14 @@ void _string_91length(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _cyc_substring(void *data, object clo, int argc, object *args)
+void _cyc_substring(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "substring", argc - 1, 3);
object cont = args[0];
Cyc_substring(data, cont, args[1], args[2], args[3]);
}
-void _cyc_string_91set_67(void *data, object clo, int argc, object *args)
+void _cyc_string_91set_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string-set!", argc - 1, 3);
{
@@ -5606,7 +5683,7 @@ void _cyc_string_91set_67(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, s);
}}
-void _cyc_string_91ref(void *data, object clo, int argc, object *args)
+void _cyc_string_91ref(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string-ref", argc - 1, 2);
{
@@ -5615,28 +5692,30 @@ void _cyc_string_91ref(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, c);
}}
-void _Cyc_91installation_91dir(void *data, object clo, int argc, object *args)
+void _Cyc_91installation_91dir(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-installation-dir", argc - 1, 1);
object cont = args[0];
Cyc_installation_dir(data, cont, args[1]);
}
-void _Cyc_91compilation_91environment(void *data, object clo, int argc, object *args)
+void _Cyc_91compilation_91environment(void *data, object clo, int argc,
+ object * args)
{
Cyc_check_argc(data, "Cyc-compilation-environment", argc - 1, 1);
object cont = args[0];
Cyc_compilation_environment(data, cont, args[1]);
}
-void _command_91line_91arguments(void *data, object clo, int argc, object *args)
+void _command_91line_91arguments(void *data, object clo, int argc,
+ object * args)
{
object cont = args[0];
object cmdline = Cyc_command_line_arguments(data, cont);
return_closcall1(data, cont, cmdline);
}
-void _cyc_system(void *data, object clo, int argc, object *args)
+void _cyc_system(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "system", argc - 1, 1);
{
@@ -5645,21 +5724,23 @@ void _cyc_system(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _Cyc_91current_91exception_91handler(void *data, object clo, int argc, object *args)
+void _Cyc_91current_91exception_91handler(void *data, object clo, int argc,
+ object * args)
{
object handler = Cyc_current_exception_handler(data);
object cont = args[0];
return_closcall1(data, cont, handler);
}
-void _Cyc_91default_91exception_91handler(void *data, object clo, int argc, object *args)
+void _Cyc_91default_91exception_91handler(void *data, object clo, int argc,
+ object * args)
{
//object cont = args[0];
- object buf[1] = {args[1]};
+ object buf[1] = { args[1] };
Cyc_default_exception_handler(data, NULL, 1, buf);
}
-void _string_91cmp(void *data, object clo, int argc, object *args)
+void _string_91cmp(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string-cmp", argc - 1, 2);
{
@@ -5668,13 +5749,13 @@ void _string_91cmp(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, obj);
}}
-void _string_91append(void *data, object clo, int argc, object *args)
+void _string_91append(void *data, object clo, int argc, object * args)
{
object cont = args[0];
dispatch_string_91append(data, cont, argc, args);
}
-void _make_91vector(void *data, object clo, int argc, object *args)
+void _make_91vector(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "make-vector", argc - 1, 1);
{
@@ -5687,7 +5768,7 @@ void _make_91vector(void *data, object clo, int argc, object *args)
}
}
-void _make_91bytevector(void *data, object clo, int argc, object *args)
+void _make_91bytevector(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "make-bytevector", argc - 1, 1);
{
@@ -5700,7 +5781,7 @@ void _make_91bytevector(void *data, object clo, int argc, object *args)
}
}
-void _vector_91ref(void *data, object clo, int argc, object *args)
+void _vector_91ref(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "vector-ref", argc - 1, 2);
{
@@ -5709,7 +5790,7 @@ void _vector_91ref(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, ref);
}}
-void _vector_91set_67(void *data, object clo, int argc, object *args)
+void _vector_91set_67(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "vector-set!", argc - 1, 3);
{
@@ -5718,35 +5799,35 @@ void _vector_91set_67(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, ref);
}}
-void _list_91_125vector(void *data, object clo, int argc, object *args)
+void _list_91_125vector(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "list->vector", argc - 1, 1);
object cont = args[0];
Cyc_list2vector(data, cont, args[1]);
}
-void _list_91_125string(void *data, object clo, int argc, object *args)
+void _list_91_125string(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "list->string", argc - 1, 1);
object cont = args[0];
Cyc_list2string(data, cont, args[1]);
}
-void _string_91_125symbol(void *data, object clo, int argc, object *args)
+void _string_91_125symbol(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "string->symbol", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_string2symbol(data, args[1]));
}
-void _symbol_91_125string(void *data, object clo, int argc, object *args)
+void _symbol_91_125string(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "symbol->string", argc - 1, 1);
object cont = args[0];
Cyc_symbol2string(data, cont, args[1]);
}
-void _number_91_125string(void *data, object clo, int argc, object *args)
+void _number_91_125string(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "number->string", argc - 1, 1);
{
@@ -5759,7 +5840,7 @@ void _number_91_125string(void *data, object clo, int argc, object *args)
}
}
-void _open_91input_91file(void *data, object clo, int argc, object *args)
+void _open_91input_91file(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "open-input-file", argc - 1, 1);
{
@@ -5768,7 +5849,7 @@ void _open_91input_91file(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, &p);
}}
-void _open_91output_91file(void *data, object clo, int argc, object *args)
+void _open_91output_91file(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "open-output-file", argc - 1, 1);
{
@@ -5777,7 +5858,8 @@ void _open_91output_91file(void *data, object clo, int argc, object *args)
return_closcall1(data, cont, &p);
}}
-void _open_91binary_91input_91file(void *data, object clo, int argc, object *args)
+void _open_91binary_91input_91file(void *data, object clo, int argc,
+ object * args)
{
Cyc_check_argc(data, "open-binary-input-file", argc - 1, 1);
{
@@ -5786,7 +5868,8 @@ void _open_91binary_91input_91file(void *data, object clo, int argc, object *arg
return_closcall1(data, cont, &p);
}}
-void _open_91binary_91output_91file(void *data, object clo, int argc, object *args)
+void _open_91binary_91output_91file(void *data, object clo, int argc,
+ object * args)
{
Cyc_check_argc(data, "open-binary-output-file", argc - 1, 1);
{
@@ -5795,77 +5878,78 @@ void _open_91binary_91output_91file(void *data, object clo, int argc, object *ar
return_closcall1(data, cont, &p);
}}
-void _close_91port(void *data, object clo, int argc, object *args)
+void _close_91port(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "close-port", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_close_port(data, args[1]));
}
-void _close_91input_91port(void *data, object clo, int argc, object *args)
+void _close_91input_91port(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "close-input-port", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_close_input_port(data, args[1]));
}
-void _close_91output_91port(void *data, object clo, int argc, object *args)
+void _close_91output_91port(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "close-output-port", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_close_output_port(data, args[1]));
}
-void _Cyc_91flush_91output_91port(void *data, object clo, int argc, object *args)
+void _Cyc_91flush_91output_91port(void *data, object clo, int argc,
+ object * args)
{
Cyc_check_argc(data, "Cyc-flush-output-port", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_flush_output_port(data, args[1]));
}
-void _file_91exists_127(void *data, object clo, int argc, object *args)
+void _file_91exists_127(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "file-exists?", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_file_exists(data, args[1]));
}
-void _delete_91file(void *data, object clo, int argc, object *args)
+void _delete_91file(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "delete-file", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_delete_file(data, args[1]));
}
-void _read_91char(void *data, object clo, int argc, object *args)
+void _read_91char(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "read-char", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_read_char(data, cont, args[1]));
}
-void _peek_91char(void *data, object clo, int argc, object *args)
+void _peek_91char(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "peek-char", argc - 1, 1);
object cont = args[0];
return_closcall1(data, cont, Cyc_io_peek_char(data, cont, args[1]));
}
-void _Cyc_91read_91line(void *data, object clo, int argc, object *args)
+void _Cyc_91read_91line(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "Cyc-read-line", argc - 1, 1);
object cont = args[0];
Cyc_io_read_line(data, cont, args[1]);
}
-void _Cyc_91write_91char(void *data, object clo, int argc, object *args)
+void _Cyc_91write_91char(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "write-char", argc - 1, 2);
object cont = args[0];
return_closcall1(data, cont, Cyc_write_char(data, args[1], args[2]));
}
-void _Cyc_91write(void *data, object clo, int argc, object *args)
+void _Cyc_91write(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "write", argc - 1, 1);
{
@@ -5876,9 +5960,10 @@ void _Cyc_91write(void *data, object clo, int argc, object *args)
buf[1] = args[2];
}
dispatch_write_va(data, cont, argc - 1, buf);
-}}
+ }
+}
-void _display(void *data, object clo, int argc, object *args)
+void _display(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "display", argc - 1, 1);
{
@@ -5892,7 +5977,7 @@ void _display(void *data, object clo, int argc, object *args)
}
}
-void _call_95cc(void *data, object clo, int argc, object *args)
+void _call_95cc(void *data, object clo, int argc, object * args)
{
Cyc_check_argc(data, "call/cc", argc - 1, 1);
object cont = args[0];
@@ -5935,14 +6020,14 @@ void _call_95cc(void *data, object clo, int argc, object *args)
va_end(ap);
//void dispatch_apply_va(void *data, int argc, object clo, object cont, object func, ...)
-void dispatch_apply_va(void *data, object clo, int argc, object *args)
+void dispatch_apply_va(void *data, object clo, int argc, object * args)
{
list lis = NULL, prev = NULL;
object tmp;
// cargs TODO: check num args to make this safe
object func = args[1];
int i;
- argc = argc - 1; // Required for "dispatch" function
+ argc = argc - 1; // Required for "dispatch" function
if (argc == 2) {
lis = args[2];
Cyc_check_pair_or_null(data, lis);
@@ -5970,8 +6055,7 @@ object apply_va(void *data, object cont, int argc, object func, ...)
object tmp;
int i;
va_list ap;
- do_apply_va
- return apply(data, cont, func, lis); // Never actually returns
+ do_apply_va return apply(data, cont, func, lis); // Never actually returns
}
/*
@@ -6000,10 +6084,10 @@ object apply(void *data, object cont, object func, object args)
count = obj_obj2int(Cyc_length(data, args));
if (func == Cyc_glo_call_cc) {
Cyc_check_num_args(data, "<procedure>", 1, args, count);
- dispatch(data, count, ((closure) func)->fn, func, cont,
- args);
+ dispatch(data, count, ((closure) func)->fn, func, cont, args);
} else {
- Cyc_check_num_args(data, "<procedure>", ((closure) func)->num_args, args, count);
+ Cyc_check_num_args(data, "<procedure>", ((closure) func)->num_args, args,
+ count);
dispatch(data, count, ((closure) func)->fn, func, cont, args);
}
break;
@@ -6015,23 +6099,26 @@ object apply(void *data, object cont, object func, object args)
if (!is_object_type(fobj) || type_of(fobj) != symbol_tag) {
Cyc_rt_raise2(data, "Call of non-procedure: ", func);
- } else if (strncmp(((symbol) fobj)->desc, "lambda", 7) == 0 && Cyc_glo_eval_from_c != NULL) {
+ } else if (strncmp(((symbol) fobj)->desc, "lambda", 7) == 0
+ && Cyc_glo_eval_from_c != NULL) {
make_pair(c, func, args);
//printf("JAE DEBUG, sending to eval: ");
//Cyc_display(data, &c, stderr);
- object buf[3] = {cont, &c, NULL};
+ object buf[3] = { cont, &c, NULL };
((closure) Cyc_glo_eval_from_c)->fn(data, Cyc_glo_eval_from_c, 2, buf);
// TODO: would be better to compare directly against symbols here,
// but need a way of looking them up ahead of time.
// maybe a libinit() or such is required.
- } else if (strncmp(((symbol) fobj)->desc, "primitive", 10) == 0 && Cyc_glo_eval_from_c != NULL) {
+ } else if (strncmp(((symbol) fobj)->desc, "primitive", 10) == 0
+ && Cyc_glo_eval_from_c != NULL) {
make_pair(c, cadr(func), args);
- object buf[3] = {cont, &c, NULL};
+ object buf[3] = { cont, &c, NULL };
((closure) Cyc_glo_eval_from_c)->fn(data, Cyc_glo_eval_from_c, 3, buf);
- } else if (strncmp(((symbol) fobj)->desc, "procedure", 10) == 0 && Cyc_glo_eval_from_c != NULL) {
+ } else if (strncmp(((symbol) fobj)->desc, "procedure", 10) == 0
+ && Cyc_glo_eval_from_c != NULL) {
make_pair(c, func, args);
- object buf[3] = {cont, &c, NULL};
+ object buf[3] = { cont, &c, NULL };
((closure) Cyc_glo_eval_from_c)->fn(data, Cyc_glo_eval_from_c, 3, buf);
} else {
make_pair(c, func, args);
@@ -6039,7 +6126,7 @@ object apply(void *data, object cont, object func, object args)
}
}
- default: {
+ default:{
Cyc_rt_raise2(data, "Call of non-procedure: ", func);
}
}
@@ -6047,7 +6134,7 @@ object apply(void *data, object cont, object func, object args)
}
// Version of apply meant to be called from within compiled code
-void Cyc_apply(void *data, object prim, int argc, object *args)
+void Cyc_apply(void *data, object prim, int argc, object * args)
{
object tmp;
int i;
@@ -6059,12 +6146,12 @@ void Cyc_apply(void *data, object prim, int argc, object *args)
for (i = 1; i < argc; i++) {
tmp = args[i];
- arglis[i-1].hdr.mark = gc_color_red;
- arglis[i-1].hdr.grayed = 0;
- arglis[i-1].hdr.immutable = 0;
- arglis[i-1].tag = pair_tag;
- arglis[i-1].pair_car = tmp;
- arglis[i-1].pair_cdr = (i == (argc - 1)) ? NULL : &arglis[i];
+ arglis[i - 1].hdr.mark = gc_color_red;
+ arglis[i - 1].hdr.grayed = 0;
+ arglis[i - 1].hdr.immutable = 0;
+ arglis[i - 1].tag = pair_tag;
+ arglis[i - 1].pair_car = tmp;
+ arglis[i - 1].pair_cdr = (i == (argc - 1)) ? NULL : &arglis[i];
}
//printf("DEBUG applying primitive to ");
//Cyc_display(data, (object)&arglis[0]);
@@ -6120,7 +6207,7 @@ void Cyc_start_trampoline(gc_thread_data * thd)
Cyc_apply_from_buf(thd, thd->gc_num_args, thd->gc_cont, thd->gc_args);
} else {
closure clo = thd->gc_cont;
- (clo->fn)(thd, clo, thd->gc_num_args, thd->gc_args);
+ (clo->fn) (thd, clo, thd->gc_num_args, thd->gc_args);
}
fprintf(stderr, "Internal error: should never have reached this line\n");
@@ -6141,7 +6228,8 @@ void gc_request_mark_globals(void)
* @param alloci Pointer to the next open slot in the buffer
* @param obj Object to add
*/
-static void gc_thr_add_to_move_buffer(gc_thread_data * d, int *alloci, object obj)
+static void gc_thr_add_to_move_buffer(gc_thread_data * d, int *alloci,
+ object obj)
{
if (*alloci == d->moveBufLen) {
gc_thr_grow_move_buffer(d);
@@ -6152,7 +6240,7 @@ static void gc_thr_add_to_move_buffer(gc_thread_data * d, int *alloci, object ob
}
static char *gc_fixup_moved_obj(gc_thread_data * thd, int *alloci, char *obj,
- object hp)
+ object hp)
{
int acquired_lock = 0;
if (grayed(obj)) {
@@ -6175,7 +6263,8 @@ static char *gc_fixup_moved_obj(gc_thread_data * thd, int *alloci, char *obj,
return (char *)hp;
}
-static char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_grown)
+static char *gc_move(char *obj, gc_thread_data * thd, int *alloci,
+ int *heap_grown)
{
gc_heap_root *heap = thd->heap;
if (!is_object_type(obj))
@@ -6220,23 +6309,20 @@ static char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_gro
return gc_fixup_moved_obj(thd, alloci, obj, hp);
}
case port_tag:{
- port_type *hp =
- gc_alloc(heap, sizeof(port_type), obj, thd, heap_grown);
+ port_type *hp = gc_alloc(heap, sizeof(port_type), obj, thd, heap_grown);
return gc_fixup_moved_obj(thd, alloci, obj, hp);
}
case bignum_tag:{
- bignum_type *hp =
+ bignum_type *hp =
gc_alloc(heap, sizeof(bignum_type), obj, thd, heap_grown);
return gc_fixup_moved_obj(thd, alloci, obj, hp);
- }
+ }
case cvar_tag:{
- cvar_type *hp =
- gc_alloc(heap, sizeof(cvar_type), obj, thd, heap_grown);
+ cvar_type *hp = gc_alloc(heap, sizeof(cvar_type), obj, thd, heap_grown);
return gc_fixup_moved_obj(thd, alloci, obj, hp);
}
case macro_tag:{
- macro_type *hp =
- gc_alloc(heap, sizeof(macro_type), obj, thd, heap_grown);
+ macro_type *hp = gc_alloc(heap, sizeof(macro_type), obj, thd, heap_grown);
return gc_fixup_moved_obj(thd, alloci, obj, hp);
}
case closure1_tag:{
@@ -6369,7 +6455,7 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont,
}
} else if (type_of(o) == cvar_tag) {
cvar_type *c = (cvar_type *) o;
- gc_move2heap(*(c->pvar)); // Transport underlying global, not the pvar
+ gc_move2heap(*(c->pvar)); // Transport underlying global, not the pvar
} else {
printf("Unexpected type %d transporting mutation\n", type_of(o));
exit(1);
@@ -6381,18 +6467,17 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont,
// Collect globals but only if a change was made. This avoids traversing a
// long list of objects unless absolutely necessary.
if (((gc_thread_data *) data)->globals_changed) {
- ((gc_thread_data *) data)->globals_changed = 0;
+ ((gc_thread_data *) data)->globals_changed = 0;
// Transport globals
- gc_move2heap(Cyc_global_variables); // Internal global used by the runtime
+ gc_move2heap(Cyc_global_variables); // Internal global used by the runtime
{
list l = global_table;
for (; l != NULL; l = cdr(l)) {
cvar_type *c = (cvar_type *) car(l);
- gc_move2heap(*(c->pvar)); // Transport underlying global, not the pvar
+ gc_move2heap(*(c->pvar)); // Transport underlying global, not the pvar
}
}
}
-
// Check allocated objects, moving additional objects as needed
while (scani < alloci) {
object obj = ((gc_thread_data *) data)->moveBuf[scani];
@@ -6464,13 +6549,13 @@ void GC(void *data, closure cont, object * args, int num_args)
object low_limit = &tmp; // This is one end of the stack...
object high_limit = ((gc_thread_data *) data)->stack_start;
#ifdef CYC_HIGH_RES_TIMERS
-long long tstamp = hrt_get_current();
+ long long tstamp = hrt_get_current();
#endif
int alloci = gc_minor(data, low_limit, high_limit, cont, args, num_args);
// Cooperate with the collector thread
gc_mut_cooperate((gc_thread_data *) data, alloci);
#ifdef CYC_HIGH_RES_TIMERS
-hrt_log_delta("minor gc", tstamp);
+ hrt_log_delta("minor gc", tstamp);
#endif
// Let it all go, Neo...
longjmp(*(((gc_thread_data *) data)->jmp_start), 1);
@@ -6482,41 +6567,43 @@ hrt_log_delta("minor gc", tstamp);
void Cyc_make_shared_object(void *data, object k, object obj)
{
- gc_thread_data *thd = (gc_thread_data *)data;
+ gc_thread_data *thd = (gc_thread_data *) data;
gc_heap_root *heap = thd->heap;
object buf[1];
int tmp, *heap_grown = &tmp;
- if (!is_object_type(obj) || // Immediates do not have to be moved
- !gc_is_stack_obj(&tmp, data, obj)) { // Not thread-local, assume already on heap
+ if (!is_object_type(obj) || // Immediates do not have to be moved
+ !gc_is_stack_obj(&tmp, data, obj)) { // Not thread-local, assume already on heap
return_closcall1(data, k, obj);
}
- switch(type_of(obj)) {
- // These are never on the stack, ignore them
- // cond_var_tag = 6
- // mutex_tag = 14
- // atomic_tag = 22
- // boolean_tag = 0
- // bignum_tag = 12
- // symbol_tag = 19
- // closure0_tag = 3
- // eof_tag = 9
- // void_tag
- // record_tag
- // macro_tag = 13
- // primitive_tag = 17
-
- // Copy stack-allocated objects with no children to the heap:
+ switch (type_of(obj)) {
+ // These are never on the stack, ignore them
+ // cond_var_tag = 6
+ // mutex_tag = 14
+ // atomic_tag = 22
+ // boolean_tag = 0
+ // bignum_tag = 12
+ // symbol_tag = 19
+ // closure0_tag = 3
+ // eof_tag = 9
+ // void_tag
+ // record_tag
+ // macro_tag = 13
+ // primitive_tag = 17
+
+ // Copy stack-allocated objects with no children to the heap:
case string_tag:
case double_tag:
case bytevector_tag:
case port_tag:
case c_opaque_tag:
- case complex_num_tag: {
- object hp = gc_alloc(heap, gc_allocated_bytes(obj, NULL, NULL), obj, thd, heap_grown);
- return_closcall1(data, k, hp);
- }
- // Objs w/children force minor GC to guarantee everything is relocated:
+ case complex_num_tag:{
+ object hp =
+ gc_alloc(heap, gc_allocated_bytes(obj, NULL, NULL), obj, thd,
+ heap_grown);
+ return_closcall1(data, k, hp);
+ }
+ // Objs w/children force minor GC to guarantee everything is relocated:
case cvar_tag:
case closure1_tag:
case closureN_tag:
@@ -6572,25 +6659,31 @@ static primitive_type Cyc_91spawn_91thread_67_primitive =
{ {0}, primitive_tag, &_Cyc_91spawn_91thread_67, "Cyc-spawn-thread!" };
static primitive_type Cyc_91end_91thread_67_primitive =
{ {0}, primitive_tag, &_Cyc_91end_91thread_67, "Cyc-end-thread!" };
-static primitive_type _87_primitive = { {0}, primitive_tag, &__87 , "+"};
-static primitive_type _91_primitive = { {0}, primitive_tag, &__91 , "-"};
-static primitive_type _85_primitive = { {0}, primitive_tag, &__85 , "*"};
-static primitive_type _95_primitive = { {0}, primitive_tag, &__95 , "/"};
+static primitive_type _87_primitive = { {0}, primitive_tag, &__87, "+" };
+static primitive_type _91_primitive = { {0}, primitive_tag, &__91, "-" };
+static primitive_type _85_primitive = { {0}, primitive_tag, &__85, "*" };
+static primitive_type _95_primitive = { {0}, primitive_tag, &__95, "/" };
static primitive_type _123_primitive = { {0}, primitive_tag, &__123, "=" };
static primitive_type _125_primitive = { {0}, primitive_tag, &__125, ">" };
static primitive_type _121_primitive = { {0}, primitive_tag, &__121, "<" };
-static primitive_type _125_123_primitive = { {0}, primitive_tag, &__125_123, ">="};
-static primitive_type _121_123_primitive = { {0}, primitive_tag, &__121_123, "<="};
-static primitive_type apply_primitive = { {0}, primitive_tag, &_apply , "apply"};
-static primitive_type _75halt_primitive = { {0}, primitive_tag, &__75halt , "%halt"};
-static primitive_type exit_primitive = { {0}, primitive_tag, &_cyc_exit, "exit"};
+static primitive_type _125_123_primitive =
+ { {0}, primitive_tag, &__125_123, ">=" };
+static primitive_type _121_123_primitive =
+ { {0}, primitive_tag, &__121_123, "<=" };
+static primitive_type apply_primitive =
+ { {0}, primitive_tag, &_apply, "apply" };
+static primitive_type _75halt_primitive =
+ { {0}, primitive_tag, &__75halt, "%halt" };
+static primitive_type exit_primitive =
+ { {0}, primitive_tag, &_cyc_exit, "exit" };
static primitive_type Cyc_91current_91exception_91handler_primitive =
{ {0}, primitive_tag, &_Cyc_91current_91exception_91handler,
- "Cyc_current_exception_handler" };
+"Cyc_current_exception_handler"
+};
static primitive_type Cyc_91default_91exception_91handler_primitive =
{ {0}, primitive_tag,
- &_Cyc_91default_91exception_91handler,
- "Cyc_default_exception_handler"
+&_Cyc_91default_91exception_91handler,
+"Cyc_default_exception_handler"
};
static primitive_type cons_primitive = { {0}, primitive_tag, &_cons, "cons" };
static primitive_type cell_91get_primitive =
@@ -6600,9 +6693,12 @@ static primitive_type set_91global_67_primitive =
static primitive_type set_91cell_67_primitive =
{ {0}, primitive_tag, &_set_91cell_67, "set-cell!" };
static primitive_type cell_primitive = { {0}, primitive_tag, &_cell, "cell" };
-static primitive_type eq_127_primitive = { {0}, primitive_tag, &_eq_127 , "eq?" };
-static primitive_type eqv_127_primitive = { {0}, primitive_tag, &_eqv_127 , "eqv?" };
-static primitive_type equal_127_primitive = { {0}, primitive_tag, &_equal_127, "equal?" };
+static primitive_type eq_127_primitive =
+ { {0}, primitive_tag, &_eq_127, "eq?" };
+static primitive_type eqv_127_primitive =
+ { {0}, primitive_tag, &_eqv_127, "eqv?" };
+static primitive_type equal_127_primitive =
+ { {0}, primitive_tag, &_equal_127, "equal?" };
static primitive_type assq_primitive = { {0}, primitive_tag, &_assq, "assq" };
static primitive_type assv_primitive = { {0}, primitive_tag, &_assv, "assv" };
static primitive_type memq_primitive = { {0}, primitive_tag, &_memq, "memq" };
@@ -6623,30 +6719,54 @@ static primitive_type caar_primitive = { {0}, primitive_tag, &_caar, "caar" };
static primitive_type cadr_primitive = { {0}, primitive_tag, &_cadr, "cadr" };
static primitive_type cdar_primitive = { {0}, primitive_tag, &_cdar, "cdar" };
static primitive_type cddr_primitive = { {0}, primitive_tag, &_cddr, "cddr" };
-static primitive_type caaar_primitive = { {0}, primitive_tag, &_caaar, "caaar" };
-static primitive_type caadr_primitive = { {0}, primitive_tag, &_caadr, "caadr" };
-static primitive_type cadar_primitive = { {0}, primitive_tag, &_cadar, "cadar" };
-static primitive_type caddr_primitive = { {0}, primitive_tag, &_caddr, "caddr" };
-static primitive_type cdaar_primitive = { {0}, primitive_tag, &_cdaar, "cdaar" };
-static primitive_type cdadr_primitive = { {0}, primitive_tag, &_cdadr, "cdadr" };
-static primitive_type cddar_primitive = { {0}, primitive_tag, &_cddar, "cddar" };
-static primitive_type cdddr_primitive = { {0}, primitive_tag, &_cdddr, "cdddr" };
-static primitive_type caaaar_primitive = { {0}, primitive_tag, &_caaaar, "caaaar" };
-static primitive_type caaadr_primitive = { {0}, primitive_tag, &_caaadr, "caaadr" };
-static primitive_type caadar_primitive = { {0}, primitive_tag, &_caadar, "caadar" };
-static primitive_type caaddr_primitive = { {0}, primitive_tag, &_caaddr, "caaddr" };
-static primitive_type cadaar_primitive = { {0}, primitive_tag, &_cadaar, "cadaar" };
-static primitive_type cadadr_primitive = { {0}, primitive_tag, &_cadadr, "cadadr" };
-static primitive_type caddar_primitive = { {0}, primitive_tag, &_caddar, "caddar" };
-static primitive_type cadddr_primitive = { {0}, primitive_tag, &_cadddr, "cadddr" };
-static primitive_type cdaaar_primitive = { {0}, primitive_tag, &_cdaaar, "cdaaar" };
-static primitive_type cdaadr_primitive = { {0}, primitive_tag, &_cdaadr, "cdaadr" };
-static primitive_type cdadar_primitive = { {0}, primitive_tag, &_cdadar, "cdadar" };
-static primitive_type cdaddr_primitive = { {0}, primitive_tag, &_cdaddr, "cdaddr" };
-static primitive_type cddaar_primitive = { {0}, primitive_tag, &_cddaar, "cddaar" };
-static primitive_type cddadr_primitive = { {0}, primitive_tag, &_cddadr, "cddadr" };
-static primitive_type cdddar_primitive = { {0}, primitive_tag, &_cdddar, "cdddar" };
-static primitive_type cddddr_primitive = { {0}, primitive_tag, &_cddddr, "cddddr" };
+static primitive_type caaar_primitive =
+ { {0}, primitive_tag, &_caaar, "caaar" };
+static primitive_type caadr_primitive =
+ { {0}, primitive_tag, &_caadr, "caadr" };
+static primitive_type cadar_primitive =
+ { {0}, primitive_tag, &_cadar, "cadar" };
+static primitive_type caddr_primitive =
+ { {0}, primitive_tag, &_caddr, "caddr" };
+static primitive_type cdaar_primitive =
+ { {0}, primitive_tag, &_cdaar, "cdaar" };
+static primitive_type cdadr_primitive =
+ { {0}, primitive_tag, &_cdadr, "cdadr" };
+static primitive_type cddar_primitive =
+ { {0}, primitive_tag, &_cddar, "cddar" };
+static primitive_type cdddr_primitive =
+ { {0}, primitive_tag, &_cdddr, "cdddr" };
+static primitive_type caaaar_primitive =
+ { {0}, primitive_tag, &_caaaar, "caaaar" };
+static primitive_type caaadr_primitive =
+ { {0}, primitive_tag, &_caaadr, "caaadr" };
+static primitive_type caadar_primitive =
+ { {0}, primitive_tag, &_caadar, "caadar" };
+static primitive_type caaddr_primitive =
+ { {0}, primitive_tag, &_caaddr, "caaddr" };
+static primitive_type cadaar_primitive =
+ { {0}, primitive_tag, &_cadaar, "cadaar" };
+static primitive_type cadadr_primitive =
+ { {0}, primitive_tag, &_cadadr, "cadadr" };
+static primitive_type caddar_primitive =
+ { {0}, primitive_tag, &_caddar, "caddar" };
+static primitive_type cadddr_primitive =
+ { {0}, primitive_tag, &_cadddr, "cadddr" };
+static primitive_type cdaaar_primitive =
+ { {0}, primitive_tag, &_cdaaar, "cdaaar" };
+static primitive_type cdaadr_primitive =
+ { {0}, primitive_tag, &_cdaadr, "cdaadr" };
+static primitive_type cdadar_primitive =
+ { {0}, primitive_tag, &_cdadar, "cdadar" };
+static primitive_type cdaddr_primitive =
+ { {0}, primitive_tag, &_cdaddr, "cdaddr" };
+static primitive_type cddaar_primitive =
+ { {0}, primitive_tag, &_cddaar, "cddaar" };
+static primitive_type cddadr_primitive =
+ { {0}, primitive_tag, &_cddadr, "cddadr" };
+static primitive_type cdddar_primitive =
+ { {0}, primitive_tag, &_cdddar, "cdddar" };
+static primitive_type cddddr_primitive =
+ { {0}, primitive_tag, &_cddddr, "cddddr" };
static primitive_type char_91_125integer_primitive =
{ {0}, primitive_tag, &_char_91_125integer, "char->integer" };
static primitive_type integer_91_125char_primitive =
@@ -6664,7 +6784,8 @@ static primitive_type string_91set_67_primitive =
static primitive_type Cyc_91installation_91dir_primitive =
{ {0}, primitive_tag, &_Cyc_91installation_91dir, "Cyc-installation-dir" };
static primitive_type Cyc_91compilation_91environment_primitive =
- { {0}, primitive_tag, &_Cyc_91compilation_91environment, "Cyc-compilation-environment" };
+ { {0}, primitive_tag, &_Cyc_91compilation_91environment,
+ "Cyc-compilation-environment" };
static primitive_type command_91line_91arguments_primitive =
{ {0}, primitive_tag, &_command_91line_91arguments, "command-line-arguments"
};
@@ -6744,9 +6865,11 @@ static primitive_type open_91input_91file_primitive =
static primitive_type open_91output_91file_primitive =
{ {0}, primitive_tag, &_open_91output_91file, "open-output-file" };
static primitive_type open_91binary_91input_91file_primitive =
- { {0}, primitive_tag, &_open_91binary_91input_91file, "open-binary-input-file" };
+ { {0}, primitive_tag, &_open_91binary_91input_91file,
+ "open-binary-input-file" };
static primitive_type open_91binary_91output_91file_primitive =
- { {0}, primitive_tag, &_open_91binary_91output_91file, "open-binary-output-file" };
+ { {0}, primitive_tag, &_open_91binary_91output_91file,
+ "open-binary-output-file" };
static primitive_type close_91port_primitive =
{ {0}, primitive_tag, &_close_91port, "close-port" };
static primitive_type close_91input_91port_primitive =
@@ -6754,7 +6877,8 @@ static primitive_type close_91input_91port_primitive =
static primitive_type close_91output_91port_primitive =
{ {0}, primitive_tag, &_close_91output_91port, "close-output-port" };
static primitive_type Cyc_91flush_91output_91port_primitive =
- { {0}, primitive_tag, &_Cyc_91flush_91output_91port, "Cyc-flush-output-port" };
+ { {0}, primitive_tag, &_Cyc_91flush_91output_91port,
+ "Cyc-flush-output-port" };
static primitive_type file_91exists_127_primitive =
{ {0}, primitive_tag, &_file_91exists_127, "file-exists?" };
static primitive_type delete_91file_primitive =
@@ -6900,8 +7024,10 @@ const object primitive_bytevector_127 = &bytevector_127_primitive;
const object primitive_symbol_127 = &symbol_127_primitive;
const object primitive_open_91input_91file = &open_91input_91file_primitive;
const object primitive_open_91output_91file = &open_91output_91file_primitive;
-const object primitive_open_91binary_91input_91file = &open_91binary_91input_91file_primitive;
-const object primitive_open_91binary_91output_91file = &open_91binary_91output_91file_primitive;
+const object primitive_open_91binary_91input_91file =
+ &open_91binary_91input_91file_primitive;
+const object primitive_open_91binary_91output_91file =
+ &open_91binary_91output_91file_primitive;
const object primitive_close_91port = &close_91port_primitive;
const object primitive_close_91input_91port = &close_91input_91port_primitive;
const object primitive_close_91output_91port = &close_91output_91port_primitive;
@@ -6917,7 +7043,7 @@ const object primitive_Cyc_91write = &Cyc_91write_primitive;
const object primitive_Cyc_91display = &Cyc_91display_primitive;
const object primitive_call_95cc = &call_95cc_primitive;
-void *gc_alloc_pair(gc_thread_data *data, object head, object tail)
+void *gc_alloc_pair(gc_thread_data * data, object head, object tail)
{
int heap_grown;
pair_type *p;
@@ -6928,7 +7054,8 @@ void *gc_alloc_pair(gc_thread_data *data, object head, object tail)
tmp.tag = pair_tag;
tmp.pair_car = head;
tmp.pair_cdr = tail;
- p = gc_alloc(((gc_thread_data *)data)->heap, sizeof(pair_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
+ p = gc_alloc(((gc_thread_data *) data)->heap, sizeof(pair_type),
+ (char *)(&tmp), (gc_thread_data *) data, &heap_grown);
return p;
}
@@ -6936,7 +7063,7 @@ void *gc_alloc_pair(gc_thread_data *data, object head, object tail)
/**
* Thread initialization function only called from within the runtime
*/
-void *Cyc_init_thread(object thread_and_thunk, int argc, object *args)
+void *Cyc_init_thread(object thread_and_thunk, int argc, object * args)
{
int i;
vector_type *t;
@@ -6946,15 +7073,15 @@ void *Cyc_init_thread(object thread_and_thunk, int argc, object *args)
gc_thread_data *thd;
// Extract passed-in thread data object
- tmp = car(thread_and_thunk);
- t = (vector_type *)tmp;
- op = _unsafe_Cyc_vector_ref(t, obj_int2obj(2)); // Field set in thread-start!
+ tmp = car(thread_and_thunk);
+ t = (vector_type *) tmp;
+ op = _unsafe_Cyc_vector_ref(t, obj_int2obj(2)); // Field set in thread-start!
if (op == NULL) {
// Should never happen
thd = malloc(sizeof(gc_thread_data));
} else {
- o = (c_opaque_type *)op;
- thd = (gc_thread_data *)(opaque_ptr(o));
+ o = (c_opaque_type *) op;
+ thd = (gc_thread_data *) (opaque_ptr(o));
}
gc_thread_data_init(thd, 0, (char *)&stack_start, global_stack_size);
thd->scm_thread_obj = car(thread_and_thunk);
@@ -6975,10 +7102,10 @@ void *Cyc_init_thread(object thread_and_thunk, int argc, object *args)
thd->thread_id = pthread_self();
// Copy thread params from the calling thread
- t = (vector_type *)thd->scm_thread_obj;
- op = Cyc_vector_ref(thd, t, obj_int2obj(5)); // Field set in thread-start!
- o = (c_opaque_type *)op;
- parent = ((gc_thread_data *)o->ptr)->param_objs; // Unbox parent thread's data
+ t = (vector_type *) thd->scm_thread_obj;
+ op = Cyc_vector_ref(thd, t, obj_int2obj(5)); // Field set in thread-start!
+ o = (c_opaque_type *) op;
+ parent = ((gc_thread_data *) o->ptr)->param_objs; // Unbox parent thread's data
child = NULL;
thd->param_objs = NULL;
while (parent) {
@@ -7016,7 +7143,7 @@ object Cyc_spawn_thread(object thread_and_thunk)
pthread_attr_t attr;
pthread_attr_init(&attr);
#ifdef CYC_PTHREAD_SET_STACK_SIZE
- pthread_attr_setstacksize(&attr, 1024*1024*8);
+ pthread_attr_setstacksize(&attr, 1024 * 1024 * 8);
#endif
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
if (pthread_create(&thread, &attr, _Cyc_init_thread, thread_and_thunk)) {
@@ -7039,7 +7166,7 @@ void Cyc_end_thread(gc_thread_data * thd)
GC(thd, &clo, thd->gc_args, 0);
}
-void Cyc_exit_thread(void *data, object _, int argc, object *args)
+void Cyc_exit_thread(void *data, object _, int argc, object * args)
{
// alternatively could call longjmp with a null continuation, but that seems
// more complicated than necessary. or does it... see next comment:
@@ -7067,7 +7194,8 @@ object Cyc_thread_sleep(void *data, object timeout)
Cyc_check_num(data, timeout);
value = unbox_number(timeout);
tim.tv_sec = (long)value;
- tim.tv_nsec = (long)((value - tim.tv_sec) * 1000 * NANOSECONDS_PER_MILLISECOND);
+ tim.tv_nsec =
+ (long)((value - tim.tv_sec) * 1000 * NANOSECONDS_PER_MILLISECOND);
nanosleep(&tim, NULL);
return boolean_t;
}
@@ -7090,8 +7218,8 @@ object copy2heap(void *data, object obj)
return obj;
}
- return gc_alloc(((gc_thread_data *)data)->heap, gc_allocated_bytes(obj, NULL, NULL), obj, data,
- &on_stack);
+ return gc_alloc(((gc_thread_data *) data)->heap,
+ gc_allocated_bytes(obj, NULL, NULL), obj, data, &on_stack);
}
// TODO: version of above that will perform a deep copy (via GC) if necessary
@@ -7127,33 +7255,31 @@ vpbuffer *vp_create(void)
return v;
}
-void vp_add(vpbuffer *v, void *obj)
+void vp_add(vpbuffer * v, void *obj)
{
v->buf = vpbuffer_add(v->buf, &(v->len), v->count++, obj);
}
-object Cyc_bit_unset(void *data, object n1, object n2)
+object Cyc_bit_unset(void *data, object n1, object n2)
{
Cyc_check_int(data, n1);
Cyc_check_int(data, n2);
- return (obj_int2obj(
- obj_obj2int(n1) & ~(obj_obj2int(n2))));
+ return (obj_int2obj(obj_obj2int(n1) & ~(obj_obj2int(n2))));
}
-object Cyc_bit_set(void *data, object n1, object n2)
+object Cyc_bit_set(void *data, object n1, object n2)
{
Cyc_check_int(data, n1);
Cyc_check_int(data, n2);
- return (obj_int2obj(
- obj_obj2int(n1) | obj_obj2int(n2)));
+ return (obj_int2obj(obj_obj2int(n1) | obj_obj2int(n2)));
}
object Cyc_num2double(void *data, object ptr, object z)
{
- return_inexact_double_op_no_cps(data, ptr, (double), z);
+ return_inexact_double_op_no_cps(data, ptr, (double), z);
}
-void Cyc_make_rectangular(void *data, object k, object r, object i)
+void Cyc_make_rectangular(void *data, object k, object r, object i)
{
double_type dr, di;
Cyc_num2double(data, &dr, r);
@@ -7182,44 +7308,43 @@ The seeds for s20, s21, s22 must be integers in [0, m2 - 1] and not all 0.
//static double s10 = SEED, s11 = SEED, s12 = SEED,
// s20 = SEED, s21 = SEED, s22 = SEED;
-
-double MRG32k3a (double seed)
-{
- double s10 = seed, s11 = seed, s12 = seed,
- s20 = seed, s21 = seed, s22 = seed;
- long k;
- double p1, p2;
- /* Component 1 */
- p1 = a12 * s11 - a13n * s10;
- k = p1 / m1;
- p1 -= k * m1;
- if (p1 < 0.0)
- p1 += m1;
- s10 = s11;
- s11 = s12;
- s12 = p1;
-
- /* Component 2 */
- p2 = a21 * s22 - a23n * s20;
- k = p2 / m2;
- p2 -= k * m2;
- if (p2 < 0.0)
- p2 += m2;
- s20 = s21;
- s21 = s22;
- s22 = p2;
-
- /* Combination */
- if (p1 <= p2)
- return ((p1 - p2 + m1) * norm);
- else
- return ((p1 - p2) * norm);
+double MRG32k3a(double seed)
+{
+ double s10 = seed, s11 = seed, s12 = seed, s20 = seed, s21 = seed, s22 = seed;
+ long k;
+ double p1, p2;
+ /* Component 1 */
+ p1 = a12 * s11 - a13n * s10;
+ k = p1 / m1;
+ p1 -= k * m1;
+ if (p1 < 0.0)
+ p1 += m1;
+ s10 = s11;
+ s11 = s12;
+ s12 = p1;
+
+ /* Component 2 */
+ p2 = a21 * s22 - a23n * s20;
+ k = p2 / m2;
+ p2 -= k * m2;
+ if (p2 < 0.0)
+ p2 += m2;
+ s20 = s21;
+ s21 = s22;
+ s22 = p2;
+
+ /* Combination */
+ if (p1 <= p2)
+ return ((p1 - p2 + m1) * norm);
+ else
+ return ((p1 - p2) * norm);
}
-/* END RNG */
+/* END RNG */
/** Dynamic loading */
-void Cyc_import_shared_object(void *data, object cont, object filename, object entry_pt_fnc)
+void Cyc_import_shared_object(void *data, object cont, object filename,
+ object entry_pt_fnc)
{
char buffer[256];
void *handle;
@@ -7232,7 +7357,7 @@ void Cyc_import_shared_object(void *data, object cont, object filename, object e
make_utf8_string(data, s, buffer);
Cyc_rt_raise2(data, "Unable to import library", &s);
}
- dlerror(); /* Clear any existing error */
+ dlerror(); /* Clear any existing error */
if (string_len(entry_pt_fnc) == 0) {
// No entry point so this is a third party library.
@@ -7241,12 +7366,13 @@ void Cyc_import_shared_object(void *data, object cont, object filename, object e
} else {
entry_pt = (function_type) dlsym(handle, string_str(entry_pt_fnc));
if (entry_pt == NULL) {
- snprintf(buffer, 256, "%s, %s, %s", string_str(filename), string_str(entry_pt_fnc), dlerror());
+ snprintf(buffer, 256, "%s, %s, %s", string_str(filename),
+ string_str(entry_pt_fnc), dlerror());
make_utf8_string(data, s, buffer);
Cyc_rt_raise2(data, "Unable to load symbol", &s);
}
mclosure1(clo, entry_pt, cont);
- object buf[1] = {&clo};
+ object buf[1] = { &clo };
entry_pt(data, &clo, 1, buf);
}
}
@@ -7258,13 +7384,13 @@ void Cyc_import_shared_object(void *data, object cont, object filename, object e
* @param p Input port
* @return Number of characters read, or 0 for EOF/error
*/
-int read_from_port(port_type *p)
+int read_from_port(port_type * p)
{
size_t rv = 0;
FILE *fp = p->fp;
char *buf = p->mem_buf;
- while(1) {
+ while (1) {
errno = 0;
rv = fread(buf, sizeof(char), p->read_len, fp);
@@ -7284,16 +7410,15 @@ int read_from_port(port_type *p)
* @param p Input port
* @param msg Error message
*/
-static void _read_error(void *data, port_type *p, const char *msg)
+static void _read_error(void *data, port_type * p, const char *msg)
{
char buf[1024];
- snprintf(buf, 1023, "(line %d, column %d): %s",
- p->line_num, p->col_num, msg);
+ snprintf(buf, 1023, "(line %d, column %d): %s", p->line_num, p->col_num, msg);
// TODO: can't do this because thread is blocked, need to return a value to cont.
// the cont could receive an error and raise it though
//Cyc_rt_raise_msg(data, buf);
make_string(str, buf);
- str.num_cp = Cyc_utf8_count_code_points((uint8_t *)buf);
+ str.num_cp = Cyc_utf8_count_code_points((uint8_t *) buf);
make_empty_vector(vec);
vec.num_elements = 1;
vec.elements = (object *) alloca(sizeof(object) * vec.num_elements);
@@ -7305,17 +7430,17 @@ static void _read_error(void *data, port_type *p, const char *msg)
* @brief Helper function to read past a comment
* @param p Input port
*/
-static void _read_line_comment(port_type *p)
+static void _read_line_comment(port_type * p)
{
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
- break; // Return if buf is empty
+ if (!read_from_port(p)) {
+ break; // Return if buf is empty
}
}
if (p->mem_buf[p->buf_idx++] == '\n') {
- p->line_num++; // Ignore col_num since we are just skipping over chars
+ p->line_num++; // Ignore col_num since we are just skipping over chars
p->col_num = 1;
break;
}
@@ -7326,15 +7451,15 @@ static void _read_line_comment(port_type *p)
* @brief Helper function to read past a block comment
* @param p Input port
*/
-static void _read_multiline_comment(port_type *p)
+static void _read_multiline_comment(port_type * p)
{
int maybe_end = 0;
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
- break; // Return if buf is empty
+ if (!read_from_port(p)) {
+ break; // Return if buf is empty
}
}
@@ -7363,25 +7488,25 @@ static void _read_multiline_comment(port_type *p)
* @brief Helper function to read past whitespace characters
* @param p Input port
*/
-static void _read_whitespace(port_type *p)
+static void _read_whitespace(port_type * p)
{
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
- break; // Return if buf is empty
+ if (!read_from_port(p)) {
+ break; // Return if buf is empty
}
}
if (p->mem_buf[p->buf_idx] == '\n') {
p->buf_idx++;
- p->line_num++; // Ignore col_num since we are just skipping over chars
+ p->line_num++; // Ignore col_num since we are just skipping over chars
p->col_num = 1;
break;
} else if (isspace(p->mem_buf[p->buf_idx])) {
p->buf_idx++;
p->col_num++;
} else {
- break; // Terminate on non-whitespace char
+ break; // Terminate on non-whitespace char
}
}
}
@@ -7391,11 +7516,11 @@ static void _read_whitespace(port_type *p)
* @param p Input port
* @param c Character to add
*/
-static void _read_add_to_tok_buf(port_type *p, char c)
+static void _read_add_to_tok_buf(port_type * p, char c)
{
// FUTURE: more efficient to try and use mem_buf directly??
// complicates things with more edge cases though
- if ((p->tok_end + 1) == p->tok_buf_len) { // +1 for trailing \0 later on
+ if ((p->tok_end + 1) == p->tok_buf_len) { // +1 for trailing \0 later on
p->tok_buf_len *= 2;
p->tok_buf = realloc(p->tok_buf, p->tok_buf_len);
if (!p->tok_buf) {
@@ -7414,7 +7539,8 @@ static int _read_is_numeric(const char *tok, int len)
return (len &&
((isdigit(tok[0])) ||
((len > 1) && tok[0] == '.' && isdigit(tok[1])) ||
- ((len > 1) && (tok[1] == '.' || isdigit(tok[1])) && (tok[0] == '-' || tok[0] == '+'))));
+ ((len > 1) && (tok[1] == '.' || isdigit(tok[1]))
+ && (tok[0] == '-' || tok[0] == '+'))));
}
/**
@@ -7423,8 +7549,7 @@ static int _read_is_numeric(const char *tok, int len)
static int _read_is_complex_number(const char *tok, int len)
{
// Assumption: tok already passed checks from _read_is_numeric
- return (tok[len - 1] == 'i' ||
- tok[len - 1] == 'I');
+ return (tok[len - 1] == 'i' || tok[len - 1] == 'I');
}
/**
@@ -7433,8 +7558,7 @@ static int _read_is_complex_number(const char *tok, int len)
*/
static int _read_is_hex_digit(char c)
{
- return (c >= 'a' && c <= 'f') ||
- (c >= 'A' && c <= 'F');
+ return (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F');
}
/**
@@ -7443,15 +7567,14 @@ static int _read_is_hex_digit(char c)
* @param cont Current continuation
* @param p Input port
*/
-static void _read_string(void *data, object cont, port_type *p)
+static void _read_string(void *data, object cont, port_type * p)
{
char c;
- int escaped = 0, escaped_whitespace = 0,
- ewrn = 0; // esc whitespace read newline
- while(1) {
+ int escaped = 0, escaped_whitespace = 0, ewrn = 0; // esc whitespace read newline
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
+ if (!read_from_port(p)) {
_read_error(data, p, "Missing closing double-quote");
}
}
@@ -7506,44 +7629,44 @@ static void _read_string(void *data, object cont, port_type *p)
case 't':
_read_add_to_tok_buf(p, '\t');
break;
- case 'x': {
- char buf[32];
- int i = 0;
- while (i < 31){
- if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
- int rv = read_from_port(p);
- if (!rv) {
+ case 'x':{
+ char buf[32];
+ int i = 0;
+ while (i < 31) {
+ if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
+ int rv = read_from_port(p);
+ if (!rv) {
+ break;
+ }
+ }
+ if (p->mem_buf[p->buf_idx] == ';') {
+ p->buf_idx++;
break;
}
- }
- if (p->mem_buf[p->buf_idx] == ';'){
- p->buf_idx++;
- break;
- }
- // Verify if hex digit is valid
- if (!isdigit(p->mem_buf[p->buf_idx]) &&
- !_read_is_hex_digit(p->mem_buf[p->buf_idx])) {
+ // Verify if hex digit is valid
+ if (!isdigit(p->mem_buf[p->buf_idx]) &&
+ !_read_is_hex_digit(p->mem_buf[p->buf_idx])) {
+ p->buf_idx++;
+ _read_error(data, p, "invalid hex digit in string");
+ }
+ buf[i] = p->mem_buf[p->buf_idx];
p->buf_idx++;
- _read_error(data, p, "invalid hex digit in string");
+ p->col_num++;
+ i++;
}
- buf[i] = p->mem_buf[p->buf_idx];
- p->buf_idx++;
- p->col_num++;
- i++;
- }
- buf[i] = '\0';
- {
- char_type result = strtol(buf, NULL, 16);
- char cbuf[5];
- int i;
- Cyc_utf8_encode_char(cbuf, 5, result);
- for (i = 0; cbuf[i] != 0; i++) {
- _read_add_to_tok_buf(p, cbuf[i]);
+ buf[i] = '\0';
+ {
+ char_type result = strtol(buf, NULL, 16);
+ char cbuf[5];
+ int i;
+ Cyc_utf8_encode_char(cbuf, 5, result);
+ for (i = 0; cbuf[i] != 0; i++) {
+ _read_add_to_tok_buf(p, cbuf[i]);
+ }
+ //p->tok_buf[p->tok_end++] = (char)result;
}
- //p->tok_buf[p->tok_end++] = (char)result;
+ break;
}
- break;
- }
case '\r':
case '\t':
case ' ':
@@ -7558,12 +7681,12 @@ static void _read_string(void *data, object cont, port_type *p)
p->col_num = 1;
break;
default:
- _read_error(data, p, "invalid escape character in string"); // TODO: char
+ _read_error(data, p, "invalid escape character in string"); // TODO: char
break;
}
} else if (c == '"') {
- p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
- p->tok_end = 0; // Reset for next atom
+ p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
+ p->tok_end = 0; // Reset for next atom
{
make_utf8_string(data, str, p->tok_buf);
return_thread_runnable_with_obj(data, &str, p);
@@ -7585,14 +7708,14 @@ static void _read_string(void *data, object cont, port_type *p)
* @param data Thread data object
* @param p Input port
*/
-static void _read_literal_identifier(void *data, port_type *p)
+static void _read_literal_identifier(void *data, port_type * p)
{
char c;
int escaped = 0;
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
+ if (!read_from_port(p)) {
_read_error(data, p, "EOF encountered parsing literal identifier");
}
}
@@ -7624,51 +7747,51 @@ static void _read_literal_identifier(void *data, port_type *p)
case 't':
_read_add_to_tok_buf(p, '\t');
break;
- case 'x': {
- char buf[32];
- int i = 0;
- while (i < 31){
- if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
- int rv = read_from_port(p);
- if (!rv) {
+ case 'x':{
+ char buf[32];
+ int i = 0;
+ while (i < 31) {
+ if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
+ int rv = read_from_port(p);
+ if (!rv) {
+ break;
+ }
+ }
+ if (p->mem_buf[p->buf_idx] == ';') {
+ p->buf_idx++;
break;
}
- }
- if (p->mem_buf[p->buf_idx] == ';'){
- p->buf_idx++;
- break;
- }
- // Verify if hex digit is valid
- if (!isdigit(p->mem_buf[p->buf_idx]) &&
- !_read_is_hex_digit(p->mem_buf[p->buf_idx])) {
+ // Verify if hex digit is valid
+ if (!isdigit(p->mem_buf[p->buf_idx]) &&
+ !_read_is_hex_digit(p->mem_buf[p->buf_idx])) {
+ p->buf_idx++;
+ _read_error(data, p, "invalid hex digit in literal identifier");
+ }
+ buf[i] = p->mem_buf[p->buf_idx];
p->buf_idx++;
- _read_error(data, p, "invalid hex digit in literal identifier");
+ p->col_num++;
+ i++;
}
- buf[i] = p->mem_buf[p->buf_idx];
- p->buf_idx++;
- p->col_num++;
- i++;
- }
- buf[i] = '\0';
- {
- char_type result = strtol(buf, NULL, 16);
- char cbuf[5];
- int i;
- Cyc_utf8_encode_char(cbuf, 5, result);
- for (i = 0; cbuf[i] != 0; i++) {
- _read_add_to_tok_buf(p, cbuf[i]);
+ buf[i] = '\0';
+ {
+ char_type result = strtol(buf, NULL, 16);
+ char cbuf[5];
+ int i;
+ Cyc_utf8_encode_char(cbuf, 5, result);
+ for (i = 0; cbuf[i] != 0; i++) {
+ _read_add_to_tok_buf(p, cbuf[i]);
+ }
+ //p->tok_buf[p->tok_end++] = (char)result;
}
- //p->tok_buf[p->tok_end++] = (char)result;
+ break;
}
- break;
- }
default:
_read_error(data, p, "invalid escape character in literal identifier"); // TODO: char
break;
}
} else if (c == '|') {
- p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
- p->tok_end = 0; // Reset for next atom
+ p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
+ p->tok_end = 0; // Reset for next atom
{
object sym = find_or_add_symbol(p->tok_buf);
return_thread_runnable_with_obj(data, sym, p);
@@ -7690,32 +7813,32 @@ static void _read_literal_identifier(void *data, port_type *p)
* @param data Thread data object
* @param p Input port
*/
-static void _read_return_character(void *data, port_type *p)
+static void _read_return_character(void *data, port_type * p)
{
- p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
- p->tok_end = 0; // Reset for next atom
+ p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
+ p->tok_end = 0; // Reset for next atom
if (strlen(p->tok_buf) == 1) {
// ASCII char, consider merging with below?
return_thread_runnable_with_obj(data, obj_char2obj(p->tok_buf[0]), p);
- } else if(strncmp(p->tok_buf, "alarm", 5) == 0) {
+ } else if (strncmp(p->tok_buf, "alarm", 5) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\a'), p);
- } else if(strncmp(p->tok_buf, "backspace", 9) == 0) {
+ } else if (strncmp(p->tok_buf, "backspace", 9) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\b'), p);
- } else if(strncmp(p->tok_buf, "delete", 6) == 0) {
+ } else if (strncmp(p->tok_buf, "delete", 6) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj(127), p);
- } else if(strncmp(p->tok_buf, "escape", 6) == 0) {
+ } else if (strncmp(p->tok_buf, "escape", 6) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj(27), p);
- } else if(strncmp(p->tok_buf, "newline", 7) == 0) {
+ } else if (strncmp(p->tok_buf, "newline", 7) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\n'), p);
- } else if(strncmp(p->tok_buf, "null", 4) == 0) {
+ } else if (strncmp(p->tok_buf, "null", 4) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\0'), p);
- } else if(strncmp(p->tok_buf, "return", 6) == 0) {
+ } else if (strncmp(p->tok_buf, "return", 6) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\r'), p);
- } else if(strncmp(p->tok_buf, "space", 5) == 0) {
+ } else if (strncmp(p->tok_buf, "space", 5) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj(' '), p);
- } else if(strncmp(p->tok_buf, "tab", 3) == 0) {
+ } else if (strncmp(p->tok_buf, "tab", 3) == 0) {
return_thread_runnable_with_obj(data, obj_char2obj('\t'), p);
- } else if(strlen(p->tok_buf) > 1 && p->tok_buf[0] == 'x') {
+ } else if (strlen(p->tok_buf) > 1 && p->tok_buf[0] == 'x') {
const char *buf = p->tok_buf + 1;
char_type result = strtol(buf, NULL, 16);
return_thread_runnable_with_obj(data, obj_char2obj(result), p);
@@ -7723,8 +7846,8 @@ static void _read_return_character(void *data, port_type *p)
// Try to read a UTF-8 char and if so return it, otherwise throw an error
uint32_t state = CYC_UTF8_ACCEPT;
char_type codepoint;
- uint8_t *s = (uint8_t *)p->tok_buf;
- while(s) {
+ uint8_t *s = (uint8_t *) p->tok_buf;
+ while (s) {
if (!Cyc_utf8_decode(&state, &codepoint, *s)) {
s++;
break;
@@ -7746,13 +7869,13 @@ static void _read_return_character(void *data, port_type *p)
* @param data Thread data object
* @param p Input port
*/
-static void _read_character(void *data, port_type *p)
+static void _read_character(void *data, port_type * p)
{
char c;
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
+ if (!read_from_port(p)) {
_read_return_character(data, p);
}
}
@@ -7776,15 +7899,15 @@ static void _read_character(void *data, port_type *p)
* @param base Number base
* @param exact Return an exact number if true
*/
-static void _read_return_number(void *data, port_type *p, int base, int exact)
+static void _read_return_number(void *data, port_type * p, int base, int exact)
{
// TODO: validation?
- p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
- p->tok_end = 0; // Reset for next atom
+ p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
+ p->tok_end = 0; // Reset for next atom
if (exact > 1) {
// Special case, we don't know if exact or inexact
make_string(str, p->tok_buf);
- str.num_cp = Cyc_utf8_count_code_points((uint8_t *)(p->tok_buf));
+ str.num_cp = Cyc_utf8_count_code_points((uint8_t *) (p->tok_buf));
make_c_opaque(opq, &str);
return_thread_runnable_with_obj(data, &opq, p);
} else {
@@ -7806,7 +7929,7 @@ static void _read_return_number(void *data, port_type *p, int base, int exact)
* @param base Number base
* @param exact Return an exact number if true
*/
-static void _read_return_complex_number(void *data, port_type *p, int len)
+static void _read_return_complex_number(void *data, port_type * p, int len)
{
// TODO: return complex num, see _read_return_number for possible template
// probably want to have that function extract/identify the real/imaginary components.
@@ -7822,7 +7945,8 @@ static void _read_return_complex_number(void *data, port_type *p, int len)
i++;
}
for (; i < len; i++) {
- if (!isdigit(p->tok_buf[i]) && p->tok_buf[i] != '.' && p->tok_buf[i] != 'e' && p->tok_buf[i] != 'E') {
+ if (!isdigit(p->tok_buf[i]) && p->tok_buf[i] != '.' && p->tok_buf[i] != 'e'
+ && p->tok_buf[i] != 'E') {
break;
}
}
@@ -7837,13 +7961,13 @@ static void _read_return_complex_number(void *data, port_type *p, int len)
* @param base Number base
* @param exact Return an exact number if true
*/
-static void _read_number(void *data, port_type *p, int base, int exact)
+static void _read_number(void *data, port_type * p, int base, int exact)
{
char c;
- while(1) {
+ while (1) {
// Read more data into buffer, if needed
if (p->buf_idx == p->mem_buf_len) {
- if (!read_from_port(p)){
+ if (!read_from_port(p)) {
_read_return_number(data, p, base, exact);
}
}
@@ -7851,8 +7975,7 @@ static void _read_number(void *data, port_type *p, int base, int exact)
p->col_num++;
if (isdigit(c)) {
- if ((base == 2 && c > '1') ||
- (base == 8 && c > '7')) {
+ if ((base == 2 && c > '1') || (base == 8 && c > '7')) {
_read_error(data, p, "Illegal digit");
}
_read_add_to_tok_buf(p, c);
@@ -7874,7 +7997,7 @@ static void _read_number(void *data, port_type *p, int base, int exact)
* @param cont Current continuation
* @param p Input port
*/
-static void _read_return_atom(void *data, object cont, port_type *p)
+static void _read_return_atom(void *data, object cont, port_type * p)
{
object sym;
int len = p->tok_end;
@@ -7883,12 +8006,12 @@ static void _read_return_atom(void *data, object cont, port_type *p)
// indicating we have the full atom
p->buf_idx--;
p->col_num--;
- p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
- p->tok_end = 0; // Reset for next atom
+ p->tok_buf[p->tok_end] = '\0'; // TODO: what if buffer is full?
+ p->tok_end = 0; // Reset for next atom
if (_read_is_numeric(p->tok_buf, len)) {
make_string(str, p->tok_buf);
- str.num_cp = Cyc_utf8_count_code_points((uint8_t *)(p->tok_buf));
+ str.num_cp = Cyc_utf8_count_code_points((uint8_t *) (p->tok_buf));
make_c_opaque(opq, &str);
if (_read_is_complex_number(p->tok_buf, len)) {
_read_return_complex_number(data, p, len);
@@ -7915,7 +8038,7 @@ object Cyc_io_char_ready(void *data, object port)
{
Cyc_check_port(data, port);
{
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
FILE *stream = p->fp;
if (stream == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
@@ -7931,11 +8054,11 @@ object Cyc_io_char_ready(void *data, object port)
FD_SET(fd, &rfds);
tv.tv_sec = 0;
tv.tv_usec = 0;
- retval = select(fd + 1, &rfds, NULL, NULL, &tv); // Non-blocking fd check
- return (retval ? boolean_t : boolean_f);
+ retval = select(fd + 1, &rfds, NULL, NULL, &tv); // Non-blocking fd check
+ return (retval ? boolean_t : boolean_f);
} else {
// Fast path, port has buffered data ready to go
- return boolean_t;
+ return boolean_t;
}
}
}
@@ -7950,7 +8073,7 @@ object Cyc_io_char_ready(void *data, object port)
if (p->tok_end) _read_return_atom(data, cont, p); \
return_thread_runnable_with_obj(data, Cyc_EOF, p); \
} \
- }
+ }
object Cyc_io_peek_char(void *data, object cont, object port)
{
@@ -7963,7 +8086,7 @@ object Cyc_io_peek_char(void *data, object cont, object port)
Cyc_check_port(data, port);
{
- p = (port_type *)port;
+ p = (port_type *) port;
stream = ((port_type *) port)->fp;
if (stream == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
@@ -7973,7 +8096,7 @@ object Cyc_io_peek_char(void *data, object cont, object port)
_read_next_char(data, cont, p);
}
c = p->mem_buf[p->buf_idx];
- if (Cyc_utf8_decode(&state, &codepoint, (uint8_t)c)) {
+ if (Cyc_utf8_decode(&state, &codepoint, (uint8_t) c)) {
// Only have a partial UTF8 code point, read more chars.
// Problem is that there may not be enough space to store them
// and do need to set them aside since we are just peeking here
@@ -7986,12 +8109,13 @@ object Cyc_io_peek_char(void *data, object cont, object port)
// No more buffered chars
at_mem_buf_end = 1;
c = fgetc(stream);
- if (c == EOF) break;
+ if (c == EOF)
+ break;
} else {
c = p->mem_buf[p->buf_idx + i];
}
buf[i++] = c;
- if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t)c)) {
+ if (!Cyc_utf8_decode(&state, &codepoint, (uint8_t) c)) {
break;
}
}
@@ -8002,7 +8126,10 @@ object Cyc_io_peek_char(void *data, object cont, object port)
memmove(p->mem_buf, buf, i);
}
- return_thread_runnable_with_obj(data, (c != EOF) ? obj_char2obj(codepoint) : Cyc_EOF, p);
+ return_thread_runnable_with_obj(data,
+ (c !=
+ EOF) ? obj_char2obj(codepoint) : Cyc_EOF,
+ p);
}
return Cyc_EOF;
}
@@ -8015,7 +8142,7 @@ object Cyc_io_peek_u8(void *data, object cont, object port)
Cyc_check_port(data, port);
{
- p = (port_type *)port;
+ p = (port_type *) port;
stream = ((port_type *) port)->fp;
if (stream == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
@@ -8032,7 +8159,7 @@ object Cyc_io_peek_u8(void *data, object cont, object port)
object Cyc_io_read_char(void *data, object cont, object port)
{
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
Cyc_check_port(data, port);
if (p->fp == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
@@ -8045,7 +8172,7 @@ object Cyc_io_read_char(void *data, object cont, object port)
do {
_read_next_char(data, cont, p);
c = p->mem_buf[p->buf_idx++];
- } while(Cyc_utf8_decode(&state, &codepoint, (uint8_t)c));
+ } while (Cyc_utf8_decode(&state, &codepoint, (uint8_t) c));
p->col_num++;
return_thread_runnable_with_obj(data, obj_char2obj(codepoint), p);
}
@@ -8054,7 +8181,7 @@ object Cyc_io_read_char(void *data, object cont, object port)
object Cyc_io_read_u8(void *data, object cont, object port)
{
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
Cyc_check_port(data, port);
if (p->fp == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
@@ -8077,7 +8204,7 @@ object Cyc_io_read_line_slow(void *data, object cont, object port)
FILE *stream;
port_type *p;
char buf[1027];
- int i, limit = 1024; // Ensure last code point is fully-read
+ int i, limit = 1024; // Ensure last code point is fully-read
Cyc_check_port(data, port);
stream = ((port_type *) port)->fp;
@@ -8086,17 +8213,17 @@ object Cyc_io_read_line_slow(void *data, object cont, object port)
}
set_thread_blocked(data, cont);
- p = (port_type *)port;
+ p = (port_type *) port;
for (i = 0; i < limit; i++) {
// Can't use this because it bails on EOF: _read_next_char(data, NULL, p);
// instead we use code based on that macro:
- if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
- int rv = read_from_port(p);
- if (!rv) {
- if (i == 0) { // Empty buffer, return EOF
- return_thread_runnable_with_obj(data, Cyc_EOF, p);
+ if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
+ int rv = read_from_port(p);
+ if (!rv) {
+ if (i == 0) { // Empty buffer, return EOF
+ return_thread_runnable_with_obj(data, Cyc_EOF, p);
} else {
- break; // Handle buf contents below
+ break; // Handle buf contents below
}
}
}
@@ -8104,7 +8231,7 @@ object Cyc_io_read_line_slow(void *data, object cont, object port)
if (buf[i] == '\n') {
break;
}
- }
+ }
// ensure we fully-read last code point
{
@@ -8112,20 +8239,22 @@ object Cyc_io_read_line_slow(void *data, object cont, object port)
char_type codepoint;
uint32_t state;
- buf[i+1] = '\0';
- state = Cyc_utf8_count_code_points_and_bytes((uint8_t *)buf, &codepoint, &num_cp, &len);
+ buf[i + 1] = '\0';
+ state =
+ Cyc_utf8_count_code_points_and_bytes((uint8_t *) buf, &codepoint,
+ &num_cp, &len);
while (state != CYC_UTF8_ACCEPT && ii < 3) {
- if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
- int rv = read_from_port(p);
+ if (p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx) {
+ int rv = read_from_port(p);
if (!rv) {
- break; // At EOF, return what we've got so far
+ break; // At EOF, return what we've got so far
}
}
c = p->mem_buf[p->buf_idx++];
buf[len] = c;
len++;
- Cyc_utf8_decode(&state, &codepoint, (uint8_t)c);
+ Cyc_utf8_decode(&state, &codepoint, (uint8_t) c);
if (state == CYC_UTF8_ACCEPT) {
num_cp++;
break;
@@ -8134,8 +8263,7 @@ object Cyc_io_read_line_slow(void *data, object cont, object port)
}
// Remove any trailing CR / newline chars
- while (len > 0 && (buf[len - 1] == '\n' ||
- buf[len - 1] == '\r')) {
+ while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r')) {
len--;
num_cp--;
}
@@ -8161,26 +8289,26 @@ object Cyc_io_read_line(void *data, object cont, object port)
if (stream == NULL) {
Cyc_rt_raise2(data, "Unable to read from closed port: ", port);
}
-
// If there is data in the port buffer we have to use the slow path
// for compatibility with other I/O functions
- p = (port_type *)port;
- if ( !(p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx)) {
+ p = (port_type *) port;
+ if (!(p->mem_buf_len == 0 || p->mem_buf_len == p->buf_idx)) {
return Cyc_io_read_line_slow(data, cont, port);
}
-
// Otherwise, the port buffer is empty so we can use the fast path below:
set_thread_blocked(data, cont);
errno = 0;
if (fgets(buf, 1023, stream) != NULL) {
- state = Cyc_utf8_count_code_points_and_bytes((uint8_t *)buf, &codepoint, &num_cp, &len);
+ state =
+ Cyc_utf8_count_code_points_and_bytes((uint8_t *) buf, &codepoint,
+ &num_cp, &len);
// Check if we stopped reading in the middle of a code point and
// if so, read one byte at a time until that code point is finished.
while (state != CYC_UTF8_ACCEPT && i < 3) {
int c = fgetc(stream);
buf[len] = c;
len++;
- Cyc_utf8_decode(&state, &codepoint, (uint8_t)c);
+ Cyc_utf8_decode(&state, &codepoint, (uint8_t) c);
if (state == CYC_UTF8_ACCEPT) {
num_cp++;
break;
@@ -8190,8 +8318,7 @@ object Cyc_io_read_line(void *data, object cont, object port)
{
// Remove any trailing CR / newline chars
- while (len > 0 && (buf[len - 1] == '\n' ||
- buf[len - 1] == '\r')) {
+ while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r')) {
len--;
num_cp--;
}
@@ -8215,7 +8342,7 @@ object Cyc_io_read_line(void *data, object cont, object port)
void Cyc_io_read_token(void *data, object cont, object port)
{
Cyc_check_port(data, port);
- port_type *p = (port_type *)port;
+ port_type *p = (port_type *) port;
char c;
// Find and return (to cont, so want to minimize stack growth if possible) next token from buf
@@ -8230,24 +8357,29 @@ void Cyc_io_read_token(void *data, object cont, object port)
// If comment found, eat up comment chars
if (c == ';') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
_read_line_comment(p);
} else if (c == '\n') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
p->line_num++;
p->col_num = 1;
} else if (isspace(c)) {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
_read_whitespace(p);
} else if (c == '(' || c == ')' || c == '\'' || c == '`') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
// Special encoding so we can distinguish from chars such as #\(
make_c_opaque(opq, obj_char2obj(c));
return_thread_runnable_with_obj(data, &opq, p);
} else if (c == ',') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
- _read_next_char(data, cont, p); // Do another buffer read if needed
+ _read_next_char(data, cont, p); // Do another buffer read if needed
if (p->mem_buf[p->buf_idx] == '@') {
object unquote_splicing = find_or_add_symbol(",@");
make_empty_vector(vec);
@@ -8264,10 +8396,11 @@ void Cyc_io_read_token(void *data, object cont, object port)
return_thread_runnable_with_obj(data, &opq, p);
}
} else if (c == '"') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
_read_string(data, cont, p);
} else if (c == '#' && !p->tok_end) {
- _read_next_char(data, cont, p); // Fill buffer
+ _read_next_char(data, cont, p); // Fill buffer
c = p->mem_buf[p->buf_idx++];
p->col_num++;
if (c == 't') {
@@ -8303,15 +8436,15 @@ void Cyc_io_read_token(void *data, object cont, object port)
_read_number(data, p, 8, 1);
} else if (c == 'x') {
_read_number(data, p, 16, 1);
- } else if (c == '(') { // Vector
+ } else if (c == '(') { // Vector
make_empty_vector(vec);
return_thread_runnable_with_obj(data, &vec, p);
- } else if (c == 'u') { // Bytevector
+ } else if (c == 'u') { // Bytevector
_read_next_char(data, cont, p); // Fill buffer
c = p->mem_buf[p->buf_idx++];
p->col_num++;
if (c == '8') {
- _read_next_char(data, cont, p); // Fill buffer
+ _read_next_char(data, cont, p); // Fill buffer
c = p->mem_buf[p->buf_idx++];
p->col_num++;
if (c == '(') {
@@ -8323,10 +8456,10 @@ void Cyc_io_read_token(void *data, object cont, object port)
} else {
_read_error(data, p, "Unhandled input sequence");
}
- } else if (c == '|') { // Block comment
+ } else if (c == '|') { // Block comment
_read_multiline_comment(p);
continue;
- } else if (c == ';') { // Datum comment
+ } else if (c == ';') { // Datum comment
object sym = find_or_add_symbol("#;");
make_empty_vector(vec);
vec.num_elements = 2;
@@ -8342,14 +8475,16 @@ void Cyc_io_read_token(void *data, object cont, object port)
} else if (c == '|' && !p->tok_end) {
_read_literal_identifier(data, p);
} else if (c == '[' || c == '{') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
// Special encoding so we can distinguish from chars such as #\(
- make_c_opaque(opq, obj_char2obj('(')); // Cheap support for brackets
+ make_c_opaque(opq, obj_char2obj('(')); // Cheap support for brackets
return_thread_runnable_with_obj(data, &opq, p);
} else if (c == ']' || c == '}') {
- if (p->tok_end) _read_return_atom(data, cont, p);
+ if (p->tok_end)
+ _read_return_atom(data, cont, p);
// Special encoding so we can distinguish from chars such as #\(
- make_c_opaque(opq, obj_char2obj(')')); // Cheap support for brackets
+ make_c_opaque(opq, obj_char2obj(')')); // Cheap support for brackets
return_thread_runnable_with_obj(data, &opq, p);
} else {
// No special meaning, add char to current token (an atom)
@@ -8366,22 +8501,34 @@ void Cyc_io_read_token(void *data, object cont, object port)
static const uint8_t utf8d[] = {
// The first part of the table maps bytes to character classes that
// to reduce the size of the transition table and create bitmasks.
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
- 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
- 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
- 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7,
+ 8, 8, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2,
+ 10, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 3, 11, 6, 6, 6, 5, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8,
// The second part is a transition table that maps a combination
// of a state of the automaton and a character class to a state.
- 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
- 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
- 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
- 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
- 12,36,12,12,12,12,12,12,12,12,12,12,
+ 0, 12, 24, 36, 60, 96, 84, 12, 12, 12, 48, 72, 12, 12, 12, 12, 12, 12, 12, 12,
+ 12, 12, 12, 12,
+ 12, 0, 12, 12, 12, 12, 12, 0, 12, 0, 12, 12, 12, 24, 12, 12, 12, 12, 12, 24,
+ 12, 24, 12, 12,
+ 12, 12, 12, 12, 12, 12, 12, 24, 12, 12, 12, 12, 12, 24, 12, 12, 12, 12, 12,
+ 12, 12, 24, 12, 12,
+ 12, 12, 12, 12, 12, 12, 12, 36, 12, 36, 12, 12, 12, 36, 12, 12, 12, 12, 12,
+ 36, 12, 36, 12, 12,
+ 12, 36, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
};
/**
@@ -8392,16 +8539,18 @@ static const uint8_t utf8d[] = {
* @param byte Byte to examine
* @return The current state: `CYC_UTF8_ACCEPT` if successful otherwise `CYC_UTF8_REJECT`.
*/
-static uint32_t Cyc_utf8_decode(uint32_t* state, uint32_t* codep, uint32_t byte) {
+static uint32_t Cyc_utf8_decode(uint32_t * state, uint32_t * codep,
+ uint32_t byte)
+{
uint32_t type = utf8d[byte];
*codep = (*state != CYC_UTF8_ACCEPT) ?
- (byte & 0x3fu) | (*codep << 6) :
- (0xff >> type) & (byte);
+ (byte & 0x3fu) | (*codep << 6) : (0xff >> type) & (byte);
*state = utf8d[256 + *state + type];
return *state;
}
+
// END Bjoern Hoehrmann
/**
@@ -8410,7 +8559,8 @@ static uint32_t Cyc_utf8_decode(uint32_t* state, uint32_t* codep, uint32_t byte)
* @param s String to examine
* @return The number of codepoints found, or -1 if there was an error.
*/
-int Cyc_utf8_count_code_points(uint8_t* s) {
+int Cyc_utf8_count_code_points(uint8_t * s)
+{
uint32_t codepoint;
uint32_t state = 0;
int count;
@@ -8432,11 +8582,14 @@ int Cyc_utf8_count_code_points(uint8_t* s) {
* @param bytes Out parameter, set to the number of bytes
* @return Returns `CYC_UTF8_ACCEPT` on success, otherwise `CYC_UTF8_REJECT`.
*/
-static int Cyc_utf8_count_code_points_and_bytes(uint8_t* s, char_type *codepoint, int *cpts, int *bytes) {
+static int Cyc_utf8_count_code_points_and_bytes(uint8_t * s,
+ char_type * codepoint,
+ int *cpts, int *bytes)
+{
uint32_t state = 0;
*cpts = 0;
*bytes = 0;
- for (; *s; ++s){
+ for (; *s; ++s) {
*bytes += 1;
if (!Cyc_utf8_decode(&state, codepoint, *s))
*cpts += 1;
@@ -8457,41 +8610,43 @@ static int Cyc_utf8_count_code_points_and_bytes(uint8_t* s, char_type *codepoint
*
* From https://stackoverflow.com/a/22135005/101258
*/
-uint32_t Cyc_utf8_validate_stream(uint32_t *state, char *str, size_t len) {
- size_t i;
- uint32_t type;
+uint32_t Cyc_utf8_validate_stream(uint32_t * state, char *str, size_t len)
+{
+ size_t i;
+ uint32_t type;
- for (i = 0; i < len; i++) {
- // We don't care about the codepoint, so this is
- // a simplified version of the decode function.
- type = utf8d[(uint8_t)str[i]];
- *state = utf8d[256 + (*state) + type];
+ for (i = 0; i < len; i++) {
+ // We don't care about the codepoint, so this is
+ // a simplified version of the decode function.
+ type = utf8d[(uint8_t) str[i]];
+ *state = utf8d[256 + (*state) + type];
- if (*state == CYC_UTF8_REJECT)
- break;
- }
+ if (*state == CYC_UTF8_REJECT)
+ break;
+ }
- return *state;
+ return *state;
}
/**
* @brief Simplified version of Cyc_utf8_validate_stream that must always be called with a complete string buffer.
*/
-uint32_t Cyc_utf8_validate(char *str, size_t len) {
- size_t i;
- uint32_t state = CYC_UTF8_ACCEPT, type;
+uint32_t Cyc_utf8_validate(char *str, size_t len)
+{
+ size_t i;
+ uint32_t state = CYC_UTF8_ACCEPT, type;
- for (i = 0; i < len; i++) {
- // We don't care about the codepoint, so this is
- // a simplified version of the decode function.
- type = utf8d[(uint8_t)str[i]];
- state = utf8d[256 + (state) + type];
+ for (i = 0; i < len; i++) {
+ // We don't care about the codepoint, so this is
+ // a simplified version of the decode function.
+ type = utf8d[(uint8_t) str[i]];
+ state = utf8d[256 + (state) + type];
- if (state == CYC_UTF8_REJECT)
- break;
- }
+ if (state == CYC_UTF8_REJECT)
+ break;
+ }
- return state;
+ return state;
}
//int uint32_num_bytes(uint32_t x) {
@@ -8522,48 +8677,44 @@ uint32_t Cyc_utf8_validate(char *str, size_t len) {
* the NUL as well.
* the destination string will never be bigger than the source string.
*/
-int Cyc_utf8_encode(char *dest, int sz, uint32_t *src, int srcsz)
-{
- uint32_t ch;
- int i = 0;
- char *dest_end = dest + sz;
-
- while (srcsz<0 ? src[i]!=0 : i < srcsz) {
- ch = src[i];
- if (ch < 0x80) {
- if (dest >= dest_end)
- return i;
- *dest++ = (char)ch;
- }
- else if (ch < 0x800) {
- if (dest >= dest_end-1)
- return i;
- *dest++ = (ch>>6) | 0xC0;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- else if (ch < 0x10000) {
- if (dest >= dest_end-2)
- return i;
- *dest++ = (ch>>12) | 0xE0;
- *dest++ = ((ch>>6) & 0x3F) | 0x80;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- else if (ch < 0x110000) {
- if (dest >= dest_end-3)
- return i;
- *dest++ = (ch>>18) | 0xF0;
- *dest++ = ((ch>>12) & 0x3F) | 0x80;
- *dest++ = ((ch>>6) & 0x3F) | 0x80;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- i++;
+int Cyc_utf8_encode(char *dest, int sz, uint32_t * src, int srcsz)
+{
+ uint32_t ch;
+ int i = 0;
+ char *dest_end = dest + sz;
+
+ while (srcsz < 0 ? src[i] != 0 : i < srcsz) {
+ ch = src[i];
+ if (ch < 0x80) {
+ if (dest >= dest_end)
+ return i;
+ *dest++ = (char)ch;
+ } else if (ch < 0x800) {
+ if (dest >= dest_end - 1)
+ return i;
+ *dest++ = (ch >> 6) | 0xC0;
+ *dest++ = (ch & 0x3F) | 0x80;
+ } else if (ch < 0x10000) {
+ if (dest >= dest_end - 2)
+ return i;
+ *dest++ = (ch >> 12) | 0xE0;
+ *dest++ = ((ch >> 6) & 0x3F) | 0x80;
+ *dest++ = (ch & 0x3F) | 0x80;
+ } else if (ch < 0x110000) {
+ if (dest >= dest_end - 3)
+ return i;
+ *dest++ = (ch >> 18) | 0xF0;
+ *dest++ = ((ch >> 12) & 0x3F) | 0x80;
+ *dest++ = ((ch >> 6) & 0x3F) | 0x80;
+ *dest++ = (ch & 0x3F) | 0x80;
}
- if (dest < dest_end)
- *dest = '\0';
- return i;
+ i++;
+ }
+ if (dest < dest_end)
+ *dest = '\0';
+ return i;
}
-
////////////// END UTF-8 Section //////////////
void init_polyfills(void)
@@ -8579,11 +8730,14 @@ void init_polyfills(void)
* which are returned using the given pointers.
* An error flag is directly returned.
*/
-int num2ratio(double x, double *numerator, double *denominator) {
+int num2ratio(double x, double *numerator, double *denominator)
+{
if (!isfinite(x)) {
*numerator = *denominator = 0.0;
- if (x > 0.0) *numerator = 1.0;
- if (x < 0.0) *numerator = -1.0;
+ if (x > 0.0)
+ *numerator = 1.0;
+ if (x < 0.0)
+ *numerator = -1.0;
return 1;
}
int bdigits = DBL_MANT_DIG;
@@ -8593,19 +8747,18 @@ int num2ratio(double x, double *numerator, double *denominator) {
expo -= bdigits;
if (expo > 0) {
*numerator *= pow(2.0, expo);
- }
- else if (expo < 0) {
+ } else if (expo < 0) {
expo = -expo;
- if (expo >= DBL_MAX_EXP-1) {
- *numerator /= pow(2.0, expo - (DBL_MAX_EXP-1));
- *denominator *= pow(2.0, DBL_MAX_EXP-1);
+ if (expo >= DBL_MAX_EXP - 1) {
+ *numerator /= pow(2.0, expo - (DBL_MAX_EXP - 1));
+ *denominator *= pow(2.0, DBL_MAX_EXP - 1);
return fabs(*numerator) < 1.0;
} else {
*denominator *= pow(2.0, expo);
}
}
- while (*numerator && fmod(*numerator,2) == 0 && fmod(*denominator,2) == 0) {
+ while (*numerator && fmod(*numerator, 2) == 0 && fmod(*denominator, 2) == 0) {
*numerator /= 2.0;
*denominator /= 2.0;
}
@@ -8670,7 +8823,7 @@ void Cyc_exact(void *data, object cont, object z)
if (obj_is_int(z)) {
i = obj_obj2int(z);
} else if (type_of(z) == integer_tag) {
- i = (int)round(((integer_type *)z)->value);
+ i = (int)round(((integer_type *) z)->value);
} else if (type_of(z) == bignum_tag) {
return_closcall1(data, cont, z);
} else if (type_of(z) == complex_num_tag) {
@@ -8679,21 +8832,21 @@ void Cyc_exact(void *data, object cont, object z)
make_complex_num(num, dreal, dimag);
return_closcall1(data, cont, &num);
} else {
- double d = ((double_type *)z)->value;
+ double d = ((double_type *) z)->value;
if (isnan(d)) {
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == INFINITY) {
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == -INFINITY) {
Cyc_rt_raise2(data, "Expected number but received", z);
-#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
- } else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
+#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
+ } else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN) {
alloc_bignum(data, bn);
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
return_closcall1(data, cont, bn);
#endif
}
- i = (int)round(((double_type *)z)->value);
+ i = (int)round(((double_type *) z)->value);
}
return_closcall1(data, cont, obj_int2obj(i));
}
@@ -8705,7 +8858,7 @@ object Cyc_exact_no_cps(void *data, object ptr, object z)
if (obj_is_int(z)) {
i = obj_obj2int(z);
} else if (type_of(z) == integer_tag) {
- i = (int)round(((integer_type *)z)->value);
+ i = (int)round(((integer_type *) z)->value);
} else if (type_of(z) == bignum_tag) {
return z;
} else if (type_of(z) == complex_num_tag) {
@@ -8715,21 +8868,21 @@ object Cyc_exact_no_cps(void *data, object ptr, object z)
assign_complex_num(ptr, unboxed);
return ptr;
} else {
- double d = ((double_type *)z)->value;
+ double d = ((double_type *) z)->value;
if (isnan(d)) {
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == INFINITY) {
Cyc_rt_raise2(data, "Expected number but received", z);
} else if (d == -INFINITY) {
Cyc_rt_raise2(data, "Expected number but received", z);
-#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
- } else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN){
+#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
+ } else if (d > CYC_FIXNUM_MAX || d < CYC_FIXNUM_MIN) {
alloc_bignum(data, bn);
BIGNUM_CALL(mp_set_double(&bignum_value(bn), d));
return bn;
#endif
}
- i = (int)round(((double_type *)z)->value);
+ i = (int)round(((double_type *) z)->value);
}
return obj_int2obj(i);
}