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

Various refactorings around bignum arithmetic

Browse source
This commit is contained in:
Simon Brooke 2019-01-17 17:04:14 +00:00
parent d624c671cd
commit 7f93b04b72
6 changed files with 134 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/arith/integer.c
View file

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

7
src/arith/peano.c
View file

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

23
src/debug.c
View file

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

1
src/debug.h
View file

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

3
src/ops/lispops.c
View file

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

159
src/ops/read.c
View file

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