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

EVAL on arithmetic operations still not working

Browse source
This commit is contained in:
simon 2017-10-06 18:27:01 +01:00
parent 832ae3be0d
commit 0e224e551b
4 changed files with 22 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/conspage.c
View file

@ -149,6 +149,7 @@ void free_cell( struct cons_pointer pointer ) {
struct cons_pointer allocate_cell( char *tag ) { struct cons_pointer allocate_cell( char *tag ) {
struct cons_pointer result = freelist; struct cons_pointer result = freelist;
if ( result.page == NIL.page && result.offset == NIL.offset ) { if ( result.page == NIL.page && result.offset == NIL.offset ) {
make_cons_page( ); make_cons_page( );
result = allocate_cell( tag ); result = allocate_cell( tag );

28
src/consspaceobject.c
View file

@ -77,40 +77,44 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
fwprintf( output, fwprintf( output,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d\n", L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n",
cell.payload.cons.car.page, cell.payload.cons.car.page,
cell.payload.cons.car.offset, cell.payload.cons.car.offset,
cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset,
cell.count);
break; break;
case INTEGERTV: case INTEGERTV:
fwprintf( output, fwprintf( output,
L"\t\tInteger cell: value %ld\n", L"\t\tInteger cell: value %ld, count %u\n",
cell.payload.integer.value ); cell.payload.integer.value, cell.count );
break; break;
case FREETV: case FREETV:
fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset );
break; break;
case REALTV: case REALTV:
fwprintf( output, L"\t\tReal cell: value %Lf\n", fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
cell.payload.real.value ); cell.payload.real.value, cell.count );
break; break;
case STRINGTV: case STRINGTV:
fwprintf( output, fwprintf( output,
L"\t\tString cell: character '%1c' (%1d) next at page %2d offset %3d\n", L"\t\tString cell: character '%1c' (%1d) next at page %2d offset %3d, count %u\n",
cell.payload.string.character, cell.payload.string.character,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset ); cell.payload.string.cdr.offset,
fwprintf( output, L"\t\t value:" ); cell.count );
fwprintf( output, L"\t\t value: " );
print( output, pointer ); print( output, pointer );
fwprintf( output, L"\n" ); fwprintf( output, L"\n" );
break; break;
case SYMBOLTV: case SYMBOLTV:
fwprintf( output, fwprintf( output,
L"\t\tSymbol cell: character '%1c' (%1d) next at page %2d offset %3d\n", L"\t\tSymbol cell: character '%1c' (%1d) next at page %2d offset %3d, count %u\n",
cell.payload.string.character, cell.payload.string.character,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset ); cell.payload.string.cdr.offset,
cell.count );
fwprintf( output, L"\t\t value:" ); fwprintf( output, L"\t\t value:" );
print( output, pointer ); print( output, pointer );
fwprintf( output, L"\n" ); fwprintf( output, L"\n" );
@ -204,7 +208,7 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) {
*/ */
struct cons_pointer struct cons_pointer
make_special( struct cons_pointer src, struct cons_pointer ( *executable ) make_special( struct cons_pointer src, struct cons_pointer ( *executable )
( struct struct stack_frame * frame, ( struct stack_frame * frame,
struct cons_pointer env ) ) { struct cons_pointer env ) ) {
struct cons_pointer pointer = allocate_cell( SPECIALTAG ); struct cons_pointer pointer = allocate_cell( SPECIALTAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );

5
src/consspaceobject.h
View file

@ -425,9 +425,8 @@ struct cons_pointer make_function( struct cons_pointer src,
*/ */
struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer make_special( struct cons_pointer src,
struct cons_pointer ( *executable ) struct cons_pointer ( *executable )
( struct cons_pointer s_expr, ( struct stack_frame *,
struct cons_pointer env, struct cons_pointer ) );
struct stack_frame * frame ) );
/** /**
* Construct a string from this character and this tail. A string is * Construct a string from this character and this tail. A string is

6
src/lispops.c
View file

@ -257,7 +257,7 @@ lisp_car( struct stack_frame *frame, struct cons_pointer env ) {
} else { } else {
struct cons_pointer message = struct cons_pointer message =
c_string_to_lisp_string c_string_to_lisp_string
( "Attempt to take CAR/CDR of non sequence" ); ( "Attempt to take CAR of non sequence" );
result = lisp_throw( message, frame ); result = lisp_throw( message, frame );
} }
@ -275,14 +275,14 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer env ) {
if ( consp( frame->arg[0] ) ) { if ( consp( frame->arg[0] ) ) {
struct cons_space_object cell = pointer2cell( frame->arg[0] ); struct cons_space_object cell = pointer2cell( frame->arg[0] );
result = cell.payload.cons.car; result = cell.payload.cons.cdr;
} else if ( stringp( frame->arg[0] ) ) { } else if ( stringp( frame->arg[0] ) ) {
struct cons_space_object cell = pointer2cell( frame->arg[0] ); struct cons_space_object cell = pointer2cell( frame->arg[0] );
result = cell.payload.string.cdr; result = cell.payload.string.cdr;
} else { } else {
struct cons_pointer message = struct cons_pointer message =
c_string_to_lisp_string c_string_to_lisp_string
( "Attempt to take CAR/CDR of non sequence" ); ( "Attempt to take CDR of non sequence" );
result = lisp_throw( message, frame ); result = lisp_throw( message, frame );
} }