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;
}