Integer arithmetic works, real doesn't - yet.

src/conspage.c

@@ -164,10 +164,11 @@ 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 );
+#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" );
     }
 }

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

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 

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

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
 }

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

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

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] );
 
         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;
-        }
-    }
+    inc_ref(args);
 
     return result;
 }