diff --git a/src/arith/integer.c b/src/arith/integer.c index 9e1a8a0..543bf0d 100644 --- a/src/arith/integer.c +++ b/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 bv = cell_value( b, is_first_cell ); + __int128_t av = cell_value( a, '+', 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 bv = cell_value( b, is_first_b ); + __int128_t dv = cell_value( d, '*', is_first_d ); + __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; } diff --git a/src/arith/integer.h b/src/arith/integer.h index f9eba33..117a0bf 100644 --- a/src/arith/integer.h +++ b/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, diff --git a/src/arith/peano.c b/src/arith/peano.c index 85bbd5c..addfed6 100644 --- a/src/arith/peano.c +++ b/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: - { - struct cons_space_object dividend = - 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; - } + result = to_long_double(cell.payload.ratio.dividend) / + to_long_double(cell.payload.ratio.divisor); break; case REALTV: result = cell.payload.real.value; diff --git a/src/arith/peano.h b/src/arith/peano.h index fa03212..7164a24 100644 --- a/src/arith/peano.h +++ b/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, diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 6a7e2bd..4eefde0 100644 --- a/src/memory/consspaceobject.c +++ b/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 ); } } } diff --git a/src/ops/equal.c b/src/ops/equal.c index 9eedd53..0c01a81 100644 --- a/src/ops/equal.c +++ b/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_b = numeric_value( b ); + double num_a = to_long_double( a ); + double num_b = to_long_double( b ); double max = fabs( num_a ) > fabs( num_b ) ? fabs( num_a ) : fabs( num_b );