From 27f39e85eab19724201c0197e0d6712330f414bd Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 13 Sep 2017 18:01:35 +0100 Subject: [PATCH] Integer arithmetic works, real doesn't - yet. --- src/conspage.c | 9 +++++---- src/conspage.h | 22 +++++++++++++--------- src/init.c | 1 + src/peano.c | 30 +++++++++++++++++++++++++++++ src/peano.h | 8 ++++++++ src/print.c | 2 +- src/read.c | 13 ++++++++++--- src/stack.c | 51 ++++++++++++++------------------------------------ 8 files changed, 82 insertions(+), 54 deletions(-) diff --git a/src/conspage.c b/src/conspage.c index efb9f91..7221ffc 100644 --- a/src/conspage.c +++ b/src/conspage.c @@ -164,11 +164,12 @@ struct cons_pointer allocate_cell( char *tag ) { cell->payload.cons.car = NIL; cell->payload.cons.cdr = NIL; +#ifdef DEBUG fprintf( stderr, "Allocated cell of type '%s' at %d, %d \n", tag, result.page, result.offset ); - // dump_object( stderr, result ); - } else { +#endif + } else { fprintf( stderr, "WARNING: Allocating non-free cell!" ); } } @@ -188,7 +189,7 @@ void initialise_cons_pages( ) { make_cons_page( ); conspageinitihasbeencalled = true; } else { - fprintf( stderr, - "WARNING: conspageinit() called a second or subsequent time\n" ); + fwprintf( stderr, + L"WARNING: initialise_cons_pages() called a second or subsequent time\n" ); } } diff --git a/src/conspage.h b/src/conspage.h index 0dfff8f..3e8026e 100644 --- a/src/conspage.h +++ b/src/conspage.h @@ -4,23 +4,27 @@ #define __conspage_h /** - * the number of cons cells on a cons page. The maximum value this can be (and consequently, - * the size which, by version 1, it will default to) is the maximum value of an unsigned 32 - * bit integer, which is to say 4294967296. However, we'll start small. + * the number of cons cells on a cons page. The maximum value this can + * be (and consequently, the size which, by version 1, it will default + * to) is the maximum value of an unsigned 32 bit integer, which is to + * say 4294967296. However, we'll start small. */ #define CONSPAGESIZE 8 /** - * the number of cons pages we will initially allow for. For convenience we'll set up an array - * of cons pages this big; however, later we will want a mechanism for this to be able to grow - * dynamically to the maximum we can currently allow, which is 4294967296. + * the number of cons pages we will initially allow for. For + * convenience we'll set up an array of cons pages this big; however, + * later we will want a mechanism for this to be able to grow + * dynamically to the maximum we can currently allow, which is + * 4294967296. */ #define NCONSPAGES 8 /** - * a cons page is essentially just an array of cons space objects. It might later have a local - * free list (i.e. list of free cells on this page) and a pointer to the next cons page, but - * my current view is that that's probably unneccessary. + * a cons page is essentially just an array of cons space objects. It + * might later have a local free list (i.e. list of free cells on this + * page) and a pointer to the next cons page, but my current view is + * that that's probably unneccessary. */ struct cons_page { struct cons_space_object cell[CONSPAGESIZE]; diff --git a/src/init.c b/src/init.c index d5207f1..a51e827 100644 --- a/src/init.c +++ b/src/init.c @@ -90,6 +90,7 @@ int main( int argc, char *argv[] ) { bind_function( "add", &lisp_add); bind_function( "multiply", &lisp_multiply); + bind_function( "subtract", &lisp_subtract); /* * primitive special forms diff --git a/src/peano.c b/src/peano.c index 55da8ba..5f50280 100644 --- a/src/peano.c +++ b/src/peano.c @@ -117,3 +117,33 @@ lisp_multiply(struct stack_frame *frame, struct cons_pointer env) { return result; } +/** + * Subtract one number from another. + * @param env the evaluation environment - ignored; + * @param frame the stack frame. + * @return a pointer to an integer or real. + */ +struct cons_pointer +lisp_subtract(struct stack_frame *frame, struct cons_pointer env) { + struct cons_pointer result = NIL; + + struct cons_space_object arg0 = pointer2cell(frame->arg[0]); + struct cons_space_object arg1 = pointer2cell(frame->arg[1]); + + if ( integerp(frame->arg[0]) && integerp(frame->arg[1])) { + result = make_integer(arg0.payload.integer.value - arg1.payload.integer.value); + } else if ( realp(frame->arg[0]) && realp(frame->arg[1])) { + result = make_real(arg0.payload.real.value - arg1.payload.real.value); + } else if (integerp(frame->arg[0]) && realp(frame->arg[1])) { + result = make_real( numeric_value(frame->arg[0]) - arg1.payload.real.value); + } else if (realp(frame->arg[0]) && integerp(frame->arg[1])) { + result = make_real( arg0.payload.real.value - numeric_value(frame->arg[0])); + } // else we have an error! + + // and if not nilp[frame->arg[2]) we also have an error. + + return result; +} + + + diff --git a/src/peano.h b/src/peano.h index 6c9c781..36b64ea 100644 --- a/src/peano.h +++ b/src/peano.h @@ -34,6 +34,14 @@ lisp_add(struct stack_frame *frame, struct cons_pointer env); struct cons_pointer lisp_multiply(struct stack_frame *frame, struct cons_pointer env); +/** + * Subtract one number from another. + * @param env the evaluation environment - ignored; + * @param frame the stack frame. + * @return a pointer to an integer or real. + */ +struct cons_pointer +lisp_subtract(struct stack_frame *frame, struct cons_pointer env); #ifdef __cplusplus } diff --git a/src/print.c b/src/print.c index 1f93f59..ca866cf 100644 --- a/src/print.c +++ b/src/print.c @@ -89,7 +89,7 @@ void print( FILE * output, struct cons_pointer pointer ) { fwprintf( output, L"nil" ); break; case REALTV: - fwprintf( output, L"%lf", cell.payload.real.value ); + fwprintf( output, L"%Lf", cell.payload.real.value ); break; case STRINGTV: print_string( output, pointer ); diff --git a/src/read.c b/src/read.c index f2eeff5..abd76bb 100644 --- a/src/read.c +++ b/src/read.c @@ -82,6 +82,7 @@ struct cons_pointer read_continuation( FILE * input, wint_t initial ) { * read a number from this input stream, given this initial character. */ struct cons_pointer read_number( FILE * input, wint_t initial ) { + struct cons_pointer result = NIL; long int accumulator = 0; int places_of_decimals = 0; bool seen_period = false; @@ -96,7 +97,7 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) { } else { accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' ); - fprintf( stderr, "Added character %c, accumulator now %ld\n", c, + fwprintf( stderr, L"Added character %c, accumulator now %ld\n", c, accumulator ); if ( seen_period ) { @@ -111,10 +112,16 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) { ungetwc( c, input ); if ( seen_period ) { - return make_real( accumulator / pow( 10, places_of_decimals ) ); + long double rv = (long double) + ( accumulator / pow(10, places_of_decimals) ); + + fwprintf( stderr, L"read_numer returning %Lf\n", rv); + result = make_real( rv); } else { - return make_integer( accumulator ); + result = make_integer( accumulator ); } + + return result; } /** diff --git a/src/stack.c b/src/stack.c index 25e9795..83ecf3a 100644 --- a/src/stack.c +++ b/src/stack.c @@ -51,18 +51,12 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, result->arg[i] = NIL; } - int i = 0; /* still an index into args, so same name will - * do */ - - while ( !nilp( 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 */ + for (int i = 0; i < args_in_frame && !nilp( args ); i++ ) { + /* 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 ( i < args_in_frame ) { - fwprintf(stderr, L"Making frame; arg %d: ", i); - print(stderr, cell.payload.cons.car); /* * TODO: if we were running on real massively parallel hardware, * each arg except the first should be handed off to another @@ -72,18 +66,13 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous, inc_ref( result->arg[i] ); args = cell.payload.cons.cdr; - i++; - } else { + } /* * TODO: this isn't right. These args should also each be evaled. */ result->more = args; inc_ref( result->more ); - args = NIL; - } - } - return result; } @@ -116,31 +105,19 @@ struct stack_frame *make_special_frame( struct stack_frame *previous, result->arg[i] = NIL; } - int i = 0; /* still an index into args, so same name will - * do */ - - while ( !nilp( 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 */ + for (int i = 0; i < args_in_frame && !nilp( args ); i++ ) { + /* 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 ( i < args_in_frame ) { - result->arg[i] = cell.payload.cons.car; - inc_ref( result->arg[i] ); + result->arg[i] = cell.payload.cons.car; + inc_ref( result->arg[i] ); - args = cell.payload.cons.cdr; - i++; - } else { - /* - * TODO: this isn't right. These args should also each be evaled. - */ - result->more = args; - inc_ref( result->more ); - - args = NIL; - } + args = cell.payload.cons.cdr; } + result->more = args; + inc_ref(args); return result; }