diff --git a/Makefile.config b/Makefile.config index 01e7dbb0..c0eb6c25 100644 --- a/Makefile.config +++ b/Makefile.config @@ -11,7 +11,7 @@ COMP_CFLAGS ?= -O2 -Wall -I$(PREFIX)/include -L$(PREFIX)/lib #CFLAGS = -g -Wall #CFLAGS = -g -pg -Wall CC ?= cc -LIBS = -pthread -lcyclone -lck -lm +LIBS = -pthread -lcyclone -lck -lm -ltommath # Commands "baked into" cyclone for invoking the C compiler CC_PROG ?= "$(CC) ~src-file~ $(COMP_CFLAGS) -c -o ~exec-file~.o" diff --git a/gc.c b/gc.c index b463c323..892f0451 100644 --- a/gc.c +++ b/gc.c @@ -417,6 +417,16 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd) hp->value = ((integer_type *) obj)->value; 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; + return (char *)hp; + } case double_tag:{ double_type *hp = dest; mark(hp) = thd->gc_alloc_color; @@ -674,6 +684,8 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r) } if (t == integer_tag) return gc_heap_align(sizeof(integer_type)); + if (t == bignum_tag) + return gc_heap_align(sizeof(bignum_type)); if (t == double_tag) return gc_heap_align(sizeof(double_type)); if (t == port_tag) @@ -869,6 +881,13 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da 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"); +#endif + mp_clear(&(((bignum_type *)p)->bn)); } // free p heap_freed += size; diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index e3b4ac60..e0ca4430 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -246,6 +246,7 @@ object Cyc_is_null(object o); object Cyc_is_number(object o); object Cyc_is_real(object o); object Cyc_is_integer(object o); +object Cyc_is_bignum(object o); object Cyc_is_vector(object o); object Cyc_is_bytevector(object o); object Cyc_is_port(object o); diff --git a/include/cyclone/types.h b/include/cyclone/types.h index b5c58443..5d61abb5 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -18,6 +18,7 @@ #include #include #include +#include "tommath.h" // Maximum number of args that GC will accept #define NUM_GC_ARGS 128 @@ -87,14 +88,15 @@ enum object_tag { , eof_tag // 9 , forward_tag // 10 , integer_tag // 11 - , macro_tag // 12 - , mutex_tag // 13 - , pair_tag // 14 - , port_tag // 15 - , primitive_tag // 16 - , string_tag // 17 - , symbol_tag // 18 - , vector_tag // 19 + , bignum_tag // 12 + , macro_tag // 13 + , mutex_tag // 14 + , pair_tag // 15 + , port_tag // 16 + , primitive_tag // 17 + , string_tag // 18 + , symbol_tag // 19 + , vector_tag // 20 }; #define type_is_pair_prim(clo) \ @@ -356,6 +358,20 @@ typedef struct { int padding; // Prevent mem corruption if sizeof(int) < sizeof(ptr) } integer_type; +typedef struct { + gc_header_type hdr; + tag_type tag; + mp_int bn; +} bignum_type; + +#define make_empty_bignum(n) \ + bignum_type n; \ + n.hdr.mark = gc_color_red; \ + n.hdr.grayed = 0; \ + n.tag = bignum_tag; \ + mp_init(&n); +/* TODO: check return value of mp_init */ + typedef struct { gc_header_type hdr; tag_type tag; diff --git a/runtime.c b/runtime.c index 2274525d..39d0aa7f 100644 --- a/runtime.c +++ b/runtime.c @@ -43,6 +43,7 @@ const char *tag_names[] = { /*eof_tag */ , "eof" /*forward_tag */ , "" /*integer_tag */ , "number" + /*bignum_tag */ , "bignum" /*macro_tag */ , "macro" /*mutex_tag */ , "mutex" /*pair_tag */ , "pair" @@ -1285,6 +1286,7 @@ object Cyc_is_number(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)))) return boolean_t; return boolean_f; @@ -1298,7 +1300,15 @@ 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) == integer_tag) || + (!is_value_type(o) && type_of(o) == bignum_tag))) + return boolean_t; + return boolean_f; +} + +object Cyc_is_bignum(object o) +{ + if ((o != NULL) && !is_value_type(o) && ((list) o)->tag == bignum_tag) return boolean_t; return boolean_f; } @@ -4078,6 +4088,11 @@ char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_grown) gc_alloc(heap, sizeof(integer_type), obj, thd, heap_grown); return gc_fixup_moved_obj(thd, alloci, obj, hp); } + case bignum_tag:{ + bignum_type *hp = + gc_alloc(heap, sizeof(bignum_type), obj, thd, heap_grown); + return gc_fixup_moved_obj(thd, alloci, obj, hp); + } case double_tag:{ double_type *hp = gc_alloc(heap, sizeof(double_type), obj, thd, heap_grown); @@ -4235,6 +4250,7 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont, case bytevector_tag: case string_tag: case integer_tag: + case bignum_tag: case double_tag: case port_tag: case cvar_tag: