Issue #55 - Adding more complex number support

gc.c

@@ -575,6 +575,13 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
       hp->value = ((integer_type *) obj)->value;
       return (char *)hp;
     }
+  case complex_num_tag:{
+      complex_num_type *hp = dest;
+      mark(hp) = thd->gc_alloc_color;
+      type_of(hp) = complex_num_tag;
+      hp->value = ((complex_num_type *) obj)->value;
+      return (char *)hp;
+    }
   default:
     fprintf(stderr, "gc_copy_obj: bad tag obj=%p obj.tag=%d\n", (object) obj,
             type_of(obj));
@@ -1012,6 +1019,8 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r)
     return gc_heap_align(sizeof(cond_var_type));
   if (t == integer_tag)
     return gc_heap_align(sizeof(integer_type));
+  if (t == complex_num_tag)
+    return gc_heap_align(sizeof(complex_num_type));
 
   fprintf(stderr, "gc_allocated_bytes: unexpected object %p of type %d\n", obj,
           t);

include/cyclone/runtime.h

@@ -390,6 +390,7 @@ object Cyc_num_op_va_list(void *data, int argc,
 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);
 /**@}*/
 /**

include/cyclone/types.h

@@ -687,6 +687,14 @@ typedef struct {
   double complex value;
 } complex_num_type;
 
+/** Create a new complex number in the nursery */
+#define make_complex_num(n,r,i) \
+  complex_num_type n; \
+  n.hdr.mark = gc_color_red; \
+  n.hdr.grayed = 0; \
+  n.tag = complex_num_tag; \
+  n.value = (r + (i * I));
+
 /**
  * @brief Double-precision floating point type, also known as a flonum.
  */
@@ -1223,6 +1231,7 @@ typedef union {
   integer_type integer_t;
   double_type double_t;
   bignum_type bignum_t;
+  complex_num_type complex_num_t;
 } common_type;
 
 #define return_copy(ptr, obj) \

runtime.c

@@ -646,11 +646,16 @@ int equal(object x, object 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 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) == double_tag &&
+            ((complex_num_type *) x)->value == ((complex_num_type *) y)->value);
+
   default:
     return x == y;
   }
@@ -933,6 +938,23 @@ object Cyc_display(void *data, object x, FILE * port)
     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);
+    }
+    break;
+  }
   default:
     fprintf(port, "Cyc_display: bad tag x=%d\n", ((closure) x)->tag);
     exit(1);
@@ -1538,7 +1560,8 @@ 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))))
+                                            || type_of(o) == double_tag
+                                            || type_of(o) == complex_num_tag))))
     return boolean_t;
   return boolean_f;
 }
@@ -5060,6 +5083,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 complex_num_tag:{
+      complex_num_type *hp =
+          gc_alloc(heap, sizeof(complex_num_type), obj, thd, heap_grown);
+      return gc_fixup_moved_obj(thd, alloci, obj, hp);
+    }
   default:
     fprintf(stderr, "gc_move: bad tag obj=%p obj.tag=%d\n", (object) obj,
             type_of(obj));
@@ -5205,6 +5233,7 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont,
     case port_tag:
     case cvar_tag:
     case c_opaque_tag:
+    case complex_num_tag:
       break;
       // These types are not heap-allocated
     case eof_tag:
@@ -5863,6 +5892,20 @@ object Cyc_bit_set(void *data, object n1, object n2)
             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);
+}
+
+void Cyc_make_rectangular(void *data, object k, object r, object i) 
+{
+  double_type dr, di;
+  Cyc_num2double(data, &dr, r);
+  Cyc_num2double(data, &di, i);
+  make_complex_num(num, double_value(&dr), double_value(&di));
+  return_closcall1(data, k, &num);
+}
+
 /* RNG section */
 #define norm 2.328306549295728e-10
 #define m1   4294967087.0