From 3d5c27cb10df058363a2f37789fea170a75451ed Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 26 Dec 2018 21:10:24 +0000 Subject: [PATCH] Horribly broken, may have to rethink. --- src/arith/peano.c | 104 +++++++------ src/arith/peano.h | 14 +- src/arith/ratio.c | 69 ++++----- src/arith/ratio.h | 10 +- src/arith/real.c | 1 + src/memory/consspaceobject.c | 26 ++-- src/memory/consspaceobject.h | 8 +- src/memory/dump.c | 23 +-- src/memory/stack.c | 282 ++++++++++++++++++++--------------- src/memory/stack.h | 8 +- src/memory/vectorspace.c | 26 +++- src/memory/vectorspace.h | 2 +- src/ops/equal.c | 4 +- src/ops/lispops.c | 194 ++++++++++++++---------- src/ops/lispops.h | 68 ++++++--- src/ops/print.c | 10 +- src/ops/read.c | 56 ++++--- src/ops/read.h | 3 +- src/repl.c | 73 ++++----- 19 files changed, 568 insertions(+), 413 deletions(-) diff --git a/src/arith/peano.c b/src/arith/peano.c index 63783f5..763414e 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -28,7 +28,9 @@ long double to_long_double( struct cons_pointer arg ); int64_t to_long_int( struct cons_pointer arg ); -struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer arg1, +struct cons_pointer add_2( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer arg1, struct cons_pointer arg2 ); @@ -119,7 +121,9 @@ int64_t to_long_int( struct cons_pointer arg ) { * return a cons_pointer indicating a number which is the sum of * the numbers indicated by `arg1` and `arg2`. */ -struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer arg1, +struct cons_pointer add_2( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer result; struct cons_space_object cell1 = pointer2cell( arg1 ); @@ -153,7 +157,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_ cell2.payload.integer.value ); break; case RATIOTV: - result = add_integer_ratio( frame_pointer, arg1, arg2 ); + result = + add_integer_ratio( frame_pointer, arg1, arg2 ); break; case REALTV: result = @@ -162,8 +167,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_ break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot add: not a number" ), - frame_pointer ); + ( "Cannot add: not a number" ), + frame_pointer ); break; } break; @@ -173,7 +178,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_ result = arg2; break; case INTEGERTV: - result = add_integer_ratio( frame_pointer, arg2, arg1 ); + result = + add_integer_ratio( frame_pointer, arg2, arg1 ); break; case RATIOTV: result = add_ratio_ratio( frame_pointer, arg1, arg2 ); @@ -185,8 +191,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_ break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot add: not a number" ), - frame_pointer ); + ( "Cannot add: not a number" ), + frame_pointer ); break; } break; @@ -198,7 +204,8 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_ default: result = exceptionp( arg2 ) ? arg2 : throw_exception( c_string_to_lisp_string - ( "Cannot add: not a number" ), frame_pointer ); + ( "Cannot add: not a number" ), + frame_pointer ); } } @@ -252,7 +259,8 @@ struct cons_pointer lisp_add( struct stack_frame * return a cons_pointer indicating a number which is the product of * the numbers indicated by `arg1` and `arg2`. */ -struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer multiply_2( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer result; @@ -286,7 +294,9 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f cell2.payload.integer.value ); break; case RATIOTV: - result = multiply_integer_ratio( frame_pointer, arg1, arg2 ); + result = + multiply_integer_ratio( frame_pointer, arg1, + arg2 ); break; case REALTV: result = @@ -295,8 +305,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), - frame_pointer ); + ( "Cannot multiply: not a number" ), + frame_pointer ); break; } break; @@ -306,10 +316,13 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f result = arg2; break; case INTEGERTV: - result = multiply_integer_ratio( frame_pointer, arg2, arg1 ); + result = + multiply_integer_ratio( frame_pointer, arg2, + arg1 ); break; case RATIOTV: - result = multiply_ratio_ratio( frame_pointer, arg1, arg2 ); + result = + multiply_ratio_ratio( frame_pointer, arg1, arg2 ); break; case REALTV: result = @@ -318,8 +331,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), - frame_pointer ); + ( "Cannot multiply: not a number" ), + frame_pointer ); } break; case REALTV: @@ -329,8 +342,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_pointer f break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot multiply: not a number" ), - frame_pointer ); + ( "Cannot multiply: not a number" ), + frame_pointer ); break; } } @@ -406,8 +419,8 @@ struct cons_pointer inverse( struct cons_pointer frame, case RATIOTV: result = make_ratio( frame, make_integer( 0 - - to_long_int( cell.payload.ratio. - dividend ) ), + to_long_int( cell.payload. + ratio.dividend ) ), cell.payload.ratio.divisor ); break; case REALTV: @@ -453,9 +466,10 @@ struct cons_pointer lisp_subtract( struct struct cons_pointer tmp = make_ratio( frame_pointer, frame->arg[0], make_integer( 1 ) ); - inc_ref(tmp); + inc_ref( tmp ); result = - subtract_ratio_ratio( frame_pointer, tmp, frame->arg[1] ); + subtract_ratio_ratio( frame_pointer, tmp, + frame->arg[1] ); dec_ref( tmp ); } break; @@ -466,8 +480,8 @@ struct cons_pointer lisp_subtract( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot subtract: not a number" ), - frame_pointer ); + ( "Cannot subtract: not a number" ), + frame_pointer ); break; } break; @@ -480,9 +494,10 @@ struct cons_pointer lisp_subtract( struct struct cons_pointer tmp = make_ratio( frame_pointer, frame->arg[1], make_integer( 1 ) ); - inc_ref(tmp); + inc_ref( tmp ); result = - subtract_ratio_ratio( frame_pointer, frame->arg[0], tmp ); + subtract_ratio_ratio( frame_pointer, frame->arg[0], + tmp ); dec_ref( tmp ); } break; @@ -498,8 +513,8 @@ struct cons_pointer lisp_subtract( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot subtract: not a number" ), - frame_pointer ); + ( "Cannot subtract: not a number" ), + frame_pointer ); break; } break; @@ -510,7 +525,8 @@ struct cons_pointer lisp_subtract( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot subtract: not a number" ), frame_pointer ); + ( "Cannot subtract: not a number" ), + frame_pointer ); break; } @@ -527,7 +543,7 @@ struct cons_pointer lisp_subtract( struct */ struct cons_pointer lisp_divide( struct stack_frame - *frame, struct cons_pointer frame_pointer, struct + *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; struct cons_space_object arg0 = pointer2cell( frame->arg[0] ); @@ -544,7 +560,8 @@ struct cons_pointer lisp_divide( struct break; case INTEGERTV:{ struct cons_pointer unsimplified = - make_ratio( frame_pointer, frame->arg[0], frame->arg[1] ); + make_ratio( frame_pointer, frame->arg[0], + frame->arg[1] ); /* OK, if result may be unsimplified, we should not inc_ref it * - but if not, we should dec_ref it. */ result = simplify_ratio( frame_pointer, unsimplified ); @@ -558,7 +575,8 @@ struct cons_pointer lisp_divide( struct struct cons_pointer ratio = make_ratio( frame_pointer, frame->arg[0], one ); result = - divide_ratio_ratio( frame_pointer, ratio, frame->arg[1] ); + divide_ratio_ratio( frame_pointer, ratio, + frame->arg[1] ); dec_ref( ratio ); } break; @@ -569,8 +587,8 @@ struct cons_pointer lisp_divide( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot divide: not a number" ), - frame_pointer ); + ( "Cannot divide: not a number" ), + frame_pointer ); break; } break; @@ -581,14 +599,15 @@ struct cons_pointer lisp_divide( struct break; case INTEGERTV:{ struct cons_pointer one = make_integer( 1 ); - inc_ref( one); + inc_ref( one ); struct cons_pointer ratio = make_ratio( frame_pointer, frame->arg[1], one ); - inc_ref(ratio); + inc_ref( ratio ); result = - divide_ratio_ratio( frame_pointer, frame->arg[0], ratio ); + divide_ratio_ratio( frame_pointer, frame->arg[0], + ratio ); dec_ref( ratio ); - dec_ref(one); + dec_ref( one ); } break; case RATIOTV: @@ -603,8 +622,8 @@ struct cons_pointer lisp_divide( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot divide: not a number" ), - frame_pointer ); + ( "Cannot divide: not a number" ), + frame_pointer ); break; } break; @@ -615,7 +634,8 @@ struct cons_pointer lisp_divide( struct break; default: result = throw_exception( c_string_to_lisp_string - ( "Cannot divide: not a number" ), frame_pointer ); + ( "Cannot divide: not a number" ), + frame_pointer ); break; } diff --git a/src/arith/peano.h b/src/arith/peano.h index 46008c2..f1c21b4 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -23,7 +23,8 @@ extern "C" { * @return a pointer to an integer or real. */ struct cons_pointer - lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Multiply an indefinite number of numbers together @@ -32,7 +33,9 @@ extern "C" { * @return a pointer to an integer or real. */ struct cons_pointer - lisp_multiply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + lisp_multiply( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Subtract one number from another. @@ -41,7 +44,9 @@ extern "C" { * @return a pointer to an integer or real. */ struct cons_pointer - lisp_subtract( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + lisp_subtract( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Divide one number by another. @@ -50,7 +55,8 @@ extern "C" { * @return a pointer to an integer or real. */ struct cons_pointer - lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); #ifdef __cplusplus } diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 042aea1..afea5b0 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -61,10 +61,10 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, if ( ratiop( arg ) ) { int64_t ddrv = - pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload. - integer.value, drrv = - pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload. - integer.value, gcd = greatest_common_divisor( ddrv, drrv ); + pointer2cell( pointer2cell( arg ).payload.ratio.dividend ). + payload.integer.value, drrv = + pointer2cell( pointer2cell( arg ).payload.ratio.divisor ). + payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv ); if ( gcd > 1 ) { if ( drrv / gcd == 1 ) { @@ -78,8 +78,8 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, } else { result = throw_exception( make_cons( c_string_to_lisp_string - ( "Shouldn't happen: bad arg to simplify_ratio" ), - arg ), frame_pointer ); + ( "Shouldn't happen: bad arg to simplify_ratio" ), + arg ), frame_pointer ); } return result; @@ -124,7 +124,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, #endif if ( dr1v == dr2v ) { - r = make_ratio( frame_pointer, + r = make_ratio( frame_pointer, make_integer( dd1v + dd2v ), cell1.payload.ratio.divisor ); } else { @@ -132,8 +132,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, dr1vm = make_integer( dr1v * m1 ), dd2vm = make_integer( dd2v * m2 ), dr2vm = make_integer( dr2v * m2 ), - r1 = make_ratio( frame_pointer, dd1vm, dr1vm ), - r2 = make_ratio( frame_pointer, dd2vm, dr2vm ); + r1 = make_ratio( frame_pointer, dd1vm, dr1vm ), + r2 = make_ratio( frame_pointer, dd2vm, dr2vm ); r = add_ratio_ratio( frame_pointer, r1, r2 ); @@ -144,17 +144,17 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, dec_ref( r2 ); } - result = simplify_ratio( frame_pointer, r ); + result = simplify_ratio( frame_pointer, r ); if ( !eq( r, result ) ) { dec_ref( r ); } } else { result = throw_exception( make_cons( c_string_to_lisp_string - ( "Shouldn't happen: bad arg to add_ratio_ratio" ), - make_cons( arg1, - make_cons( arg2, NIL ) ) ), - frame_pointer ); + ( "Shouldn't happen: bad arg to add_ratio_ratio" ), + make_cons( arg1, + make_cons( arg2, NIL ) ) ), + frame_pointer ); } #ifdef DEBUG @@ -181,17 +181,18 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer one = make_integer( 1 ), ratio = make_ratio( frame_pointer, intarg, one ); - result = add_ratio_ratio( frame_pointer, ratio, ratarg ); + result = add_ratio_ratio( frame_pointer, ratio, ratarg ); dec_ref( one ); dec_ref( ratio ); } else { result = throw_exception( make_cons( c_string_to_lisp_string - ( "Shouldn't happen: bad arg to add_integer_ratio" ), - make_cons( intarg, - make_cons( ratarg, NIL ) ) ), - frame_pointer ); + ( "Shouldn't happen: bad arg to add_integer_ratio" ), + make_cons( intarg, + make_cons( ratarg, + NIL ) ) ), + frame_pointer ); } return result; @@ -205,12 +206,12 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ) { - struct cons_pointer i = make_ratio( frame_pointer, - pointer2cell( arg2 ).payload.ratio. - divisor, - pointer2cell( arg2 ).payload.ratio. - dividend ), result = - multiply_ratio_ratio( frame_pointer, arg1, i ); + struct cons_pointer i = make_ratio( frame_pointer, + pointer2cell( arg2 ).payload. + ratio.divisor, + pointer2cell( arg2 ).payload. + ratio.dividend ), result = + multiply_ratio_ratio( frame_pointer, arg1, i ); dec_ref( i ); @@ -248,7 +249,7 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str ddrv = dd1v * dd2v, drrv = dr1v * dr2v; struct cons_pointer unsimplified = - make_ratio( frame_pointer, make_integer( ddrv ), + make_ratio( frame_pointer, make_integer( ddrv ), make_integer( drrv ) ); result = simplify_ratio( frame_pointer, unsimplified ); @@ -258,8 +259,8 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str } else { result = throw_exception( c_string_to_lisp_string - ( "Shouldn't happen: bad arg to multiply_ratio_ratio" ), - frame_pointer ); + ( "Shouldn't happen: bad arg to multiply_ratio_ratio" ), + frame_pointer ); } return result; @@ -278,15 +279,15 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, if ( integerp( intarg ) && ratiop( ratarg ) ) { struct cons_pointer one = make_integer( 1 ), ratio = make_ratio( frame_pointer, intarg, one ); - result = multiply_ratio_ratio( frame_pointer, ratio, ratarg ); + result = multiply_ratio_ratio( frame_pointer, ratio, ratarg ); dec_ref( one ); dec_ref( ratio ); } else { result = throw_exception( c_string_to_lisp_string - ( "Shouldn't happen: bad arg to multiply_integer_ratio" ), - frame_pointer ); + ( "Shouldn't happen: bad arg to multiply_integer_ratio" ), + frame_pointer ); } return result; @@ -302,7 +303,7 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer i = inverse( frame_pointer, arg2 ), - result = add_ratio_ratio( frame_pointer, arg1, i ); + result = add_ratio_ratio( frame_pointer, arg1, i ); dec_ref( i ); @@ -328,8 +329,8 @@ struct cons_pointer make_ratio( struct cons_pointer frame_pointer, } else { result = throw_exception( c_string_to_lisp_string - ( "Dividend and divisor of a ratio must be integers" ), - frame_pointer ); + ( "Dividend and divisor of a ratio must be integers" ), + frame_pointer ); } #ifdef DEBUG dump_object( stderr, result ); diff --git a/src/arith/ratio.h b/src/arith/ratio.h index feb8925..5a3b0d6 100644 --- a/src/arith/ratio.h +++ b/src/arith/ratio.h @@ -14,15 +14,15 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg ); -struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, +struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, +struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer intarg, struct cons_pointer ratarg ); -struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, +struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ); @@ -30,11 +30,11 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, +struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer intarg, struct cons_pointer ratarg ); -struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, +struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ); diff --git a/src/arith/real.c b/src/arith/real.c index a499b6a..d3786dd 100644 --- a/src/arith/real.c +++ b/src/arith/real.c @@ -9,6 +9,7 @@ #include "conspage.h" #include "consspaceobject.h" +#include "dump.h" #include "read.h" /** diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 75a5257..acca2a8 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -89,21 +89,21 @@ struct cons_pointer make_cons( struct cons_pointer car, * @param frame_pointer should be the pointer to the frame in which the exception occurred. */ struct cons_pointer make_exception( struct cons_pointer message, - struct cons_pointer frame_pointer ) { - struct cons_pointer result = NIL; - struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer frame_pointer ) { + struct cons_pointer result = NIL; + struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ + inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ - inc_ref( message ); - inc_ref( frame_pointer); - cell->payload.exception.message = message; - cell->payload.exception.frame = frame_pointer; + inc_ref( message ); + inc_ref( frame_pointer ); + cell->payload.exception.message = message; + cell->payload.exception.frame = frame_pointer; - result = pointer; + result = pointer; - return result; + return result; } @@ -113,7 +113,7 @@ struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer make_function( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, - struct cons_pointer, struct cons_pointer ) ) { + struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer pointer = allocate_cell( FUNCTIONTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); @@ -212,7 +212,7 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) { struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame * frame, - struct cons_pointer, struct cons_pointer env ) ) { + struct cons_pointer, struct cons_pointer env ) ) { struct cons_pointer pointer = allocate_cell( SPECIALTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index b31a0bf..44b6a79 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -421,10 +421,10 @@ struct vectorp_payload { * tag. */ uint32_t value; /* the tag considered as a number */ } tag; - struct vector_space_object * address; - /* the address of the actual vector space - * object (TODO: will change when I actually - * implement vector space) */ + struct vector_space_object *address; + /* the address of the actual vector space + * object (TODO: will change when I actually + * implement vector space) */ }; /** diff --git a/src/memory/dump.c b/src/memory/dump.c index 5306801..5aaedfb 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -72,7 +72,7 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { break; case EXCEPTIONTV: fwprintf( output, L"\t\tException cell: " ); - dump_stack_trace( output, pointer); + dump_stack_trace( output, pointer ); break; case FREETV: fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", @@ -93,10 +93,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { case RATIOTV: fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ).payload. - integer.value, - pointer2cell( cell.payload.ratio.divisor ).payload. - integer.value, cell.count ); + pointer2cell( cell.payload.ratio.dividend ). + payload.integer.value, + pointer2cell( cell.payload.ratio.divisor ). + payload.integer.value, cell.count ); break; case READTV: fwprintf( output, L"\t\tInput stream\n" ); @@ -110,11 +110,12 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { case SYMBOLTV: dump_string_cell( output, L"Symbol", pointer ); break; - case VECTORPOINTTV: { - struct vector_space_object * vso = cell.payload.vectorp.address; - fwprintf( output, L"\t\tVector space object of type %4.4s, payload size %d bytes\n", - vso->header.tag, vso->header.size); - } - break; + case VECTORPOINTTV:{ + struct vector_space_object *vso = cell.payload.vectorp.address; + fwprintf( output, + L"\t\tVector space object of type %4.4s, payload size %d bytes\n", + vso->header.tag, vso->header.size ); + } + break; } } diff --git a/src/memory/stack.c b/src/memory/stack.c index 8fe268e..9f0f6f8 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -28,17 +28,26 @@ * get the actual stackframe object from this `pointer`, or NULL if * `pointer` is not a stackframe pointer. */ -struct stack_frame * get_stack_frame(struct cons_pointer pointer) { - struct stack_frame * result = NULL; - struct vector_space_object * vso = - pointer2cell(pointer).payload.vectorp.address; +struct stack_frame *get_stack_frame( struct cons_pointer pointer ) { + struct stack_frame *result = NULL; + fputws + ( L"get_stack_frame: about to get a pointer to the vector space object\n", + stderr ); + struct vector_space_object *vso = + pointer2cell( pointer ).payload.vectorp.address; + fputws( L"get_stack_frame: got a pointer, about to test it\n", stderr ); - if (vectorpointp(pointer) && stackframep(vso)) - { - result = (struct stack_frame *) &(vso->payload); - } + if ( vectorpointp( pointer ) ) { // && stackframep(vso)){ + fputws( L"get_stack_frame: pointer is good, about to set the result\n", + stderr ); - return result; + result = ( struct stack_frame * ) &( vso->payload ); + fputws( L"get_stack_frame: all good, returning\n", stderr ); + } else { + fputws( L"get_stack_frame: fail, returning NULL\n", stderr ); + } + + return result; } /** @@ -48,28 +57,38 @@ struct stack_frame * get_stack_frame(struct cons_pointer pointer) { * @return the new frame, or NULL if memory is exhausted. */ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { - struct cons_pointer result = make_vso(STACKFRAMETAG, sizeof(struct stack_frame)); - if (!nilp(result)) { - struct stack_frame *frame = get_stack_frame(result); - /* - * TODO: later, pop a frame off a free-list of stack frames - */ + fputws( L"Entering make_empty_frame\n", stderr ); + struct cons_pointer result = + make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) ); + if ( !nilp( result ) ) { + fputws( L"make_empty_frame: about to call get_stack_frame\n", stderr ); + struct stack_frame *frame = get_stack_frame( result ); + /* + * TODO: later, pop a frame off a free-list of stack frames + */ - frame->previous = previous; - inc_ref(previous); + fwprintf( stderr, + L"make_empty_frame: about to set previous to %4.4s\n", + pointer2cell( previous ).tag ); + frame->previous = previous; + fputws( L"make_empty_frame: about to call inc_ref\n", stderr ); + inc_ref( previous ); - /* - * clearing the frame with memset would probably be slightly quicker, but - * this is clear. - */ - frame->more = NIL; - frame->function = NIL; - frame->args = 0; + /* + * clearing the frame with memset would probably be slightly quicker, but + * this is clear. + */ + frame->more = NIL; + frame->function = NIL; + frame->args = 0; - for ( int i = 0; i < args_in_frame; i++ ) { - set_reg( frame, i, NIL ); + fputws( L"make_empty_frame: about to initialise arg registers\n", + stderr ); + for ( int i = 0; i < args_in_frame; i++ ) { + set_reg( frame, i, NIL ); + } } - } + fputws( L"Leaving make_empty_frame\n", stderr ); return result; } @@ -83,67 +102,76 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { * @return the new frame, or an exception if one occurred while building it. */ struct cons_pointer make_stack_frame( struct cons_pointer previous, - struct cons_pointer args, - struct cons_pointer env ) { - struct cons_pointer result = make_empty_frame( previous ); + struct cons_pointer args, + struct cons_pointer env ) { + fputws( L"Entering make_stack_frame\n", stderr ); + struct cons_pointer result = make_empty_frame( previous ); - if (nilp(result)) - { - /* i.e. out of memory */ - result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous); - } else { - struct stack_frame * frame = get_stack_frame(result); + if ( nilp( result ) ) { + /* i.e. out of memory */ + result = + make_exception( c_string_to_lisp_string( "Memory exhausted." ), + previous ); + } else { + struct stack_frame *frame = get_stack_frame( result ); - for ( frame->args = 0; frame->args < args_in_frame && consp( args ); frame->args++ ) { - /* iterate down the arg list filling in the arg slots in the - * frame. When there are no more slots, if there are still args, - * stash them on more */ - struct cons_space_object cell = pointer2cell( args ); + for ( frame->args = 0; frame->args < args_in_frame && consp( args ); + frame->args++ ) { + /* iterate down the arg list filling in the arg slots in the + * frame. When there are no more slots, if there are still args, + * stash them on more */ + struct cons_space_object cell = pointer2cell( args ); - /* - * TODO: if we were running on real massively parallel hardware, - * each arg except the first should be handed off to another - * processor to be evaled in parallel; but see notes here: - * https://github.com/simon-brooke/post-scarcity/wiki/parallelism - */ - struct cons_pointer arg_frame_pointer = make_empty_frame( result); - inc_ref(arg_frame_pointer); + /* + * TODO: if we were running on real massively parallel hardware, + * each arg except the first should be handed off to another + * processor to be evaled in parallel; but see notes here: + * https://github.com/simon-brooke/post-scarcity/wiki/parallelism + */ + struct cons_pointer arg_frame_pointer = make_empty_frame( result ); + inc_ref( arg_frame_pointer ); - if(nilp(arg_frame_pointer)) { - result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous); - break; - } else { - struct stack_frame *arg_frame = get_stack_frame( arg_frame_pointer ); - set_reg( arg_frame, 0, cell.payload.cons.car ); + if ( nilp( arg_frame_pointer ) ) { + result = + make_exception( c_string_to_lisp_string + ( "Memory exhausted." ), previous ); + break; + } else { + struct stack_frame *arg_frame = + get_stack_frame( arg_frame_pointer ); + set_reg( arg_frame, 0, cell.payload.cons.car ); - struct cons_pointer val = lisp_eval( arg_frame, arg_frame_pointer, env ); - if ( exceptionp( val ) ) { - result = val; - break; - } else { - set_reg( frame, frame->args, val ); + struct cons_pointer val = + lisp_eval( arg_frame, arg_frame_pointer, env ); + if ( exceptionp( val ) ) { + result = val; + break; + } else { + set_reg( frame, frame->args, val ); + } + + dec_ref( arg_frame_pointer ); + + args = cell.payload.cons.cdr; + } } - - dec_ref(arg_frame_pointer); - - args = cell.payload.cons.cdr; - } - } - if (!exceptionp(result)) { - if ( consp( args ) ) { - /* if we still have args, eval them and stick the values on `more` */ - struct cons_pointer more = eval_forms( get_stack_frame(previous), previous, args, env ); - frame->more = more; - inc_ref( more ); - } - + if ( !exceptionp( result ) ) { + if ( consp( args ) ) { + /* if we still have args, eval them and stick the values on `more` */ + struct cons_pointer more = + eval_forms( get_stack_frame( previous ), previous, args, + env ); + frame->more = more; + inc_ref( more ); + } #ifdef DEBUG - dump_frame( stderr, result ); + dump_frame( stderr, result ); #endif + } } - } + fputws( L"Leaving make_stack_frame\n", stderr ); - return result; + return result; } /** @@ -157,36 +185,40 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, struct cons_pointer make_special_frame( struct cons_pointer previous, struct cons_pointer args, struct cons_pointer env ) { - struct cons_pointer result = make_empty_frame( previous ); + fputws( L"Entering make_special_frame\n", stderr ); - if (nilp(result)) - { - /* i.e. out of memory */ - result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous); - } else { - struct stack_frame * frame = get_stack_frame(result); + struct cons_pointer result = make_empty_frame( previous ); - for ( frame->args = 0; frame->args < args_in_frame && !nilp( args ); frame->args++ ) { - /* iterate down the arg list filling in the arg slots in the - * frame. When there are no more slots, if there are still args, - * stash them on more */ - struct cons_space_object cell = pointer2cell( args ); + if ( nilp( result ) ) { + /* i.e. out of memory */ + result = + make_exception( c_string_to_lisp_string( "Memory exhausted." ), + previous ); + } else { + struct stack_frame *frame = get_stack_frame( result ); - set_reg( frame, frame->args, cell.payload.cons.car ); + for ( frame->args = 0; frame->args < args_in_frame && !nilp( args ); + frame->args++ ) { + /* iterate down the arg list filling in the arg slots in the + * frame. When there are no more slots, if there are still args, + * stash them on more */ + struct cons_space_object cell = pointer2cell( args ); - args = cell.payload.cons.cdr; - } - if (!exceptionp(result)) { - if ( consp( args ) ) { - frame->more = args; - inc_ref( args ); - } + set_reg( frame, frame->args, cell.payload.cons.car ); + args = cell.payload.cons.cdr; + } + if ( !exceptionp( result ) ) { + if ( consp( args ) ) { + frame->more = args; + inc_ref( args ); + } #ifdef DEBUG - dump_frame( stderr, result ); + dump_frame( stderr, result ); #endif + } } - } + fputws( L"Leaving make_special_frame\n", stderr ); return result; } @@ -215,37 +247,39 @@ void free_stack_frame( struct stack_frame *frame ) { * @param frame_pointer the pointer to the frame */ void dump_frame( FILE * output, struct cons_pointer frame_pointer ) { - struct stack_frame *frame = get_stack_frame(frame_pointer); + struct stack_frame *frame = get_stack_frame( frame_pointer ); - if (frame != NULL) { - for ( int arg = 0; arg < frame->args; arg++ ) { - struct cons_space_object cell = pointer2cell( frame->arg[arg] ); + if ( frame != NULL ) { + for ( int arg = 0; arg < frame->args; arg++ ) { + struct cons_space_object cell = pointer2cell( frame->arg[arg] ); - fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ", arg, - cell.tag.bytes[0], - cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3], - cell.count ); + fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ", arg, + cell.tag.bytes[0], + cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3], + cell.count ); - print( output, frame->arg[arg] ); - fputws( L"\n", output ); + print( output, frame->arg[arg] ); + fputws( L"\n", output ); + } + fputws( L"More: \t", output ); + print( output, frame->more ); + fputws( L"\n", output ); } - fputws( L"More: \t", output ); - print( output, frame->more ); - fputws( L"\n", output ); - } } -void dump_stack_trace(FILE * output, struct cons_pointer pointer) { - if (exceptionp(pointer)) { - print( output, pointer2cell(pointer).payload.exception.message ); - fwprintf( output, L"\n" ); - dump_stack_trace(output, pointer2cell(pointer).payload.exception.frame); - } else { - while (vectorpointp(pointer) && stackframep(pointer_to_vso(pointer))) { - dump_frame( output, pointer); - pointer = get_stack_frame(pointer)->previous; +void dump_stack_trace( FILE * output, struct cons_pointer pointer ) { + if ( exceptionp( pointer ) ) { + print( output, pointer2cell( pointer ).payload.exception.message ); + fwprintf( output, L"\n" ); + dump_stack_trace( output, + pointer2cell( pointer ).payload.exception.frame ); + } else { + while ( vectorpointp( pointer ) + && stackframep( pointer_to_vso( pointer ) ) ) { + dump_frame( output, pointer ); + pointer = get_stack_frame( pointer )->previous; + } } - } } /** diff --git a/src/memory/stack.h b/src/memory/stack.h index df76849..20acd73 100644 --- a/src/memory/stack.h +++ b/src/memory/stack.h @@ -41,19 +41,19 @@ */ #define set_reg(frame,register,value)frame->arg[register]=value; inc_ref(value) -struct stack_frame * get_stack_frame(struct cons_pointer pointer); +struct stack_frame *get_stack_frame( struct cons_pointer pointer ); struct cons_pointer make_empty_frame( struct cons_pointer previous ); struct cons_pointer make_stack_frame( struct cons_pointer previous, - struct cons_pointer args, - struct cons_pointer env ); + struct cons_pointer args, + struct cons_pointer env ); void free_stack_frame( struct stack_frame *frame ); void dump_frame( FILE * output, struct cons_pointer pointer ); -void dump_stack_trace(FILE * output, struct cons_pointer frame_pointer); +void dump_stack_trace( FILE * output, struct cons_pointer frame_pointer ); struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n ); diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index c0b6f8d..db39b48 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -30,12 +30,19 @@ * NOTE that `tag` should be the vector-space tag of the particular type of * vector-space object, NOT `VECTORPOINTTAG`. */ -struct cons_pointer make_vec_pointer( char * tag, struct vector_space_object * address ) { +struct cons_pointer make_vec_pointer( char *tag, + struct vector_space_object *address ) { + fputws( L"Entered make_vec_pointer\n", stderr ); struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG ); struct cons_space_object cell = pointer2cell( pointer ); - + fwprintf( stderr, + L"make_vec_pointer: allocated cell, about to write tag '%s'\n", + tag ); strncpy( &cell.payload.vectorp.tag.bytes[0], tag, 4 ); + fputws( L"make_vec_pointer: tag written, about to set pointer address\n", + stderr ); cell.payload.vectorp.address = address; + fputws( L"make_vec_pointer: all good, returning\n", stderr ); return pointer; } @@ -48,15 +55,18 @@ struct cons_pointer make_vec_pointer( char * tag, struct vector_space_object * a * Returns NIL if the vector could not be allocated due to memory exhaustion. */ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { + fputws( L"Entered make_vso\n", stderr ); struct cons_pointer result = NIL; int64_t total_size = sizeof( struct vector_space_header ) + payload_size; /* Pad size to 64 bit words. This is intended to promote access efficiancy * on 64 bit machines but may just be voodoo coding */ - uint64_t padded = ceil((total_size * 8.0) / 8.0); + uint64_t padded = ceil( ( total_size * 8.0 ) / 8.0 ); + fputws( L"make_vso: about to malloc\n", stderr ); struct vector_space_object *vso = malloc( padded ); if ( vso != NULL ) { + fwprintf( stderr, L"make_vso: about to write tag '%s'\n", tag ); strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH ); vso->header.vecp = make_vec_pointer( tag, vso ); vso->header.size = payload_size; @@ -65,13 +75,15 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { fwprintf( stderr, L"Allocated vector-space object of type %4.4s, total size %ld, payload size %ld\n", tag, total_size, payload_size ); - if (padded != total_size){ - fwprintf(stderr, L"\t\tPadded from %d to %d\n", - total_size, padded); - } + if ( padded != total_size ) { + fwprintf( stderr, L"\t\tPadded from %d to %d\n", + total_size, padded ); + } #endif result = vso->header.vecp; } + fputws( L"make_vso: all good, returning\n", stderr ); + return result; } diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 83fa74c..caec968 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -61,7 +61,7 @@ struct vector_space_header { }; struct vector_space_object { - struct vector_space_header header; + struct vector_space_header header; char payload; /* we'll malloc `size` bytes for payload, * `payload` is just the first of these. * TODO: this is almost certainly not diff --git a/src/ops/equal.c b/src/ops/equal.c index ebb085e..0f0597c 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { && ( equal( cell_a->payload.string.cdr, cell_b->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr ) - && end_of_string( cell_b->payload.string. - cdr ) ) ); + && end_of_string( cell_b->payload. + string.cdr ) ) ); break; case INTEGERTV: result = diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 825222f..1e6712d 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -89,9 +89,9 @@ struct cons_pointer eval_form( struct stack_frame *parent, struct cons_pointer result = NIL; struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); - inc_ref( next_pointer); + inc_ref( next_pointer ); - struct stack_frame * next = get_stack_frame(next_pointer); + struct stack_frame *next = get_stack_frame( next_pointer ); set_reg( next, 0, form ); result = lisp_eval( next, next_pointer, env ); @@ -100,7 +100,7 @@ struct cons_pointer eval_form( struct stack_frame *parent, /* if we're returning an exception, we should NOT free the * stack frame. Corollary is, when we free an exception, we * should free all the frames it's holding on to. */ - dec_ref(next_pointer); + dec_ref( next_pointer ); } return result; @@ -111,13 +111,15 @@ struct cons_pointer eval_form( struct stack_frame *parent, * and this `env`, and return a list of their values. If the arg passed as * `list` is not in fact a list, return nil. */ -struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer eval_forms( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer list, struct cons_pointer env ) { - /* TODO: refactor. This runs up the C stack. */ + /* TODO: refactor. This runs up the C stack. */ return consp( list ) ? make_cons( eval_form( frame, frame_pointer, c_car( list ), env ), - eval_forms( frame, frame_pointer, c_cdr( list ), env ) ) : NIL; + eval_forms( frame, frame_pointer, c_cdr( list ), + env ) ) : NIL; } /** @@ -126,7 +128,8 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer f * (oblist) */ struct cons_pointer -lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return oblist; } @@ -159,7 +162,8 @@ struct cons_pointer compose_body( struct stack_frame *frame ) { * @param env the environment in which it is to be intepreted. */ struct cons_pointer -lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return make_lambda( frame->arg[0], compose_body( frame ) ); } @@ -170,7 +174,8 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struc * @param env the environment in which it is to be intepreted. */ struct cons_pointer -lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return make_nlambda( frame->arg[0], compose_body( frame ) ); } @@ -188,8 +193,8 @@ void log_binding( struct cons_pointer name, struct cons_pointer val ) { * Evaluate a lambda or nlambda expression. */ struct cons_pointer -eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { +eval_lambda( struct cons_space_object cell, struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; fwprintf( stderr, L"eval_lambda called\n" ); @@ -216,7 +221,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct co struct cons_pointer vals = frame->more; for ( int i = args_in_frame - 1; i >= 0; i-- ) { - struct cons_pointer val = eval_form( frame, frame_pointer, frame->arg[i], env ); + struct cons_pointer val = + eval_form( frame, frame_pointer, frame->arg[i], env ); if ( nilp( val ) && nilp( vals ) ) { /* nothing */ } else { @@ -248,23 +254,25 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct co * @return the result of evaluating the function with its arguments. */ struct cons_pointer -c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; - /* construct a child frame and within it evaluate the first argument - the - * argument in the function position. */ + /* construct a child frame and within it evaluate the first argument - the + * argument in the function position. */ struct cons_pointer fn_frame_pointer = make_empty_frame( frame_pointer ); - inc_ref( fn_frame_pointer); - struct stack_frame *fn_frame = get_stack_frame(fn_frame_pointer); + inc_ref( fn_frame_pointer ); + struct stack_frame *fn_frame = get_stack_frame( fn_frame_pointer ); set_reg( fn_frame, 0, c_car( frame->arg[0] ) ); - struct cons_pointer fn_pointer = lisp_eval( fn_frame, fn_frame_pointer, env ); + struct cons_pointer fn_pointer = + lisp_eval( fn_frame, fn_frame_pointer, env ); if ( !exceptionp( result ) ) { /* if we're returning an exception, we should NOT free the * stack frame. Corollary is, when we free an exception, we * should free all the frames it's holding on to. */ - dec_ref(fn_frame_pointer); + dec_ref( fn_frame_pointer ); } struct cons_space_object fn_cell = pointer2cell( fn_pointer ); @@ -280,14 +288,17 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co struct cons_pointer exep = NIL; struct cons_pointer next_pointer = make_stack_frame( frame_pointer, args, env ); - inc_ref(next_pointer); + inc_ref( next_pointer ); if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - struct stack_frame *next = get_stack_frame(next_pointer); + struct stack_frame *next = get_stack_frame( next_pointer ); - result = ( *fn_cell.payload.function.executable ) ( next, next_pointer, env ); - dec_ref(next_pointer); + result = + ( *fn_cell.payload.function.executable ) ( next, + next_pointer, + env ); + dec_ref( next_pointer ); } } break; @@ -296,48 +307,53 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co struct cons_pointer exep = NIL; struct cons_pointer next_pointer = make_stack_frame( frame_pointer, args, env ); - inc_ref(next_pointer); - if ( exceptionp( next_pointer ) ) { + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - struct stack_frame *next = get_stack_frame(next_pointer); - result = eval_lambda( fn_cell, next, next_pointer, env ); - if ( !exceptionp( result ) ) { - dec_ref(next_pointer); + struct stack_frame *next = get_stack_frame( next_pointer ); + result = eval_lambda( fn_cell, next, next_pointer, env ); + if ( !exceptionp( result ) ) { + dec_ref( next_pointer ); + } } - } } break; case NLAMBDATV: { struct cons_pointer next_pointer = - make_special_frame( frame_pointer, args, env ); - inc_ref(next_pointer); - if ( exceptionp( next_pointer ) ) { + make_special_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - struct stack_frame *next = get_stack_frame(frame_pointer); - result = eval_lambda( fn_cell, next, next_pointer, env ); - if ( !exceptionp( result ) ) { - dec_ref(next_pointer); + struct stack_frame *next = + get_stack_frame( frame_pointer ); + result = eval_lambda( fn_cell, next, next_pointer, env ); + if ( !exceptionp( result ) ) { + dec_ref( next_pointer ); + } } - } } break; case SPECIALTV: { struct cons_pointer next_pointer = - make_special_frame( frame_pointer, args, env ); - inc_ref(next_pointer); - if ( exceptionp( next_pointer ) ) { + make_special_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - struct stack_frame *next = get_stack_frame(frame_pointer); - result = ( *fn_cell.payload.special.executable ) ( next, next_pointer, env ); - if ( !exceptionp( result ) ) { - dec_ref(next_pointer); + struct stack_frame *next = + get_stack_frame( frame_pointer ); + result = + ( *fn_cell.payload.special.executable ) ( next, + next_pointer, + env ); + if ( !exceptionp( result ) ) { + dec_ref( next_pointer ); + } } - } } break; default: @@ -355,7 +371,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct co result = throw_exception( message, frame_pointer ); } } - dec_ref(fn_frame_pointer); + dec_ref( fn_frame_pointer ); return result; } @@ -393,7 +409,8 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { * If a special form, passes the cdr of s_expr to the special form as argument. */ struct cons_pointer -lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = frame->arg[0]; struct cons_space_object cell = pointer2cell( frame->arg[0] ); @@ -456,7 +473,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * the second argument */ struct cons_pointer -lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { #ifdef DEBUG fputws( L"Apply: ", stderr ); dump_frame( stderr, frame_pointer ); @@ -484,7 +502,8 @@ lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * this isn't at this stage checked) unevaluated. */ struct cons_pointer -lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return frame->arg[0]; } @@ -499,7 +518,8 @@ lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * the namespace in so doing. `namespace` defaults to the value of `oblist`. */ struct cons_pointer -lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; struct cons_pointer namespace = nilp( frame->arg[2] ) ? oblist : frame->arg[2]; @@ -512,7 +532,8 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c make_exception( make_cons ( c_string_to_lisp_string ( "The first argument to `set!` is not a symbol: " ), - make_cons( frame->arg[0], NIL ) ), frame_pointer ); + make_cons( frame->arg[0], NIL ) ), + frame_pointer ); } return result; @@ -529,13 +550,15 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c * the namespace in so doing. `namespace` defaults to the value of `oblist`. */ struct cons_pointer -lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; struct cons_pointer namespace = nilp( frame->arg[2] ) ? oblist : frame->arg[2]; if ( symbolp( frame->arg[0] ) ) { - struct cons_pointer val = eval_form( frame, frame_pointer, frame->arg[1], env ); + struct cons_pointer val = + eval_form( frame, frame_pointer, frame->arg[1], env ); deep_bind( frame->arg[0], val ); result = val; } else { @@ -543,7 +566,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s make_exception( make_cons ( c_string_to_lisp_string ( "The first argument to `set!` is not a symbol: " ), - make_cons( frame->arg[0], NIL ) ), frame_pointer ); + make_cons( frame->arg[0], NIL ) ), + frame_pointer ); } return result; @@ -558,7 +582,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s * otherwise returns a new cons cell. */ struct cons_pointer -lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer car = frame->arg[0]; struct cons_pointer cdr = frame->arg[1]; struct cons_pointer result; @@ -582,7 +607,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * strings, and TODO read streams and other things which can be considered as sequences. */ struct cons_pointer -lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; if ( consp( frame->arg[0] ) ) { @@ -606,7 +632,8 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c * strings, and TODO read streams and other things which can be considered as sequences. */ struct cons_pointer -lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; if ( consp( frame->arg[0] ) ) { @@ -629,7 +656,8 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct c * Returns the value associated with key in store, or NIL if not found. */ struct cons_pointer -lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return c_assoc( frame->arg[0], frame->arg[1] ); } @@ -637,7 +665,8 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * (eq a b) * Returns T if a and b are pointers to the same object, else NIL */ -struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_eq( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ) { return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } @@ -647,7 +676,8 @@ struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer fram * Returns T if a and b are pointers to structurally identical objects, else NIL */ struct cons_pointer -lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } @@ -658,7 +688,8 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * is a read stream, then read from that stream, else stdin. */ struct cons_pointer -lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { FILE *input = stdin; if ( readp( frame->arg[0] ) ) { @@ -698,7 +729,8 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) { * (reverse sequence) * Return a sequence like this sequence but with the members in the reverse order. */ -struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_reverse( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ) { return c_reverse( frame->arg[0] ); } @@ -711,9 +743,10 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer * is a write stream, then print to that stream, else stdout. */ struct cons_pointer -lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { #ifdef DEBUG - fputws(L"Entering print\n", stderr); + fputws( L"Entering print\n", stderr ); #endif struct cons_pointer result = NIL; FILE *output = stdout; @@ -741,7 +774,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * @return As a Lisp string, the tag of the object which is the argument. */ struct cons_pointer -lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { return c_type( frame->arg[0] ); } @@ -759,7 +793,8 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * argument. */ struct cons_pointer -lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer remaining = frame->more; struct cons_pointer result = NIL; @@ -786,7 +821,8 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * @return the value of the last form of the first successful clause. */ struct cons_pointer -lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { +lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { struct cons_pointer result = NIL; bool done = false; @@ -797,11 +833,14 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct if ( consp( clause_pointer ) ) { struct cons_space_object cell = pointer2cell( clause_pointer ); - result = eval_form( frame, frame_pointer, c_car( clause_pointer ), env ); + result = + eval_form( frame, frame_pointer, c_car( clause_pointer ), + env ); if ( !nilp( result ) ) { struct cons_pointer vals = - eval_forms( frame, frame_pointer,c_cdr( clause_pointer ), env ); + eval_forms( frame, frame_pointer, c_cdr( clause_pointer ), + env ); while ( consp( vals ) ) { result = c_car( vals ); @@ -814,8 +853,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct done = true; } else { result = throw_exception( c_string_to_lisp_string - ( "Arguments to `cond` must be lists" ), - frame_pointer); + ( "Arguments to `cond` must be lists" ), + frame_pointer ); } } /* TODO: if there are more than 8 clauses we need to continue into the @@ -835,7 +874,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * pointer to the frame in which the exception occurred. */ struct cons_pointer -throw_exception( struct cons_pointer message, struct cons_pointer frame_pointer ) { +throw_exception( struct cons_pointer message, + struct cons_pointer frame_pointer ) { fwprintf( stderr, L"\nERROR: " ); print( stderr, message ); struct cons_pointer result = NIL; @@ -861,7 +901,9 @@ throw_exception( struct cons_pointer message, struct cons_pointer frame_pointer * If `message` is itself an exception, returns that instead. */ struct cons_pointer -lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer message = frame->arg[0]; - return exceptionp(message) ? message : make_exception(message, frame->previous); +lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer message = frame->arg[0]; + return exceptionp( message ) ? message : make_exception( message, + frame->previous ); } diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 059255d..a1dee81 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -60,7 +60,8 @@ struct cons_pointer eval_form( struct stack_frame *parent, * and this `env`, and return a list of their values. If the arg passed as * `list` is not in fact a list, return nil. */ -struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer eval_forms( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer list, struct cons_pointer env ); @@ -68,19 +69,24 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer f /* * special forms */ -struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_eval( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_apply( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer -lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer -lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer -lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Construct an interpretable function. @@ -89,7 +95,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, s * @param lexpr the lambda expression to be interpreted; * @param env the environment in which it is to be intepreted. */ -struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_lambda( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); /** @@ -99,31 +106,42 @@ struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer * @param env the environment in which it is to be intepreted. */ struct cons_pointer -lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); -struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_quote( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); /* * functions */ -struct cons_pointer lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_cons( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_car( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_cdr( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_assoc( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_eq( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_equal( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_print( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_read( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer, +struct cons_pointer lisp_reverse( struct stack_frame *frame, + struct cons_pointer frame_pointer, struct cons_pointer env ); /** * Function: Get the Lisp type of the single argument. @@ -132,7 +150,8 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer * @return As a Lisp string, the tag of the object which is the argument. */ struct cons_pointer -lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); /** @@ -146,7 +165,8 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * argument. */ struct cons_pointer -lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Special form: conditional. Each arg is expected to be a list; if the first @@ -158,7 +178,8 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * @return the value of the last form of the first successful clause. */ struct cons_pointer -lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Throw an exception. @@ -167,7 +188,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct * real `throw_exception`, which does, will be needed. */ struct cons_pointer throw_exception( struct cons_pointer message, - struct cons_pointer frame_pointer ); + struct cons_pointer frame_pointer ); struct cons_pointer -lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); diff --git a/src/ops/print.c b/src/ops/print.c index 7efd59f..99cd7f3 100644 --- a/src/ops/print.c +++ b/src/ops/print.c @@ -119,7 +119,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { case EXCEPTIONTV: fwprintf( output, L"\n%sException: ", print_use_colours ? "\x1B[31m" : "" ); - dump_stack_trace(output, pointer); + dump_stack_trace( output, pointer ); break; case FUNCTIONTV: fwprintf( output, L"(Function)" ); @@ -133,8 +133,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { case LAMBDATV: print( output, make_cons( c_string_to_lisp_symbol( "lambda" ), make_cons( cell.payload.lambda.args, - cell.payload. - lambda.body ) ) ); + cell.payload.lambda. + body ) ) ); break; case NILTV: fwprintf( output, L"nil" ); @@ -142,8 +142,8 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { case NLAMBDATV: print( output, make_cons( c_string_to_lisp_symbol( "nlambda" ), make_cons( cell.payload.lambda.args, - cell.payload. - lambda.body ) ) ); + cell.payload.lambda. + body ) ) ); break; case RATIOTV: print( output, cell.payload.ratio.dividend ); diff --git a/src/ops/read.c b/src/ops/read.c index 1a09700..7d21dbe 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -34,10 +34,11 @@ */ struct cons_pointer read_number( struct stack_frame *frame, - struct cons_pointer frame_pointer, FILE * input, - wint_t initial, bool seen_period ); + struct cons_pointer frame_pointer, + FILE * input, wint_t initial, + bool seen_period ); struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, FILE * input, + struct cons_pointer frame_pointer, FILE * input, wint_t initial ); struct cons_pointer read_string( FILE * input, wint_t initial ); struct cons_pointer read_symbol( FILE * input, wint_t initial ); @@ -55,8 +56,9 @@ struct cons_pointer c_quote( struct cons_pointer arg ) { * treating this initial character as the first character of the object * representation. */ -struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_pointer frame_pointer, FILE * input, - wint_t initial ) { +struct cons_pointer read_continuation( struct stack_frame *frame, + struct cons_pointer frame_pointer, + FILE * input, wint_t initial ) { struct cons_pointer result = NIL; wint_t c; @@ -76,15 +78,18 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po break; case EOF: result = throw_exception( c_string_to_lisp_string - ( "End of input while reading" ), frame_pointer ); + ( "End of input while reading" ), + frame_pointer ); break; case '\'': result = c_quote( read_continuation - ( frame, frame_pointer, input, fgetwc( input ) ) ); + ( frame, frame_pointer, input, + fgetwc( input ) ) ); break; case '(': - result = read_list( frame, frame_pointer, input, fgetwc( input ) ); + result = + read_list( frame, frame_pointer, input, fgetwc( input ) ); break; case '"': result = read_string( input, fgetwc( input ) ); @@ -93,7 +98,9 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po wint_t next = fgetwc( input ); ungetwc( next, input ); if ( iswdigit( next ) ) { - result = read_number( frame, frame_pointer, input, c, false ); + result = + read_number( frame, frame_pointer, input, c, + false ); } else { result = read_symbol( input, c ); } @@ -104,12 +111,15 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po wint_t next = fgetwc( input ); if ( iswdigit( next ) ) { ungetwc( next, input ); - result = read_number( frame, frame_pointer, input, c, true ); + result = + read_number( frame, frame_pointer, input, c, + true ); } else if ( iswblank( next ) ) { /* dotted pair. TODO: this isn't right, we * really need to backtrack up a level. */ result = - read_continuation( frame, frame_pointer, input, fgetwc( input ) ); + read_continuation( frame, frame_pointer, input, + fgetwc( input ) ); } else { read_symbol( input, c ); } @@ -117,7 +127,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po break; default: if ( iswdigit( c ) ) { - result = read_number( frame, frame_pointer, input, c, false ); + result = + read_number( frame, frame_pointer, input, c, false ); } else if ( iswprint( c ) ) { result = read_symbol( input, c ); } else { @@ -140,8 +151,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_po * input stream into a Lisp string, and then convert it to a number. */ struct cons_pointer read_number( struct stack_frame *frame, - struct cons_pointer frame_pointer, - FILE * input, + struct cons_pointer frame_pointer, + FILE * input, wint_t initial, bool seen_period ) { struct cons_pointer result = NIL; int64_t accumulator = 0; @@ -222,17 +233,21 @@ struct cons_pointer read_number( struct stack_frame *frame, * left parenthesis. */ struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, - FILE * input, wint_t initial ) { + struct cons_pointer frame_pointer, + FILE * input, wint_t initial ) { struct cons_pointer result = NIL; if ( initial != ')' ) { #ifdef DEBUG fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial, initial ); #endif - struct cons_pointer car = read_continuation( frame, frame_pointer, input, - initial ); - result = make_cons( car, read_list( frame, frame_pointer, input, fgetwc( input ) ) ); + struct cons_pointer car = + read_continuation( frame, frame_pointer, input, + initial ); + result = + make_cons( car, + read_list( frame, frame_pointer, input, + fgetwc( input ) ) ); } #ifdef DEBUG else { @@ -323,6 +338,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) { */ struct cons_pointer read( struct stack_frame - *frame, struct cons_pointer frame_pointer, FILE * input ) { + *frame, struct cons_pointer frame_pointer, + FILE * input ) { return read_continuation( frame, frame_pointer, input, fgetwc( input ) ); } diff --git a/src/ops/read.h b/src/ops/read.h index c144699..c6dbba3 100644 --- a/src/ops/read.h +++ b/src/ops/read.h @@ -15,7 +15,6 @@ * read the next object on this input stream and return a cons_pointer to it. */ struct cons_pointer read( struct stack_frame *frame, - struct cons_pointer frame_pointer, - FILE * input ); + struct cons_pointer frame_pointer, FILE * input ); #endif diff --git a/src/repl.c b/src/repl.c index 5dd6567..d077ba8 100644 --- a/src/repl.c +++ b/src/repl.c @@ -31,64 +31,65 @@ * Dummy up a Lisp read call with its own stack frame. */ struct cons_pointer repl_read( struct cons_pointer stream_pointer ) { - struct cons_pointer result = NIL; - struct cons_pointer frame_pointer = make_empty_frame( NIL ); - if (!nilp(frame_pointer)) { - inc_ref(frame_pointer); - struct stack_frame *frame = get_stack_frame(frame_pointer); + struct cons_pointer result = NIL; + struct cons_pointer frame_pointer = make_empty_frame( NIL ); + if ( !nilp( frame_pointer ) ) { + inc_ref( frame_pointer ); + struct stack_frame *frame = get_stack_frame( frame_pointer ); - if (frame != NULL){ + if ( frame != NULL ) { - set_reg( frame, 0, stream_pointer ); - struct cons_pointer result = lisp_read( frame, frame_pointer, oblist ); + set_reg( frame, 0, stream_pointer ); + struct cons_pointer result = + lisp_read( frame, frame_pointer, oblist ); + } + dec_ref( frame_pointer ); } - dec_ref(frame_pointer); - } - return result; + return result; } /** * Dummy up a Lisp eval call with its own stack frame. */ struct cons_pointer repl_eval( struct cons_pointer input ) { - struct cons_pointer result = NIL; - struct cons_pointer frame_pointer = make_empty_frame( NIL ); - if (!nilp(frame_pointer)) { - inc_ref(frame_pointer); - struct stack_frame *frame = get_stack_frame(frame_pointer); + struct cons_pointer result = NIL; + struct cons_pointer frame_pointer = make_empty_frame( NIL ); + if ( !nilp( frame_pointer ) ) { + inc_ref( frame_pointer ); + struct stack_frame *frame = get_stack_frame( frame_pointer ); - if (frame != NULL){ - set_reg( frame, 0, input ); - result = lisp_eval( frame, frame_pointer, oblist ); + if ( frame != NULL ) { + set_reg( frame, 0, input ); + result = lisp_eval( frame, frame_pointer, oblist ); + } + + dec_ref( frame_pointer ); } - dec_ref(frame_pointer); - } - - return result; + return result; } /** * Dummy up a Lisp print call with its own stack frame. */ struct cons_pointer repl_print( struct cons_pointer stream_pointer, - struct cons_pointer value ) { - struct cons_pointer result = NIL; - struct cons_pointer frame_pointer = make_empty_frame( NIL ); - if (!nilp(frame_pointer)) { - struct stack_frame *frame = get_stack_frame(frame_pointer); + struct cons_pointer value ) { + struct cons_pointer result = NIL; + struct cons_pointer frame_pointer = make_empty_frame( NIL ); + if ( !nilp( frame_pointer ) ) { + struct stack_frame *frame = get_stack_frame( frame_pointer ); - if (frame != NULL){ - set_reg( frame, 0, value ); - set_reg( frame, 1, stream_pointer ); - result = lisp_print( frame, frame_pointer, oblist ); - free_stack_frame( frame ); + if ( frame != NULL ) { + set_reg( frame, 0, value ); + set_reg( frame, 1, stream_pointer ); + result = lisp_print( frame, frame_pointer, oblist ); + free_stack_frame( frame ); + } + dec_ref( frame_pointer ); } - dec_ref(frame_pointer); - } - return result; + return result; } /**