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

Merge branch 'feature/all-integers-are-bignums' into develop

Browse source
This commit is contained in:
Simon Brooke 2021-07-19 09:50:34 +01:00
parent 0732d25156 e0f6e0a42a
commit 61ff254c98
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
3 changed files with 131 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

181
src/arith/integer.c
View file

@ -216,20 +216,44 @@ struct cons_pointer base_partial( int depth ) {
return result; return result;
} }
/**
* destructively modify this `partial` by appending this `digit`.
*/
struct cons_pointer append_digit( struct cons_pointer partial, struct cons_pointer digit) {
struct cons_pointer c = partial;
struct cons_pointer result = partial;
if (nilp( partial)) {
result = digit;
} else {
while ( !nilp( pointer2cell(c).payload.integer.more)) {
c = pointer2cell(c).payload.integer.more;
}
(&pointer2cell(c))->payload.integer.more = digit;
}
return result;
}
/** /**
* Return a pointer to an integer representing the product of the integers * Return a pointer to an integer representing the product of the integers
* pointed to by `a` and `b`. If either isn't an integer, will return nil. * pointed to by `a` and `b`. If either isn't an integer, will return nil.
* \todo it is MUCH more complicated than this! *
* Yes, this is one of Muhammad ibn Musa al-Khwarizmi's original recipes, so
* you'd think it would be easy; the reason that each step is documented is
* because I did not find it so.
* *
* @param a an integer; * @param a an integer;
* @param b an integer. * @param b an integer.
*/ */
struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer b ) { struct cons_pointer b ) {
struct cons_pointer result = NIL; struct cons_pointer result = make_integer( 0, NIL);
bool neg = is_negative( a ) != is_negative( b ); bool neg = is_negative( a ) != is_negative( b );
bool is_first_b = true; bool is_first_b = true;
int oom = -1; int i = 0;
debug_print( L"multiply_integers: a = ", DEBUG_ARITH ); debug_print( L"multiply_integers: a = ", DEBUG_ARITH );
debug_print_object( a, DEBUG_ARITH ); debug_print_object( a, DEBUG_ARITH );
@ -238,60 +262,54 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
debug_println( DEBUG_ARITH ); debug_println( DEBUG_ARITH );
if ( integerp( a ) && integerp( b ) ) { if ( integerp( a ) && integerp( b ) ) {
while ( !nilp( b ) ) { /* for each digit in a, starting with the least significant (ai) */
bool is_first_d = true;
struct cons_pointer d = a; for ( struct cons_pointer ai = a; !nilp( ai );
struct cons_pointer partial = base_partial( ++oom ); ai = pointer2cell(ai).payload.integer.more) {
/* set carry to 0 */
__int128_t carry = 0; __int128_t carry = 0;
while ( !nilp( d ) || carry != 0 ) { /* set least significant digits for result ri for this iteration
partial = make_integer( 0, partial ); * to i zeros */
struct cons_pointer new = NIL; struct cons_pointer ri = base_partial( i++ );
__int128_t dv = cell_value( d, '+', is_first_d );
__int128_t bv = cell_value( b, '+', is_first_b );
__int128_t rv = ( dv * bv ) + carry; /* for each digit in b, starting with the least significant (bj) */
for ( struct cons_pointer bj = b; !nilp( bj );
bj = pointer2cell(bj).payload.integer.more) {
debug_print( L"multiply_integers: d = ", DEBUG_ARITH ); debug_printf( DEBUG_ARITH,
debug_print_object( d, DEBUG_ARITH ); L"multiply_integers: a[i] = %Ld, b[j] = %Ld, i = %d\n",
debug_print( L"; dv = ", DEBUG_ARITH ); pointer2cell(ai).payload.integer.value,
debug_print_128bit( dv, DEBUG_ARITH ); pointer2cell(bj).payload.integer.value, i);
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"; acc = ", DEBUG_ARITH );
debug_print_object( result, DEBUG_ARITH );
debug_print( L"; partial = ", DEBUG_ARITH );
debug_print_object( partial, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH );
new = make_integer_128( rv, base_partial( oom ) ); /* multiply ai with bj and add the carry, resulting in a
* value xj which may exceed one digit */
__int128_t xj = pointer2cell(ai).payload.integer.value *
pointer2cell(bj).payload.integer.value;
xj += carry;
if ( zerop( partial ) ) { /* if xj exceeds one digit, break it into the digit dj and
partial = new; * the carry */
} else { carry = xj >> 60;
partial = add_integers( partial, new ); struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL);
}
d = integerp( d ) ? pointer2cell( d ).payload.integer. /* destructively modify ri by appending dj */
more : NIL; ri = append_digit( ri, dj);
is_first_d = false; } /* end for bj */
/* if carry is not equal to zero, append it as a final digit
* to ri */
if (carry != 0) {
ri = append_digit( ri, make_integer( carry, NIL));
} }
if ( nilp( result ) || zerop( result ) ) { /* add ri to result */
result = partial; result = add_integers( result, ri);
} else {
struct cons_pointer old = result; debug_print( L"multiply_integers: result is ", DEBUG_ARITH );
result = add_integers( partial, result ); debug_print_object( result, DEBUG_ARITH );
//if (!eq(result, old)) dec_ref(old); debug_println( DEBUG_ARITH );
//if (!eq(result, partial)) dec_ref(partial); } /* end for ai */
}
b = pointer2cell( b ).payload.integer.more;
is_first_b = false;
}
} }
debug_print( L"multiply_integers returning: ", DEBUG_ARITH ); debug_print( L"multiply_integers returning: ", DEBUG_ARITH );
@ -324,38 +342,28 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits,
* when we get to the last digit from one integer cell, we have potentially * when we get to the last digit from one integer cell, we have potentially
* to be looking to the next. H'mmmm. * to be looking to the next. H'mmmm.
*/ */
/*
* \todo this blows up when printing three-cell integers, but works fine
* for two-cell. What's happening is that when we cross the barrier we
* SHOULD print 2^120, but what we actually print is 2^117. H'mmm.
*/
struct cons_pointer integer_to_string( struct cons_pointer int_pointer, struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
int base ) { int base ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object integer = pointer2cell( int_pointer );
__int128_t accumulator = llabs( integer.payload.integer.value );
bool is_negative = integer.payload.integer.value < 0;
int digits = 0;
if ( accumulator == 0 && nilp( integer.payload.integer.more ) ) { if ( integerp( int_pointer ) ) {
result = c_string_to_lisp_string( L"0" ); struct cons_pointer next = pointer2cell( int_pointer ).payload.integer.more;
} else { __int128_t accumulator = llabs( pointer2cell( int_pointer ).payload.integer.value );
while ( accumulator > 0 || !nilp( integer.payload.integer.more ) ) { bool is_negative = pointer2cell( int_pointer ).payload.integer.value < 0;
if ( !nilp( integer.payload.integer.more ) ) { int digits = 0;
integer = pointer2cell( integer.payload.integer.more );
accumulator += integer.payload.integer.value;
debug_print
( L"integer_to_string: crossing cell boundary, accumulator is: ",
DEBUG_IO );
debug_print_128bit( accumulator, DEBUG_IO );
debug_println( DEBUG_IO );
}
do { if ( accumulator == 0 && nilp( next ) ) {
result = c_string_to_lisp_string( L"0" );
} else {
while ( accumulator > 0 || !nilp( next ) ) {
if ( accumulator < MAX_INTEGER && !nilp( next ) ) {
accumulator += (pointer2cell(next).payload.integer.value << 60);
next = pointer2cell(next).payload.integer.more;
}
int offset = ( int ) ( accumulator % base ); int offset = ( int ) ( accumulator % base );
debug_printf( DEBUG_IO, debug_printf( DEBUG_IO,
L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ", L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ",
offset, hex_digits[offset] ); offset, hex_digits[offset] );
debug_print_128bit( accumulator, DEBUG_IO ); debug_print_128bit( accumulator, DEBUG_IO );
debug_print( L"; result is: ", DEBUG_IO ); debug_print( L"; result is: ", DEBUG_IO );
debug_print_object( result, DEBUG_IO ); debug_print_object( result, DEBUG_IO );
@ -364,20 +372,19 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
result = result =
integer_to_string_add_digit( offset, ++digits, result ); integer_to_string_add_digit( offset, ++digits, result );
accumulator = accumulator / base; accumulator = accumulator / base;
} while ( accumulator > base ); }
}
if ( stringp( result ) if ( stringp( result )
&& pointer2cell( result ).payload.string.character == L',' ) { && pointer2cell( result ).payload.string.character == L',' ) {
/* if the number of digits in the string is divisible by 3, there will be /* if the number of digits in the string is divisible by 3, there will be
* an unwanted comma on the front. */ * an unwanted comma on the front. */
struct cons_pointer tmp = result; result = pointer2cell( result ).payload.string.cdr;
result = pointer2cell( result ).payload.string.cdr; }
//dec_ref( tmp );
}
if ( is_negative ) {
result = make_string( L'-', result ); if ( is_negative ) {
result = make_string( L'-', result );
}
} }
} }

40
src/init.c
View file

@ -84,6 +84,33 @@ void bind_value( wchar_t *name, struct cons_pointer value ) {
dec_ref( n ); dec_ref( n );
} }
void print_banner() {
fwprintf(stdout, L"Post-Scarcity Software Environment version %s\n\n", VERSION);
}
/**
* Print command line options to this `stream`.
*
* @stream the stream to print to.
*/
void print_options(FILE* stream) {
fwprintf(stream, L"Expected options are:\n");
fwprintf(stream, L"\t-d\tDump memory to standard out at end of run (copious!);\n");
fwprintf(stream, L"\t-h\tPrint this message and exit;\n");
fwprintf(stream, L"\t-p\tShow a prompt (default is no prompt);\n");
fwprintf(stream, L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n");
fwprintf(stream, L"\t\tWhere bits are interpreted as follows:\n");
fwprintf(stream, L"\t\t1\tALLOC;\n");
fwprintf(stream, L"\t\t2\tARITH;\n");
fwprintf(stream, L"\t\t4\tBIND;\n");
fwprintf(stream, L"\t\t8\tBOOTSTRAP;\n");
fwprintf(stream, L"\t\t16\tEVAL;\n");
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");
}
/** /**
* main entry point; parse command line arguments, initialise the environment, * main entry point; parse command line arguments, initialise the environment,
* and enter the read-eval-print loop. * and enter the read-eval-print loop.
@ -99,11 +126,16 @@ int main( int argc, char *argv[] ) {
exit( 1 ); exit( 1 );
} }
while ( ( option = getopt( argc, argv, "pdv:" ) ) != -1 ) { while ( ( option = getopt( argc, argv, "phdv:" ) ) != -1 ) {
switch ( option ) { switch ( option ) {
case 'd': case 'd':
dump_at_end = true; dump_at_end = true;
break; break;
case 'h':
print_banner();
print_options(stdout);
exit( 0 );
break;
case 'p': case 'p':
show_prompt = true; show_prompt = true;
break; break;
@ -112,14 +144,14 @@ int main( int argc, char *argv[] ) {
break; break;
default: default:
fwprintf( stderr, L"Unexpected option %c\n", option ); fwprintf( stderr, L"Unexpected option %c\n", option );
print_options(stderr);
exit( 1 );
break; break;
} }
} }
if ( show_prompt ) { if ( show_prompt ) {
fwprintf( stdout, print_banner();
L"Post scarcity software environment version %s\n\n",
VERSION );
} }
debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP ); debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP );

2
src/io/print.c
View file

@ -163,7 +163,7 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
print_list( output, pointer ); print_list( output, pointer );
break; break;
case EXCEPTIONTV: case EXCEPTIONTV:
url_fwuts( L"\nException: ", output ); url_fputws( L"\nException: ", output );
dump_stack_trace( output, pointer ); dump_stack_trace( output, pointer );
break; break;
case FUNCTIONTV: case FUNCTIONTV: