simon/post-scarcity
1
0
Fork 0
Code Issues 7 Pull requests Projects Releases Packages Wiki Activity Actions

Tactical commit while working on the bignum bug, AGAIN.

Browse source
This commit is contained in:
Simon Brooke 2026-03-14 21:20:23 +00:00
parent 7f34601523
commit d42ece5711
4 changed files with 49 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/arith/integer.c
View file

@ -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,23 +226,10 @@ 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 ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
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;
@ -257,7 +244,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print_128bit( rv, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH );
if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) {
if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
result =
acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
break;
@ -275,7 +262,6 @@ struct cons_pointer add_integers( struct cons_pointer a,
is_first_cell = false;
}
}
}
debug_print( L"add_integers returning: ", DEBUG_ARITH );
debug_print_object( result, DEBUG_ARITH );

7
src/debug.h
View file

@ -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 );

3
src/init.c
View file

@ -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
}

22
src/ops/equal.c
View file

@ -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;
}