From e5f40032e960b3c182b9c66db502f5329d3cbb5b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 31 Dec 2018 16:11:55 +0000 Subject: [PATCH] Now safely detecting (but not dealing with) integer overflow. Also printing and reading integers with comma separators. --- src/arith/integer.c | 53 ++++++++++++++++++++++++++++++++------------- src/ops/lispops.c | 13 ++++++----- src/ops/read.c | 4 +++- 3 files changed, 48 insertions(+), 22 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index 0e74f7b..d916c99 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -12,6 +12,12 @@ #include #include #include +/* safe_iop, as available in the Ubuntu repository, is this one: + * https://code.google.com/archive/p/safe-iop/wikis/README.wiki + * which is installed as `libsafe-iop-dev`. There is an alternate + * implementation here: https://github.com/redpig/safe-iop/ + * which shares the same version number but is not compatible. */ +#include /* * wide characters */ @@ -107,16 +113,18 @@ struct cons_pointer add_integers( struct cons_pointer a, int64_t bv = integerp( b ) ? pointer2cell( b ).payload.integer.value : 0; - __int128_t rv = av + bv + carry; + int64_t rv = 0; - if ( rv > LONG_MAX || rv < LONG_MIN ) { + if ( safe_add( &rv, av, bv ) ) { + carry = 0; + } else { + // TODO: we're correctly detecting overflow, but not yet correctly + // handling it. debug_printf( DEBUG_ARITH, L"add_integers: 64 bit overflow; setting carry to %ld\n", carry ); carry = llabs( rv / LONG_MAX ); rv = rv % LONG_MAX; - } else { - carry = 0; } result = make_integer( rv, result ); @@ -153,16 +161,18 @@ struct cons_pointer multiply_integers( struct cons_pointer a, int64_t bv = integerp( b ) ? pointer2cell( b ).payload.integer.value : 1; - __int128_t rv = ( av * bv ) + carry; + int64_t rv = 0; - if ( rv > LONG_MAX || rv < LONG_MIN ) { + if ( safe_mul( &rv, av, bv ) ) { + carry = 0; + } else { + // TODO: we're correctly detecting overflow, but not yet correctly + // handling it. debug_printf( DEBUG_ARITH, L"multiply_integers: 64 bit overflow; setting carry to %ld\n", carry ); carry = llabs( rv / LONG_MAX ); rv = rv % LONG_MAX; - } else { - carry = 0; } result = make_integer( rv, result ); @@ -177,6 +187,19 @@ struct cons_pointer multiply_integers( struct cons_pointer a, return result; } +/** + * don't use; private to integer_to_string, and somewaht dodgy. + */ +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]; + return ( digits % 3 == 0 ) ? + make_string( L',', make_string( character, + tail ) ) : + make_string( character, tail ); +} + /** * The general principle of printing a bignum is that you print the least * significant digit in whatever base you're dealing with, divide through @@ -195,24 +218,24 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, int64_t accumulator = integer.payload.integer.value; bool is_negative = accumulator < 0; accumulator = llabs( accumulator ); + int digits = 0; if ( accumulator == 0 ) { result = c_string_to_lisp_string( L"0" ); } else { while ( accumulator > 0 ) { - debug_printf( DEBUG_ARITH, + debug_printf( DEBUG_IO, L"integer_to_string: accumulator is %ld\n:", accumulator ); do { - debug_printf( DEBUG_ARITH, + debug_printf( DEBUG_IO, L"integer_to_string: digit is %ld, hexadecimal is %lc\n:", accumulator % base, hex_digits[accumulator % base] ); - wint_t digit = ( wint_t ) hex_digits[accumulator % base]; result = - make_string( ( wint_t ) hex_digits[accumulator % base], - result ); + integer_to_string_add_digit( accumulator % base, digits++, + result ); accumulator = accumulator / base; } while ( accumulator > base ); @@ -223,8 +246,8 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, /* TODO: I don't believe it's as simple as this! */ accumulator += ( base * ( i % base ) ); result = - make_string( ( wint_t ) hex_digits[accumulator % base], - result ); + integer_to_string_add_digit( accumulator % base, digits++, + result ); accumulator += ( base * ( i / base ) ); } } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index d20dbf9..d66af71 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -359,9 +359,10 @@ 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 ); @@ -1015,7 +1016,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" ); struct cons_pointer old_oblist = oblist; struct cons_pointer new_env = env; - inc_ref(env); + inc_ref( env ); inc_ref( input ); inc_ref( output ); @@ -1047,8 +1048,8 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, debug_println( DEBUG_REPL ); new_env = make_cons( c_car( cursor ), new_env ); - inc_ref( new_env); - dec_ref( old_new_env); + inc_ref( new_env ); + dec_ref( old_new_env ); cursor = c_cdr( cursor ); } old_oblist = oblist; diff --git a/src/ops/read.c b/src/ops/read.c index 410a27f..c83fc24 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -175,7 +175,7 @@ struct cons_pointer read_number( struct stack_frame *frame, initial ); for ( c = initial; iswdigit( c ) - || c == btowc( '.' ) || c == btowc( '/' ); c = fgetwc( input ) ) { + || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) { if ( c == btowc( '.' ) ) { if ( seen_period || dividend != 0 ) { return throw_exception( c_string_to_lisp_string @@ -194,6 +194,8 @@ struct cons_pointer read_number( struct stack_frame *frame, accumulator = 0; } + } else if ( c == L',' ) { + // silently ignore it. } else { accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );