diff --git a/src/arith/integer.c b/src/arith/integer.c index 779a112..a5e2271 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -36,7 +36,7 @@ /** * hexadecimal digits for printing numbers. */ -const wchar_t hex_digits[16] = L"0123456789ABCDEF"; +const char * hex_digits = "0123456789ABCDEF"; /* * Doctrine from here on in is that ALL integers are bignums, it's just @@ -133,13 +133,24 @@ struct cons_pointer operate_on_integers( struct cons_pointer a, switch (op) { case '*': - rv = ( av * bv ) + carry; + rv = av * bv * ((carry == 0) ? 1 : carry); break; case '+': rv = av + bv + carry; break; } + debug_printf( DEBUG_ARITH, L"operate_on_integers: op = '%c'; av = ", op); + 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 ( MAX_INTEGER >= rv ) { carry = 0; } else { @@ -206,7 +217,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer integer_to_string_add_digit( int digit, int digits, struct cons_pointer tail ) { digits++; - wint_t character = ( wint_t ) hex_digits[digit]; + wint_t character = btowc(hex_digits[digit]); return ( digits % 3 == 0 ) ? make_string( L',', make_string( character, tail ) ) : @@ -247,13 +258,14 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, L"integer_to_string: accumulator is %ld\n:", accumulator ); do { + int offset = (int)(accumulator % base); debug_printf( DEBUG_IO, - L"integer_to_string: digit is %ld, hexadecimal is %C\n:", - accumulator % base, - btowc(hex_digits[accumulator % base] )); + L"integer_to_string: digit is %ld, hexadecimal is %c\n:", + offset, + hex_digits[offset] ); result = - integer_to_string_add_digit( accumulator % base, digits++, + integer_to_string_add_digit( offset, digits++, result ); accumulator = accumulator / base; } while ( accumulator > base ); diff --git a/src/arith/peano.c b/src/arith/peano.c index 481f33e..1dded80 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -41,7 +41,8 @@ bool zerop( struct cons_pointer arg ) { switch ( cell.tag.value ) { case INTEGERTV: - result = cell.payload.integer.value == 0; + result = cell.payload.integer.value == 0 && + nilp(cell.payload.integer.more); break; case RATIOTV: result = zerop( cell.payload.ratio.dividend ); @@ -134,9 +135,9 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_space_object cell2 = pointer2cell( arg2 ); debug_print( L"add_2( arg1 = ", DEBUG_ARITH ); - debug_print_object( arg1, DEBUG_ARITH ); + debug_dump_object( arg1, DEBUG_ARITH ); debug_print( L"; arg2 = ", DEBUG_ARITH ); - debug_print_object( arg2, DEBUG_ARITH ); + debug_dump_object( arg2, DEBUG_ARITH ); debug_print( L"\n", DEBUG_ARITH ); if ( zerop( arg1 ) ) { diff --git a/src/debug.c b/src/debug.c index eba31e8..392aa71 100644 --- a/src/debug.c +++ b/src/debug.c @@ -42,6 +42,29 @@ void debug_print( wchar_t *message, int level ) { #endif } +/** + * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc + */ +void debug_print_128bit( __int128_t n, int level ) { + #ifdef DEBUG + if ( level & verbosity ) { + if (n == 0) { + fwprintf(stderr, L"0"); + } else { + char str[40] = {0}; // log10(1 << 128) + '\0' + char *s = str + sizeof(str) - 1; // start at the end + while (n != 0) { + if (s == str) return; // never happens + + *--s = "0123456789"[n % 10]; // save last digit + n /= 10; // drop it + } + fwprintf(stderr, L"%s", s); + } + } + #endif +} + /** * print a line feed to stderr, if `verbosity` matches `level`. * `verbosity is a set of flags, see debug_print.h; so you can diff --git a/src/debug.h b/src/debug.h index 72fa020..f961d6e 100644 --- a/src/debug.h +++ b/src/debug.h @@ -26,6 +26,7 @@ extern int verbosity; void debug_print( wchar_t *message, int level ); +void debug_print_128bit( __int128_t n, int level ); void debug_println( int level ); void debug_printf( int level, wchar_t *format, ... ); void debug_print_object( struct cons_pointer pointer, int level ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index aba7a92..298ae1a 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -1133,7 +1133,6 @@ struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { debug_print( L"Entering print\n", DEBUG_IO ); - struct cons_pointer result = frame->arg[0]; FILE *output = stdout; struct cons_pointer out_stream = writep( frame->arg[1] ) ? frame->arg[1] : get_default_stream( false, env ); @@ -1150,5 +1149,5 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer dec_ref( out_stream ); } - return result; + return frame->arg[0]; } diff --git a/src/ops/read.c b/src/ops/read.c index 9074652..4f866d6 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -157,91 +157,104 @@ struct cons_pointer read_continuation( struct stack_frame *frame, * garbage is collected. */ struct cons_pointer read_number( struct stack_frame *frame, - struct cons_pointer frame_pointer, - FILE * input, - wint_t initial, bool seen_period ) { - debug_print( L"entering read_number\n", DEBUG_IO ); + struct cons_pointer frame_pointer, + FILE * input, + wint_t initial, bool seen_period ) { + debug_print( L"entering read_number\n", DEBUG_IO ); - struct cons_pointer result = make_integer( 0, NIL ); - /* TODO: we really need to be getting `base` from a privileged Lisp name - + struct cons_pointer result = make_integer( 0, NIL ); + /* TODO: we really need to be getting `base` from a privileged Lisp name - * and it should be the same privileged name we use when writing numbers */ - struct cons_pointer base = make_integer( 10, NIL ); - struct cons_pointer dividend = NIL; - int places_of_decimals = 0; - wint_t c; - bool neg = initial == btowc( '-' ); + struct cons_pointer base = make_integer( 10, NIL ); + struct cons_pointer dividend = NIL; + int places_of_decimals = 0; + wint_t c; + bool neg = initial == btowc( '-' ); - if ( neg ) { - initial = fgetwc( input ); + if ( neg ) { + initial = fgetwc( input ); + } + + debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial, + initial ); + + for ( c = initial; iswdigit( c ) + || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) { + switch (c) { + case L'.': + if ( seen_period || !nilp( dividend ) ) { + return throw_exception( c_string_to_lisp_string + ( L"Malformed number: too many periods" ), + frame_pointer ); + } else { + debug_print(L"read_number: decimal point seen\n", DEBUG_IO); + seen_period = true; + } + break; + case L'/': + if ( seen_period || !nilp( dividend ) ) { + return throw_exception( c_string_to_lisp_string + ( L"Malformed number: dividend of rational must be integer" ), + frame_pointer ); + } else { + debug_print(L"read_number: ratio slash seen\n", DEBUG_IO); + dividend = result; + + result = make_integer( 0, NIL ); + } + break; + case L',' : + // silently ignore it. + break; + default: + result = add_integers( multiply_integers( result, base ), + make_integer( ( int ) c - ( int ) '0', + NIL ) ); + + debug_printf( DEBUG_IO, + L"read_number: added character %c, result now ", c ); + debug_print_object( result, DEBUG_IO); + debug_print( L"\n", DEBUG_IO); + + if ( seen_period ) { + places_of_decimals++; + } } + } - debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial, - initial ); - - for ( c = initial; iswdigit( c ) - || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) { - if ( c == btowc( '.' ) ) { - if ( seen_period || !nilp( dividend ) ) { - return throw_exception( c_string_to_lisp_string - ( L"Malformed number: too many periods" ), - frame_pointer ); - } else { - seen_period = true; - } - } else if ( c == btowc( '/' ) ) { - if ( seen_period || !nilp( dividend ) ) { - return throw_exception( c_string_to_lisp_string - ( L"Malformed number: dividend of rational must be integer" ), - frame_pointer ); - } else { - dividend = result; - - result = make_integer( 0, NIL ); - } - } else if ( c == L',' ) { - // silently ignore it. - } else { - result = add_integers( multiply_integers( result, base ), - make_integer( ( int ) c - ( int ) '0', - NIL ) ); - - debug_printf( DEBUG_IO, - L"Added character %c, result now %ld\n", c, result ); - - if ( seen_period ) { - places_of_decimals++; - } - } - } - - /* + /* * push back the character read which was not a digit */ - ungetwc( c, input ); - if ( seen_period ) { - struct cons_pointer div = make_ratio( frame_pointer, result, - make_integer( powl - ( to_long_double - ( base ), - places_of_decimals ), - NIL ) ); - inc_ref( div ); + ungetwc( c, input ); - result = make_real( to_long_double( div ) ); + if ( seen_period ) { + debug_print(L"read_number: converting result to real\n", DEBUG_IO); + struct cons_pointer div = make_ratio( frame_pointer, result, + make_integer( powl + ( to_long_double + ( base ), + places_of_decimals ), + NIL ) ); + inc_ref( div ); - dec_ref( div ); - } else if ( integerp( dividend ) ) { - result = make_ratio( frame_pointer, dividend, result ); - } + result = make_real( to_long_double( div ) ); - if ( neg ) { - result = negative( frame_pointer, result ); - } + dec_ref( div ); + } else if ( integerp( dividend ) ) { + debug_print(L"read_number: converting result to ratio\n", DEBUG_IO); + result = make_ratio( frame_pointer, dividend, result ); + } - debug_print( L"read_number returning\n", DEBUG_IO ); - debug_dump_object( result, DEBUG_IO ); + if ( neg ) { + debug_print(L"read_number: converting result to negative\n", DEBUG_IO); - return result; + result = negative( frame_pointer, result ); + } + + debug_print( L"read_number returning\n", DEBUG_IO ); + debug_dump_object( result, DEBUG_IO ); + + return result; } /**