Getting closer. WARNING: GC disabled in this commit.

src/arith/integer.c

@@ -31,11 +31,6 @@
 #include "lispops.h"
 #include "peano.h"
 
-/*
- * The maximum value we will allow in an integer cell.
- */
-#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL)
-
 /**
  * hexadecimal digits for printing numbers.
  */
@@ -46,36 +41,6 @@ const char *hex_digits = "0123456789ABCDEF";
  * that integers less than 65 bits are bignums of one cell only.
  */
 
-/**
- * return the numeric value of the cell indicated by this `pointer`, as a C
- * primitive double, not as a cons_space_object. The indicated cell may in
- * principle be any kind of number; if it is not a number, will return `NAN`.
- */
-long double numeric_value( struct cons_pointer pointer ) {
-    long double result = NAN;
-    struct cons_space_object *cell = &pointer2cell( pointer );
-
-    switch ( cell->tag.value ) {
-        case INTEGERTV:
-            result = 1.0;
-            while ( cell->tag.value == INTEGERTV ) {
-                result = ( result * LONG_MAX * cell->payload.integer.value );
-                cell = &pointer2cell( cell->payload.integer.more );
-            }
-            break;
-        case RATIOTV:
-            result = numeric_value( cell->payload.ratio.dividend ) /
-                numeric_value( cell->payload.ratio.divisor );
-            break;
-        case REALTV:
-            result = cell->payload.real.value;
-            break;
-            // default is NAN
-    }
-
-    return result;
-}
-
 /**
  * Allocate an integer cell representing this `value` and return a cons_pointer to it.
  * @param value an integer value;
@@ -100,13 +65,17 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
 }
 
 /**
- * Internal to `operate_on_integers`, do not use.
+ * Low level integer arithmetic, do not use elsewhere.
+ *
  * @param c a pointer to a cell, assumed to be an integer cell;
+ * @param op a character representing the operation: expectedto be either
+ * '+' or '*'; behaviour with other values is undefined.
  * @param is_first_cell true if this is the first cell in a bignum
  * chain, else false.
- * \see operate_on_integers
+ * \see multiply_integers
+ * \see add_integers
  */
-__int128_t cell_value( struct cons_pointer c, bool is_first_cell ) {
+__int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
     long int val = nilp( c ) ?
       0 :
       pointer2cell( c ).payload.integer.value;
@@ -117,7 +86,7 @@ __int128_t cell_value( struct cons_pointer c, bool is_first_cell ) {
         ( val == 0 ) ?
           carry :
           val :
-         0;
+         op == '*' ? 1 : 0;
     debug_printf( DEBUG_ARITH,
                   L"cell_value: raw value is %ld, is_first_cell = %s; %4.4s; returning ",
                   val, is_first_cell ? "true" : "false", pointer2cell(c).tag.bytes);
@@ -194,8 +163,8 @@ struct cons_pointer add_integers( struct cons_pointer a,
         debug_println( DEBUG_ARITH );
 
         while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
-            __int128_t av = cell_value( a, is_first_cell );
+            __int128_t av = cell_value( a, '+', is_first_cell );
-            __int128_t bv = cell_value( b, is_first_cell );
+            __int128_t bv = cell_value( b, '+', is_first_cell );
             __int128_t rv = av + bv + carry;
 
             debug_print( L"add_integers: av = ", DEBUG_ARITH );
@@ -268,10 +237,10 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
           __int128_t carry = 0;
 
           while ( !nilp(d) || carry != 0) {
-            struct cons_pointer old_partial = partial;
+            partial = make_integer(0, partial);
             struct cons_pointer new = make_integer( 0, NIL);
-            __int128_t dv = cell_value( d, is_first_d );
+            __int128_t dv = cell_value( d, '*', is_first_d );
-            __int128_t bv = cell_value( b, is_first_b );
+            __int128_t bv = cell_value( b, '*', is_first_b );
 
             __int128_t rv = (dv * bv) + carry;
 
@@ -304,7 +273,6 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
               //dec_ref(new);
             }
 
-            //dec_ref(old_partial);
             d = integerp(d) ? pointer2cell( d ).payload.integer.more : NIL;
             is_first_d = false;
           }

src/arith/integer.h

@@ -11,8 +11,6 @@
 #ifndef __integer_h
 #define __integer_h
 
-long double numeric_value( struct cons_pointer pointer );
-
 struct cons_pointer make_integer( int64_t value, struct cons_pointer more );
 
 struct cons_pointer add_integers( struct cons_pointer a,

src/arith/peano.c

@@ -21,6 +21,7 @@
 #include "integer.h"
 #include "intern.h"
 #include "lispops.h"
+#include "peano.h"
 #include "print.h"
 #include "ratio.h"
 #include "read.h"
@@ -119,19 +120,15 @@ long double to_long_double( struct cons_pointer arg ) {
 
     switch ( cell.tag.value ) {
         case INTEGERTV:
-            result = ( double ) cell.payload.integer.value;
+            result = 1.0;
+            while ( cell.tag.value == INTEGERTV ) {
+                result = ( result * (MAX_INTEGER + 1) * cell.payload.integer.value );
+                cell = pointer2cell( cell.payload.integer.more );
+            }
             break;
         case RATIOTV:
-            {
+            result = to_long_double(cell.payload.ratio.dividend) /
-                struct cons_space_object dividend =
+              to_long_double(cell.payload.ratio.divisor);
-                    pointer2cell( cell.payload.ratio.dividend );
-                struct cons_space_object divisor =
-                    pointer2cell( cell.payload.ratio.divisor );
-
-                result =
-                    ( long double ) dividend.payload.integer.value /
-                    divisor.payload.integer.value;
-            }
             break;
         case REALTV:
             result = cell.payload.real.value;

src/arith/peano.h

@@ -12,6 +12,11 @@
 #ifndef PEANO_H
 #define PEANO_H
 
+/**
+ * The maximum value we will allow in an integer cell.
+ */
+#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL)
+
 bool zerop( struct cons_pointer arg );
 
 struct cons_pointer negative( struct cons_pointer frame,

src/memory/consspaceobject.c

@@ -59,7 +59,7 @@ void dec_ref( struct cons_pointer pointer ) {
         cell->count--;
 
         if ( cell->count == 0 ) {
-            free_cell( pointer );
+            // free_cell( pointer );
         }
     }
 }

src/ops/equal.c

@@ -12,7 +12,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
-#include "integer.h"
+#include "peano.h"
 
 /**
  * Shallow, and thus cheap, equality: true if these two objects are
@@ -92,8 +92,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 break;
             case REALTV:
                 {
-                    double num_a = numeric_value( a );
+                    double num_a = to_long_double( a );
-                    double num_b = numeric_value( b );
+                    double num_b = to_long_double( b );
                     double max =
                         fabs( num_a ) >
                         fabs( num_b ) ? fabs( num_a ) : fabs( num_b );