From 8629e33f92372d7eaaee83011151500cc2e41c58 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 15 Feb 2026 23:47:28 +0000 Subject: [PATCH] Added a flag, `simplify` to the arg list of `make_ratio`, so that we can create ratios which would otherwise somplify to integers, in order to make ratio arithmetic easier. --- Makefile | 1 + docs/state-of-play.md | 21 +++++++ src/arith/peano.c | 43 ++++++------- src/arith/peano.h | 5 +- src/arith/ratio.c | 140 ++++++++++++++++++++++------------------- src/arith/ratio.h | 5 +- src/io/io.c | 4 +- src/io/read.c | 6 +- src/memory/dump.c | 8 +-- src/ops/equal.c | 141 ++++++++++++++++++++++-------------------- src/ops/lispops.c | 19 +++--- 11 files changed, 213 insertions(+), 180 deletions(-) diff --git a/Makefile b/Makefile index 85c8b8f..7c55be3 100644 --- a/Makefile +++ b/Makefile @@ -30,6 +30,7 @@ $(TARGET): $(OBJS) Makefile doc: $(SRCS) Makefile Doxyfile doxygen + tar czvf target/doc.tgz doc format: $(SRCS) $(HDRS) Makefile ifeq ($(shell uname -s), Darwin) diff --git a/docs/state-of-play.md b/docs/state-of-play.md index 3562cc6..50c4cec 100644 --- a/docs/state-of-play.md +++ b/docs/state-of-play.md @@ -22,6 +22,27 @@ fractions once bignums are working. So we're down to eight unit tests failing: the memory leak, one unimplemented feature, and the bignum problem. +At the end of the day I decided to chew up some memory by doing a series of +moderately large computations, to see how much memory is being successfully +deallocated. + +```lisp +:: (mapcar fact '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)) + +(1 2 6 24 120 720 5,040 40,320 362,880 3,628,800 39,916,800 479,001,600 +1,932,053,504 1,278,945,280 2,004,310,016 2,004,189,184 4,006,445,056 +3,396,534,272 109,641,728 2,192,834,560) +:: + +Allocation summary: allocated 10136; deallocated 548; not deallocated 9588. +``` + +So, about 5%. This is still a major problem, and is making me doubt my reference +counting strategy. Must do better! + +Note that the reason that the numbers become eratic past about two billion is +the bignum arithmetic bug. + ## 20260214 ### Memory leaks diff --git a/src/arith/peano.c b/src/arith/peano.c index 1a43f55..f2c81e0 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -99,7 +99,7 @@ struct cons_pointer absolute( struct cons_pointer arg ) { break; case RATIOTV: result = make_ratio( absolute( cell.payload.ratio.dividend ), - cell.payload.ratio.divisor ); + cell.payload.ratio.divisor, false ); break; case REALTV: result = make_real( 0 - cell.payload.real.value ); @@ -504,7 +504,7 @@ struct cons_pointer negative( struct cons_pointer arg ) { break; case RATIOTV: result = make_ratio( negative( cell.payload.ratio.dividend ), - cell.payload.ratio.divisor ); + cell.payload.ratio.divisor, false ); break; case REALTV: result = make_real( 0 - to_long_double( arg ) ); @@ -566,7 +566,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame, case RATIOTV:{ struct cons_pointer tmp = make_ratio( arg1, make_integer( 1, - NIL ) ); + NIL ), false ); inc_ref( tmp ); result = subtract_ratio_ratio( tmp, arg2 ); dec_ref( tmp ); @@ -592,7 +592,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame, case INTEGERTV:{ struct cons_pointer tmp = make_ratio( arg2, make_integer( 1, - NIL ) ); + NIL ), false ); inc_ref( tmp ); result = subtract_ratio_ratio( arg1, tmp ); dec_ref( tmp ); @@ -670,21 +670,15 @@ struct cons_pointer lisp_divide( struct result = frame->arg[1]; break; case INTEGERTV:{ - struct cons_pointer unsimplified = + result = make_ratio( frame->arg[0], - frame->arg[1] ); - /* OK, if result may be unsimplified, we should not inc_ref it - * - but if not, we should dec_ref it. */ - result = simplify_ratio( unsimplified ); - if ( !eq( unsimplified, result ) ) { - dec_ref( unsimplified ); - } + frame->arg[1], true); } break; case RATIOTV:{ struct cons_pointer one = make_integer( 1, NIL ); struct cons_pointer ratio = - make_ratio( frame->arg[0], one ); + make_ratio( frame->arg[0], one, false ); inc_ref( ratio ); result = divide_ratio_ratio( ratio, frame->arg[1] ); dec_ref( ratio ); @@ -709,11 +703,9 @@ struct cons_pointer lisp_divide( struct break; case INTEGERTV:{ struct cons_pointer one = make_integer( 1, NIL ); - inc_ref( one ); struct cons_pointer ratio = - make_ratio( frame->arg[1], one ); - inc_ref( ratio ); - result = divide_ratio_ratio( frame->arg[0], ratio ); + make_ratio( frame->arg[1], one, false); + result = divide_ratio_ratio( frame->arg[0], ratio ); dec_ref( ratio ); dec_ref( one ); } @@ -760,17 +752,18 @@ struct cons_pointer lisp_divide( struct */ // struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, // struct cons_pointer env ) -struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env) { +struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; struct cons_pointer rat = frame->arg[0]; - debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH); - debug_print_object( rat, DEBUG_ARITH); + debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH ); + debug_print_object( rat, DEBUG_ARITH ); - if ( ratiop( rat)) { - result = make_real( c_ratio_to_ld( rat)); - } // TODO: else throw an exception? + if ( ratiop( rat ) ) { + result = make_real( c_ratio_to_ld( rat ) ); + } // TODO: else throw an exception? return result; -} \ No newline at end of file +} diff --git a/src/arith/peano.h b/src/arith/peano.h index 8b2908c..9e02a4d 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -75,7 +75,8 @@ struct cons_pointer lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env); +struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif /* PEANO_H */ diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 80aff8f..cf67e88 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -64,14 +64,15 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) { if ( gcd > 1 ) { if ( drrv / gcd == 1 ) { - result = acquire_integer( (int64_t)(ddrv / gcd), NIL ); + result = + acquire_integer( ( int64_t ) ( ddrv / gcd ), NIL ); } else { debug_printf( DEBUG_ARITH, L"simplify_ratio: %ld/%ld => %ld/%ld\n", ddrv, drrv, ddrv / gcd, drrv / gcd ); result = make_ratio( acquire_integer( ddrv / gcd, NIL ), - acquire_integer( drrv / gcd, NIL ) ); + acquire_integer( drrv / gcd, NIL ), false); } } } @@ -93,25 +94,26 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer r; - debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH); - debug_print_object( arg1, DEBUG_ARITH); - debug_print( L" + ", DEBUG_ARITH); - debug_print_object( arg2, DEBUG_ARITH); + debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH ); + debug_print_object( arg1, DEBUG_ARITH ); + debug_print( L" + ", DEBUG_ARITH ); + debug_print_object( arg2, DEBUG_ARITH ); if ( ratiop( arg1 ) && ratiop( arg2 ) ) { - struct cons_space_object * cell1 = &pointer2cell( arg1 ); - struct cons_space_object * cell2 = &pointer2cell( arg2 ); - - struct cons_pointer divisor = multiply_integers( cell1->payload.ratio.divisor, cell2->payload.ratio.divisor ); - struct cons_pointer dividend = add_integers( - multiply_integers( cell1->payload.ratio.dividend, - cell2->payload.ratio.divisor), - multiply_integers( cell2->payload.ratio.dividend, - cell1->payload.ratio.divisor)); - r = make_ratio( dividend, divisor ); + struct cons_space_object *cell1 = &pointer2cell( arg1 ); + struct cons_space_object *cell2 = &pointer2cell( arg2 ); + + struct cons_pointer divisor = + multiply_integers( cell1->payload.ratio.divisor, + cell2->payload.ratio.divisor ); + struct cons_pointer dividend = + add_integers( multiply_integers( cell1->payload.ratio.dividend, + cell2->payload.ratio.divisor ), + multiply_integers( cell2->payload.ratio.dividend, + cell1->payload.ratio.divisor ) ); + r = make_ratio( dividend, divisor, true ); } else { - r = - throw_exception( make_cons( c_string_to_lisp_string + r = throw_exception( make_cons( c_string_to_lisp_string ( L"Shouldn't happen: bad arg to add_ratio_ratio" ), make_cons( arg1, make_cons( arg2, NIL ) ) ), @@ -136,15 +138,14 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; - debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH); - debug_print_object( intarg, DEBUG_ARITH); - debug_print( L" + ", DEBUG_ARITH); - debug_print_object( ratarg, DEBUG_ARITH); + debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH ); + debug_print_object( intarg, DEBUG_ARITH ); + debug_print( L" + ", DEBUG_ARITH ); + debug_print_object( ratarg, DEBUG_ARITH ); if ( integerp( intarg ) && ratiop( ratarg ) ) { - // TODO: not longer works struct cons_pointer one = acquire_integer( 1, NIL ), - ratio = make_ratio( intarg, one ); + ratio = make_ratio( intarg, one, false ); result = add_ratio_ratio( ratio, ratarg ); @@ -174,14 +175,14 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH); - debug_print_object( arg1, DEBUG_ARITH); - debug_print( L" / ", DEBUG_ARITH); - debug_print_object( arg2, DEBUG_ARITH); + debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH ); + debug_print_object( arg1, DEBUG_ARITH ); + debug_print( L" / ", DEBUG_ARITH ); + debug_print_object( arg2, DEBUG_ARITH ); // TODO: this now has to work if `arg1` is an integer struct cons_pointer i = make_ratio( pointer2cell( arg2 ).payload.ratio.divisor, - pointer2cell( arg2 ).payload.ratio.dividend ), result = + pointer2cell( arg2 ).payload.ratio.dividend, false ), result = multiply_ratio_ratio( arg1, i ); dec_ref( i ); @@ -226,15 +227,10 @@ struct cons_pointer multiply_ratio_ratio( struct struct cons_pointer dividend = acquire_integer( ddrv, NIL ); struct cons_pointer divisor = acquire_integer( drrv, NIL ); - struct cons_pointer unsimplified = make_ratio( dividend, divisor ); - result = simplify_ratio( unsimplified ); - + result = make_ratio( dividend, divisor, true ); + release_integer( dividend ); release_integer( divisor ); - - if ( !eq( unsimplified, result ) ) { - dec_ref( unsimplified ); - } } else { result = throw_exception( c_string_to_lisp_string @@ -259,15 +255,14 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; - debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH); - debug_print_object( intarg, DEBUG_ARITH); - debug_print( L" * ", DEBUG_ARITH); - debug_print_object( ratarg, DEBUG_ARITH); + debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH ); + debug_print_object( intarg, DEBUG_ARITH ); + debug_print( L" * ", DEBUG_ARITH ); + debug_print_object( ratarg, DEBUG_ARITH ); if ( integerp( intarg ) && ratiop( ratarg ) ) { - // TODO: no longer works; fix struct cons_pointer one = acquire_integer( 1, NIL ), - ratio = make_ratio( intarg, one ); + ratio = make_ratio( intarg, one, false ); result = multiply_ratio_ratio( ratio, ratarg ); release_integer( one ); @@ -294,10 +289,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH); - debug_print_object( arg1, DEBUG_ARITH); - debug_print( L" * ", DEBUG_ARITH); - debug_print_object( arg2, DEBUG_ARITH); + debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH ); + debug_print_object( arg1, DEBUG_ARITH ); + debug_print( L" * ", DEBUG_ARITH ); + debug_print_object( arg2, DEBUG_ARITH ); struct cons_pointer i = negative( arg2 ), result = add_ratio_ratio( arg1, i ); @@ -315,7 +310,14 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, * @exception if either `dividend` or `divisor` is not an integer. */ struct cons_pointer make_ratio( struct cons_pointer dividend, - struct cons_pointer divisor ) { + struct cons_pointer divisor, + bool simplify ) { + debug_print( L"make_ratio: dividend = ", DEBUG_ALLOC); + debug_print_object( dividend, DEBUG_ALLOC); + debug_print( L"; divisor = ", DEBUG_ALLOC); + debug_print_object( divisor, DEBUG_ALLOC); + debug_printf( DEBUG_ALLOC, L"; simplify = %d\n", simplify); + struct cons_pointer result; if ( integerp( dividend ) && integerp( divisor ) ) { inc_ref( dividend ); @@ -325,9 +327,13 @@ struct cons_pointer make_ratio( struct cons_pointer dividend, cell->payload.ratio.dividend = dividend; cell->payload.ratio.divisor = divisor; - result = simplify_ratio( unsimplified ); - if ( !eq( result, unsimplified ) ) { - dec_ref( unsimplified ); + if ( simplify) { + result = simplify_ratio( unsimplified ); + if ( !eq( result, unsimplified ) ) { + dec_ref( unsimplified ); + } + } else { + result = unsimplified; } } else { result = @@ -335,8 +341,9 @@ struct cons_pointer make_ratio( struct cons_pointer dividend, ( L"Dividend and divisor of a ratio must be integers" ), NIL ); } - // debug_print( L"make_ratio returning:\n", DEBUG_ARITH); - debug_dump_object( result, DEBUG_ARITH ); + debug_print( L" => ", DEBUG_ALLOC); + debug_print_object( result, DEBUG_ALLOC ); + debug_println( DEBUG_ALLOC); return result; } @@ -369,28 +376,31 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) { * @param rat a pointer to a ratio. * @return long double */ -long double c_ratio_to_ld( struct cons_pointer rat) { +long double c_ratio_to_ld( struct cons_pointer rat ) { long double result = NAN; - debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH); - debug_print_object( rat, DEBUG_ARITH); + debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH ); + debug_print_object( rat, DEBUG_ARITH ); - if ( ratiop( rat)) { - struct cons_space_object * cell_a = & pointer2cell( rat); + if ( ratiop( rat ) ) { + struct cons_space_object *cell_a = &pointer2cell( rat ); struct cons_pointer dv = cell_a->payload.ratio.divisor; - struct cons_space_object * dv_cell = &pointer2cell( dv); + struct cons_space_object *dv_cell = &pointer2cell( dv ); struct cons_pointer dd = cell_a->payload.ratio.dividend; - struct cons_space_object * dd_cell = &pointer2cell( dd); - - if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) { - result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);; + struct cons_space_object *dd_cell = &pointer2cell( dd ); + + if ( nilp( dv_cell->payload.integer.more ) + && nilp( dd_cell->payload.integer.more ) ) { + result = + ( ( long double ) dd_cell->payload.integer.value ) / + ( ( long double ) dv_cell->payload.integer.value );; } else { - fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals."); - } + fwprintf( stderr, + L"real conversion is not yet implemented for bignums rationals." ); + } } debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result ); return result; } - diff --git a/src/arith/ratio.h b/src/arith/ratio.h index 8d93f44..4ef0d24 100644 --- a/src/arith/ratio.h +++ b/src/arith/ratio.h @@ -32,10 +32,11 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ); struct cons_pointer make_ratio( struct cons_pointer dividend, - struct cons_pointer divisor ); + struct cons_pointer divisor, + bool simplify ); bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ); -long double c_ratio_to_ld( struct cons_pointer rat); +long double c_ratio_to_ld( struct cons_pointer rat ); #endif diff --git a/src/io/io.c b/src/io/io.c index b7dc11c..aa960f0 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( frame->arg[0] ) ) { result = make_string( url_fgetwc - ( pointer2cell( frame->arg[0] ).payload. - stream.stream ), NIL ); + ( pointer2cell( frame->arg[0] ).payload.stream. + stream ), NIL ); } return result; diff --git a/src/io/read.c b/src/io/read.c index 24a47fb..c103274 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -90,7 +90,7 @@ struct cons_pointer read_path( URL_FILE *input, wint_t initial, switch ( initial ) { case '/': - prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL); + prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL ); break; case '$': case LSESSION: @@ -370,7 +370,7 @@ struct cons_pointer read_number( struct stack_frame *frame, ( to_long_double ( base ), places_of_decimals ), - NIL ) ); + NIL ), true); inc_ref( div ); result = make_real( to_long_double( div ) ); @@ -378,7 +378,7 @@ struct cons_pointer read_number( struct stack_frame *frame, dec_ref( div ); } else if ( integerp( dividend ) ) { debug_print( L"read_number: converting result to ratio\n", DEBUG_IO ); - result = make_ratio( dividend, result ); + result = make_ratio( dividend, result, true ); } if ( neg ) { diff --git a/src/memory/dump.c b/src/memory/dump.c index 3a83866..b065661 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { case RATIOTV: url_fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ). - payload.integer.value, - pointer2cell( cell.payload.ratio.divisor ). - payload.integer.value, cell.count ); + pointer2cell( cell.payload.ratio.dividend ).payload. + integer.value, + pointer2cell( cell.payload.ratio.divisor ).payload. + integer.value, cell.count ); break; case READTV: url_fputws( L"\t\tInput stream; metadata: ", output ); diff --git a/src/ops/equal.c b/src/ops/equal.c index 0b21060..105cc93 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -58,17 +58,17 @@ bool end_of_string( struct cons_pointer string ) { * @return true if `a` and `b` are equal to within one part in a billion. * @return false otherwise. */ -bool equal_ld_ld( long double a, long double b) { - long double fa = fabsl( a); - long double fb = fabsl( b); +bool equal_ld_ld( long double a, long double b ) { + long double fa = fabsl( a ); + long double fb = fabsl( b ); /* difference of magnitudes */ - long double diff = fabsl( fa - fb); + long double diff = fabsl( fa - fb ); /* average magnitude of the two */ - long double av = (fa > fb) ? ( fa - diff) : ( fb - diff); + long double av = ( fa > fb ) ? ( fa - diff ) : ( fb - diff ); /* amount of difference we will tolerate for equality */ long double tolerance = av * 0.000000001; - bool result = ( fabsl( a - b) < tolerance); + bool result = ( fabsl( a - b ) < tolerance ); debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result ); @@ -84,22 +84,26 @@ bool equal_ld_ld( long double a, long double b) { * @return true if the two numbers have equal value. * @return false if they don't. */ -bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){ - debug_print( L"\nequal_integer_real: ", DEBUG_ARITH); - debug_print_object( a, DEBUG_ARITH); - debug_print( L" = ", DEBUG_ARITH); - debug_print_object( b, DEBUG_ARITH); +bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) { + debug_print( L"\nequal_integer_real: ", DEBUG_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" = ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); bool result = false; - struct cons_space_object * cell_a = &pointer2cell( a); - struct cons_space_object * cell_b = & pointer2cell( b); + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); - if (nilp( cell_a->payload.integer.more)) { - result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value); + if ( nilp( cell_a->payload.integer.more ) ) { + result = + equal_ld_ld( ( long double ) cell_a->payload.integer.value, + cell_b->payload.real.value ); } else { - fwprintf( stderr, L"\nequality is not yet implemented for bignums compared to reals."); + fwprintf( stderr, + L"\nequality is not yet implemented for bignums compared to reals." ); } - debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", result ); + debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", + result ); return result; } @@ -114,26 +118,27 @@ bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){ * @return false if they don't. */ bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) { - debug_print( L"\nequal_integer_number: ", DEBUG_ARITH); - debug_print_object( a, DEBUG_ARITH); - debug_print( L" = ", DEBUG_ARITH); - debug_print_object( b, DEBUG_ARITH); + debug_print( L"\nequal_integer_number: ", DEBUG_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" = ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); bool result = false; - struct cons_space_object * cell_b = & pointer2cell( b); + struct cons_space_object *cell_b = &pointer2cell( b ); - switch ( cell_b->tag.value) { + switch ( cell_b->tag.value ) { case INTEGERTV: - result = equal_integer_integer( a, b); + result = equal_integer_integer( a, b ); break; - case REALTV: - result = equal_integer_real( a, b); + case REALTV: + result = equal_integer_real( a, b ); break; case RATIOTV: result = false; break; } - - debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", result ); + + debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", + result ); return result; } @@ -147,30 +152,33 @@ bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) { * @return true if the two numbers have equal value. * @return false if they don't. */ -bool equal_real_number( struct cons_pointer a, struct cons_pointer b) { - debug_print( L"\nequal_real_number: ", DEBUG_ARITH); - debug_print_object( a, DEBUG_ARITH); - debug_print( L" = ", DEBUG_ARITH); - debug_print_object( b, DEBUG_ARITH); +bool equal_real_number( struct cons_pointer a, struct cons_pointer b ) { + debug_print( L"\nequal_real_number: ", DEBUG_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" = ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); bool result = false; - struct cons_space_object * cell_b = & pointer2cell( b); + struct cons_space_object *cell_b = &pointer2cell( b ); - switch ( cell_b->tag.value) { + switch ( cell_b->tag.value ) { case INTEGERTV: - result = equal_integer_real( b, a); + result = equal_integer_real( b, a ); break; - case REALTV: { - struct cons_space_object * cell_a = & pointer2cell( a); - result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value); + case REALTV:{ + struct cons_space_object *cell_a = &pointer2cell( a ); + result = + equal_ld_ld( cell_a->payload.real.value, + cell_b->payload.real.value ); } break; - case RATIOTV: - struct cons_space_object * cell_a = & pointer2cell( a); - result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value); + case RATIOTV: + struct cons_space_object *cell_a = &pointer2cell( a ); + result = + equal_ld_ld( c_ratio_to_ld( b ), cell_a->payload.real.value ); break; - } + } - debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result ); + debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result ); return result; } @@ -187,24 +195,24 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) { bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) { bool result = eq( a, b ); - debug_print( L"\nequal_number_number: ", DEBUG_ARITH); - debug_print_object( a, DEBUG_ARITH); - debug_print( L" = ", DEBUG_ARITH); - debug_print_object( b, DEBUG_ARITH); + debug_print( L"\nequal_number_number: ", DEBUG_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" = ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); if ( !result ) { - struct cons_space_object * cell_a = & pointer2cell( a); - struct cons_space_object * cell_b = & pointer2cell( b); + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); - switch ( cell_a->tag.value) { - case INTEGERTV: - result = equal_integer_number( a, b); + switch ( cell_a->tag.value ) { + case INTEGERTV: + result = equal_integer_number( a, b ); break; case REALTV: - result = equal_real_number( a, b); + result = equal_real_number( a, b ); break; case RATIOTV: - switch( cell_b->tag.value) { + switch ( cell_b->tag.value ) { case INTEGERTV: /* as all ratios are simplified by make_ratio, any * ratio that would simplify to an integer is an @@ -212,13 +220,13 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) { result = false; break; case REALTV: - result = equal_real_number( b, a); + result = equal_real_number( b, a ); break; case RATIOTV: - result = equal_ratio_ratio( a, b); + result = equal_ratio_ratio( a, b ); break; - /* can't throw an exception from here, but non-numbers - * shouldn't have been passed in anyway, so no default. */ + /* can't throw an exception from here, but non-numbers + * shouldn't have been passed in anyway, so no default. */ } break; /* can't throw an exception from here, but non-numbers @@ -226,20 +234,21 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) { } } - debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", result ); + debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", + result ); return result; } - + /** * Deep, and thus expensive, equality: true if these two objects have * 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_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" = ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); bool result = eq( a, b ); @@ -309,7 +318,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { break; } } else if ( numberp( a ) && numberp( b ) ) { - result = equal_number_number( a, b); + result = equal_number_number( a, b ); } /* diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 782afe0..4584a9b 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload.special. + executable ) ( get_stack_frame( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -1246,8 +1245,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer message = frame->arg[0]; return exceptionp( message ) ? message : throw_exception( message, - frame-> - previous ); + frame->previous ); } /** @@ -1430,14 +1428,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { if ( nilp( c_cdr( l1 ) ) ) { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), - l2, + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), l2, pointer2cell( l1 ).tag.value ); } else { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), c_append( c_cdr( l1 ), l2 ), pointer2cell( l1 ).tag.value ); }