WIP for libtommath

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"

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;

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);

include/cyclone/types.h

@@ -18,6 +18,7 @@
 #include <time.h>
 #include <pthread.h>
 #include <stdint.h>
+#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;

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: