diff --git a/gc.c b/gc.c index 0c0e57f4..d24e5c1e 100644 --- a/gc.c +++ b/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); diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 58343f1b..040c774b 100644 --- a/include/cyclone/runtime.h +++ b/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); /**@}*/ /** diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 4f72dccb..f08d2d4b 100644 --- a/include/cyclone/types.h +++ b/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) \ diff --git a/runtime.c b/runtime.c index 48d55513..1ec6ceab 100644 --- a/runtime.c +++ b/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