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

Tactical commit

Browse source
This commit is contained in:
Simon Brooke 2019-01-28 15:02:46 +00:00
parent 8334e2bf1f
commit b15c0e8f89
4 changed files with 167 additions and 124 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
src/arith/integer.c
View file

@ -76,20 +76,16 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
* \see add_integers * \see add_integers
*/ */
__int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
long int val = nilp( c ) ? long int val = nilp( c ) ? 0 : pointer2cell( c ).payload.integer.value;
0 :
pointer2cell( c ).payload.integer.value;
long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 ); long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 );
__int128_t result = ( __int128_t ) integerp( c ) ? __int128_t result = ( __int128_t ) integerp( c ) ?
( val == 0 ) ? ( val == 0 ) ? carry : val : op == '*' ? 1 : 0;
carry :
val :
op == '*' ? 1 : 0;
debug_printf( DEBUG_ARITH, debug_printf( DEBUG_ARITH,
L"cell_value: raw value is %ld, is_first_cell = %s; %4.4s; returning ", L"cell_value: raw value is %ld, is_first_cell = %s; %4.4s; returning ",
val, is_first_cell ? "true" : "false", pointer2cell(c).tag.bytes); val, is_first_cell ? "true" : "false",
pointer2cell( c ).tag.bytes );
debug_print_128bit( result, DEBUG_ARITH ); debug_print_128bit( result, DEBUG_ARITH );
debug_println( DEBUG_ARITH ); debug_println( DEBUG_ARITH );
@ -110,8 +106,7 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
*/ */
__int128_t int128_to_integer( __int128_t val, __int128_t int128_to_integer( __int128_t val,
struct cons_pointer less_significant, struct cons_pointer less_significant,
struct cons_pointer new) struct cons_pointer new ) {
{
struct cons_pointer cursor = NIL; struct cons_pointer cursor = NIL;
__int128_t carry = 0; __int128_t carry = 0;
@ -125,7 +120,7 @@ __int128_t int128_to_integer( __int128_t val,
val &= MAX_INTEGER; val &= MAX_INTEGER;
} }
struct cons_space_object * newc = &pointer2cell( new); struct cons_space_object *newc = &pointer2cell( new );
newc->payload.integer.value = val; newc->payload.integer.value = val;
if ( integerp( less_significant ) ) { if ( integerp( less_significant ) ) {
@ -137,19 +132,21 @@ __int128_t int128_to_integer( __int128_t val,
return carry; return carry;
} }
struct cons_pointer make_integer_128(__int128_t val, struct cons_pointer make_integer_128( __int128_t val,
struct cons_pointer less_significant) { struct cons_pointer less_significant ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
do { do {
if ( MAX_INTEGER >= val ) { if ( MAX_INTEGER >= val ) {
result = make_integer( (long int) val, less_significant); result = make_integer( ( long int ) val, less_significant );
} else { } else {
less_significant = make_integer( (long int)val & MAX_INTEGER, less_significant); less_significant =
make_integer( ( long int ) val & MAX_INTEGER,
less_significant );
val = val >> 60; val = val >> 60;
} }
} while (nilp(result)); } while ( nilp( result ) );
return result; return result;
} }
@ -164,10 +161,10 @@ struct cons_pointer add_integers( struct cons_pointer a,
struct cons_pointer cursor = NIL; struct cons_pointer cursor = NIL;
debug_print( L"add_integers: a = ", DEBUG_ARITH ); debug_print( L"add_integers: a = ", DEBUG_ARITH );
debug_print_object(a, DEBUG_ARITH); debug_print_object( a, DEBUG_ARITH );
debug_print( L"; b = ", DEBUG_ARITH ); debug_print( L"; b = ", DEBUG_ARITH );
debug_print_object(b, DEBUG_ARITH); debug_print_object( b, DEBUG_ARITH );
debug_println(DEBUG_ARITH); debug_println( DEBUG_ARITH );
__int128_t carry = 0; __int128_t carry = 0;
bool is_first_cell = true; bool is_first_cell = true;
@ -194,8 +191,8 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print_128bit( rv, DEBUG_ARITH ); debug_print_128bit( rv, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH ); debug_print( L"\n", DEBUG_ARITH );
struct cons_pointer new = make_integer( 0, NIL); struct cons_pointer new = make_integer( 0, NIL );
carry = int128_to_integer(rv, cursor, new); carry = int128_to_integer( rv, cursor, new );
cursor = new; cursor = new;
if ( nilp( result ) ) { if ( nilp( result ) ) {
@ -215,11 +212,11 @@ struct cons_pointer add_integers( struct cons_pointer a,
return result; return result;
} }
struct cons_pointer base_partial(int depth) { struct cons_pointer base_partial( int depth ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
for (int i = 0; i < depth; i++) { for ( int i = 0; i < depth; i++ ) {
result = make_integer(0, result); result = make_integer( 0, result );
} }
return result; return result;
@ -236,33 +233,33 @@ struct cons_pointer base_partial(int depth) {
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 = 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 oom = -1;
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 );
debug_print( L"; b = ", DEBUG_ARITH ); debug_print( L"; b = ", DEBUG_ARITH );
debug_print_object(b, DEBUG_ARITH); debug_print_object( b, DEBUG_ARITH );
debug_println(DEBUG_ARITH); debug_println( DEBUG_ARITH );
if ( integerp( a ) && integerp( b ) ) { if ( integerp( a ) && integerp( b ) ) {
while ( !nilp( b ) ) { while ( !nilp( b ) ) {
bool is_first_d = true; bool is_first_d = true;
struct cons_pointer d = a; struct cons_pointer d = a;
struct cons_pointer partial = base_partial(++oom); struct cons_pointer partial = base_partial( ++oom );
__int128_t carry = 0; __int128_t carry = 0;
while ( !nilp(d) || carry != 0) { while ( !nilp( d ) || carry != 0 ) {
partial = make_integer(0, partial); partial = make_integer( 0, partial );
struct cons_pointer new = NIL; struct cons_pointer new = NIL;
__int128_t dv = cell_value( d, '+', is_first_d ); __int128_t dv = cell_value( d, '+', is_first_d );
__int128_t bv = cell_value( b, '+', is_first_b ); __int128_t bv = cell_value( b, '+', is_first_b );
__int128_t rv = (dv * bv) + carry; __int128_t rv = ( dv * bv ) + carry;
debug_print( L"multiply_integers: d = ", DEBUG_ARITH); debug_print( L"multiply_integers: d = ", DEBUG_ARITH );
debug_print_object( d, DEBUG_ARITH); debug_print_object( d, DEBUG_ARITH );
debug_print( L"; dv = ", DEBUG_ARITH ); debug_print( L"; dv = ", DEBUG_ARITH );
debug_print_128bit( dv, DEBUG_ARITH ); debug_print_128bit( dv, DEBUG_ARITH );
debug_print( L"; bv = ", DEBUG_ARITH ); debug_print( L"; bv = ", DEBUG_ARITH );
@ -272,28 +269,29 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
debug_print( L"; rv = ", DEBUG_ARITH ); debug_print( L"; rv = ", DEBUG_ARITH );
debug_print_128bit( rv, DEBUG_ARITH ); debug_print_128bit( rv, DEBUG_ARITH );
debug_print( L"; acc = ", DEBUG_ARITH ); debug_print( L"; acc = ", DEBUG_ARITH );
debug_print_object( result, DEBUG_ARITH); debug_print_object( result, DEBUG_ARITH );
debug_print( L"; partial = ", DEBUG_ARITH ); debug_print( L"; partial = ", DEBUG_ARITH );
debug_print_object( partial, DEBUG_ARITH); debug_print_object( partial, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH ); debug_print( L"\n", DEBUG_ARITH );
new = make_integer_128(rv, base_partial(oom)); new = make_integer_128( rv, base_partial( oom ) );
if ( zerop(partial)) { if ( zerop( partial ) ) {
partial = new; partial = new;
} else { } else {
partial = add_integers(partial, new); partial = add_integers( partial, new );
} }
d = integerp(d) ? pointer2cell( d ).payload.integer.more : NIL; d = integerp( d ) ? pointer2cell( d ).payload.integer.
more : NIL;
is_first_d = false; is_first_d = false;
} }
if (nilp(result) || zerop(result)) { if ( nilp( result ) || zerop( result ) ) {
result = partial; result = partial;
} else { } else {
struct cons_pointer old = result; struct cons_pointer old = result;
result = add_integers(partial, result); result = add_integers( partial, result );
//if (!eq(result, old)) dec_ref(old); //if (!eq(result, old)) dec_ref(old);
//if (!eq(result, partial)) dec_ref(partial); //if (!eq(result, partial)) dec_ref(partial);
} }
@ -365,8 +363,8 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
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 );
debug_println( DEBUG_IO ); debug_println( DEBUG_IO );
result = result =

2
src/init.c
View file

@ -87,7 +87,7 @@ int main( int argc, char *argv[] ) {
bool show_prompt = false; bool show_prompt = false;
setlocale( LC_ALL, "" ); setlocale( LC_ALL, "" );
curl_global_init(CURL_GLOBAL_DEFAULT); curl_global_init( CURL_GLOBAL_DEFAULT );
while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) { while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) {
switch ( option ) { switch ( option ) {

73
src/io/fopen.c
View file

@ -53,6 +53,8 @@
/* we use a global one for convenience */ /* we use a global one for convenience */
static CURLM *multi_handle; static CURLM *multi_handle;
wint_t ungotten = 0;
/* curl calls this routine to get more data */ /* curl calls this routine to get more data */
static size_t write_callback( char *buffer, static size_t write_callback( char *buffer,
size_t size, size_t nitems, void *userp ) { size_t size, size_t nitems, void *userp ) {
@ -452,6 +454,13 @@ URL_FILE *file_to_url_file( FILE * f ) {
wint_t url_fgetwc( URL_FILE * input ) { wint_t url_fgetwc( URL_FILE * input ) {
wint_t result = -1; wint_t result = -1;
debug_printf( DEBUG_IO, L"url_fgetwc: ungotten = %d\n", ungotten );
if ( ungotten != 0 ) {
/* TODO: not thread safe */
result = ungotten;
ungotten = 0;
} else {
switch ( input->type ) { switch ( input->type ) {
case CFTYPE_FILE: case CFTYPE_FILE:
fwide( input->handle.file, 1 ); /* wide characters */ fwide( input->handle.file, 1 ); /* wide characters */
@ -459,20 +468,55 @@ wint_t url_fgetwc( URL_FILE * input ) {
break; break;
case CFTYPE_CURL:{ case CFTYPE_CURL:{
debug_print( L"url_fgetwc: stream is URL\n", DEBUG_IO );
char *cbuff =
calloc( sizeof( wchar_t ) + 1, sizeof( char ) );
wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) ); wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) );
mbstowcs( wbuff, (char *)&input->buffer[input->buffer_pos], 1 ); size_t count = 0;
debug_print( L"url_fgetwc: about to call url_fgets\n", DEBUG_IO );
url_fgets( cbuff, 1, input );
debug_print( L"url_fgetwc: back from url_fgets\n", DEBUG_IO );
int c = ( int ) cbuff[0];
debug_printf( DEBUG_IO, L"url_fgetwc: (first) character = %d (%c)\n", c, c & 0xf7 );
/* The value of each individual byte indicates its UTF-8 function, as follows:
*
* 00 to 7F hex (0 to 127): first and only byte of a sequence.
* 80 to BF hex (128 to 191): continuing byte in a multi-byte sequence.
* C2 to DF hex (194 to 223): first byte of a two-byte sequence.
* E0 to EF hex (224 to 239): first byte of a three-byte sequence.
* F0 to FF hex (240 to 255): first byte of a four-byte sequence.
*/
if ( c <= 0x07 ) {
count = 1;
} else if ( c >= '0xc2' && c <= '0xdf' ) {
count = 2;
} else if ( c >= '0xe0' && c <= '0xef' ) {
count = 3;
} else if ( c >= '0xf0' && c <= '0xff' ) {
count = 4;
}
if ( count > 1 ) {
url_fgets( cbuff, --count, input );
}
mbstowcs( wbuff, cbuff, 1 ); //(char *)(&input->buffer[input->buffer_pos]), 1 );
result = wbuff[0]; result = wbuff[0];
use_one_wide( input ); use_one_wide( input );
free( wbuff ); free( wbuff );
free( cbuff );
} }
break; break;
case CFTYPE_NONE: case CFTYPE_NONE:
break; break;
} }
}
debug_printf( DEBUG_IO, L"url_fgetwc returning %d (%C)\n", result, result); debug_printf( DEBUG_IO, L"url_fgetwc returning %d (%C)\n", result,
result );
return result; return result;
} }
@ -486,18 +530,19 @@ wint_t url_ungetwc( wint_t wc, URL_FILE * input ) {
break; break;
case CFTYPE_CURL:{ case CFTYPE_CURL:{
wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) ); ungotten = wc;
char *cbuff = calloc( 5, sizeof( char ) ); // wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) );
// char *cbuff = calloc( 5, sizeof( char ) );
wbuff[0] = wc; //
result = wcstombs( cbuff, wbuff, 1 ); // wbuff[0] = wc;
// result = wcstombs( cbuff, wbuff, 1 );
input->buffer_pos -= strlen( cbuff ); //
// input->buffer_pos -= strlen( cbuff );
free( cbuff ); //
free( wbuff ); // free( cbuff );
// free( wbuff );
result = result > 0 ? wc : result; //
// result = result > 0 ? wc : result;
break; break;
case CFTYPE_NONE: case CFTYPE_NONE:
break; break;

26
src/io/io.c
View file

@ -49,9 +49,9 @@ char *lisp_string_to_c_string( struct cons_pointer s ) {
free( buffer ); free( buffer );
} }
debug_print(L"lisp_string_to_c_string( ", DEBUG_IO); debug_print( L"lisp_string_to_c_string( ", DEBUG_IO );
debug_print_object( s, DEBUG_IO); debug_print_object( s, DEBUG_IO );
debug_printf( DEBUG_IO, L") => '%s'\n", result); debug_printf( DEBUG_IO, L") => '%s'\n", result );
return result; return result;
} }
@ -115,7 +115,7 @@ lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
free( url ); free( url );
if ( pointer2cell(result).payload.stream.stream == NULL) { if ( pointer2cell( result ).payload.stream.stream == NULL ) {
result = NIL; result = NIL;
} }
} }
@ -169,19 +169,19 @@ lisp_slurp( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) { if ( readp( frame->arg[0] ) ) {
URL_FILE *stream = pointer2cell( frame->arg[0] ).payload.stream.stream; URL_FILE *stream = pointer2cell( frame->arg[0] ).payload.stream.stream;
struct cons_pointer cursor = make_string( url_fgetwc( stream ), NIL); struct cons_pointer cursor = make_string( url_fgetwc( stream ), NIL );
result = cursor; result = cursor;
for ( wint_t c = url_fgetwc( stream ); !url_feof(stream); for ( wint_t c = url_fgetwc( stream ); !url_feof( stream );
c = url_fgetwc( stream ) ) { c = url_fgetwc( stream ) ) {
debug_print(L"slurp: cursor is: ", DEBUG_IO); debug_print( L"slurp: cursor is: ", DEBUG_IO );
debug_dump_object( cursor, DEBUG_IO); debug_dump_object( cursor, DEBUG_IO );
debug_print(L"; result is: ", DEBUG_IO); debug_print( L"; result is: ", DEBUG_IO );
debug_dump_object( result, DEBUG_IO); debug_dump_object( result, DEBUG_IO );
debug_println( DEBUG_IO); debug_println( DEBUG_IO );
struct cons_space_object * cell = &pointer2cell(cursor); struct cons_space_object *cell = &pointer2cell( cursor );
cursor = make_string( ( wchar_t ) c , NIL); cursor = make_string( ( wchar_t ) c, NIL );
cell->payload.string.cdr = cursor; cell->payload.string.cdr = cursor;
} }
} }