From d42ece5711f29beb5af7a667bb93d40924495d8f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 14 Mar 2026 21:20:23 +0000 Subject: [PATCH] Tactical commit while working on the bignum bug, AGAIN. --- src/arith/integer.c | 72 ++++++++++++++++++--------------------------- src/debug.h | 7 +++++ src/init.c | 3 +- src/ops/equal.c | 22 +++++++------- 4 files changed, 49 insertions(+), 55 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index a3174ac..3688ff5 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -210,7 +210,7 @@ __int128_t int128_to_integer( __int128_t val, if ( integerp( less_significant ) ) { struct cons_space_object *lsc = &pointer2cell( less_significant ); - inc_ref( new ); + // inc_ref( new ); lsc->payload.integer.more = new; } @@ -226,57 +226,43 @@ struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer result = NIL; struct cons_pointer cursor = NIL; - debug_print( L"add_integers: a = ", DEBUG_ARITH ); - debug_print_object( a, DEBUG_ARITH ); - debug_print( L"; b = ", DEBUG_ARITH ); - debug_print_object( b, DEBUG_ARITH ); - debug_println( DEBUG_ARITH ); - __int128_t carry = 0; bool is_first_cell = true; - if ( integerp( a ) && integerp( b ) ) { - debug_print( L"add_integers: \n", DEBUG_ARITH ); - debug_dump_object( a, DEBUG_ARITH ); - debug_print( L" plus \n", DEBUG_ARITH ); - debug_dump_object( b, DEBUG_ARITH ); - debug_println( DEBUG_ARITH ); + while ( integerp( a ) || integerp( b ) || carry != 0 ) { + __int128_t av = cell_value( a, '+', is_first_cell ); + __int128_t bv = cell_value( b, '+', is_first_cell ); + __int128_t rv = ( av + bv ) + carry; - 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 rv = ( av + bv ) + carry; + debug_print( L"add_integers: av = ", DEBUG_ARITH ); + debug_print_128bit( av, DEBUG_ARITH ); + debug_print( L"; bv = ", DEBUG_ARITH ); + debug_print_128bit( bv, DEBUG_ARITH ); + debug_print( L"; carry = ", DEBUG_ARITH ); + debug_print_128bit( carry, DEBUG_ARITH ); + debug_print( L"; rv = ", DEBUG_ARITH ); + debug_print_128bit( rv, DEBUG_ARITH ); + debug_print( L"\n", DEBUG_ARITH ); - debug_print( L"add_integers: av = ", DEBUG_ARITH ); - debug_print_128bit( av, DEBUG_ARITH ); - debug_print( L"; bv = ", DEBUG_ARITH ); - debug_print_128bit( bv, DEBUG_ARITH ); - debug_print( L"; carry = ", DEBUG_ARITH ); - debug_print_128bit( carry, DEBUG_ARITH ); - debug_print( L"; rv = ", DEBUG_ARITH ); - debug_print_128bit( rv, DEBUG_ARITH ); - debug_print( L"\n", DEBUG_ARITH ); + if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) { + result = + acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); + break; + } else { + struct cons_pointer new = make_integer( 0, NIL ); + carry = int128_to_integer( rv, cursor, new ); + cursor = new; - if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) { - result = - acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); - break; - } else { - struct cons_pointer new = make_integer( 0, NIL ); - carry = int128_to_integer( rv, cursor, new ); - cursor = new; - - if ( nilp( result ) ) { - result = cursor; - } - - a = pointer2cell( a ).payload.integer.more; - b = pointer2cell( b ).payload.integer.more; - is_first_cell = false; + if ( nilp( result ) ) { + result = cursor; } + + a = pointer2cell( a ).payload.integer.more; + b = pointer2cell( b ).payload.integer.more; + is_first_cell = false; } } - + debug_print( L"add_integers returning: ", DEBUG_ARITH ); debug_print_object( result, DEBUG_ARITH ); debug_println( DEBUG_ARITH ); diff --git a/src/debug.h b/src/debug.h index 2e59932..6c7c8cb 100644 --- a/src/debug.h +++ b/src/debug.h @@ -79,6 +79,13 @@ */ #define DEBUG_STACK 256 +/** + * @brief Print messages about equality tests. + * + * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v. + */ + #define DEBUG_EQUAL 512 + extern int verbosity; void debug_print_exception( struct cons_pointer ex_ptr ); diff --git a/src/init.c b/src/init.c index baca2b7..d88e8aa 100644 --- a/src/init.c +++ b/src/init.c @@ -231,7 +231,8 @@ void print_options( FILE *stream ) { fwprintf( stream, L"\t\t32\tINPUT/OUTPUT;\n" ); fwprintf( stream, L"\t\t64\tLAMBDA;\n" ); fwprintf( stream, L"\t\t128\tREPL;\n" ); - fwprintf( stream, L"\t\t256\tSTACK.\n" ); + fwprintf( stream, L"\t\t256\tSTACK;\n" ); + fwprintf( stream, L"\t\t512\tEQUAL.\n" ); #endif } diff --git a/src/ops/equal.c b/src/ops/equal.c index b2d0fa2..296aea6 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -74,7 +74,7 @@ bool equal_ld_ld( long double a, long double b ) { bool result = ( fabsl( a - b ) < tolerance ); - debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result ); + debug_printf( DEBUG_EQUAL, L"\nequal_ld_ld returning %d\n", result ); return result; } @@ -332,10 +332,10 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) { * identical structure, else false. */ bool equal( struct cons_pointer a, struct cons_pointer b ) { - debug_print( L"\nequal: ", DEBUG_ARITH ); - debug_print_object( a, DEBUG_ARITH ); - debug_print( L" = ", DEBUG_ARITH ); - debug_print_object( b, DEBUG_ARITH ); + debug_print( L"\nequal: ", DEBUG_EQUAL ); + debug_print_object( a, DEBUG_EQUAL ); + debug_print( L" = ", DEBUG_EQUAL ); + debug_print_object( b, DEBUG_EQUAL ); bool result = false; @@ -389,11 +389,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { } #ifdef DEBUG - debug_print( L"Comparing '", DEBUG_ARITH ); - debug_print( a_buff, DEBUG_ARITH ); - debug_print( L"' to '", DEBUG_ARITH ); - debug_print( b_buff, DEBUG_ARITH ); - debug_print( L"'\n", DEBUG_ARITH ); + debug_print( L"Comparing '", DEBUG_EQUAL ); + debug_print( a_buff, DEBUG_EQUAL ); + debug_print( L"' to '", DEBUG_EQUAL ); + debug_print( b_buff, DEBUG_EQUAL ); + debug_print( L"'\n", DEBUG_EQUAL ); #endif /* OK, now we have wchar string buffers loaded from the objects. We @@ -427,7 +427,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { * I'll ignore them, too, for now. */ - debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result ); + debug_printf( DEBUG_EQUAL, L"\nequal returning %d\n", result ); return result; }