Sorting out what looked like a premature freeing bug.

It wasn't, but in investigating I tightened up allocation and deallocation in frames.

src/consspaceobject.c

@@ -54,7 +54,7 @@ void inc_ref( struct cons_pointer pointer ) {
 void dec_ref( struct cons_pointer pointer ) {
     struct cons_space_object *cell = &pointer2cell( pointer );
 
-    if ( cell->count <= MAXREFERENCE ) {
+    if ( cell->count > 0 ) {
         cell->count--;
 
         if ( cell->count == 0 ) {

src/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.
+                              && end_of_string( cell_b->payload.
-                                                cdr ) ) );
+                                                string.cdr ) ) );
                 break;
             case INTEGERTV:
                 result =

src/lispops.c

@@ -88,8 +88,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
 
     struct cons_pointer result = NIL;
     struct stack_frame *next = make_empty_frame( parent, env );
-    next->arg[0] = form;
+    set_reg( next, 0, form );
-    inc_ref( next->arg[0] );
     result = lisp_eval( next, env );
 
     if ( !exceptionp( result ) ) {
@@ -242,8 +241,7 @@ struct cons_pointer
 c_apply( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     struct stack_frame *fn_frame = make_empty_frame( frame, env );
-    fn_frame->arg[0] = c_car( frame->arg[0] );
+    set_reg( fn_frame, 0, c_car( frame->arg[0] ) );
-    inc_ref( fn_frame->arg[0] );
     struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
 
     if ( !exceptionp( result ) ) {
@@ -438,9 +436,8 @@ lisp_apply( struct stack_frame *frame, struct cons_pointer env ) {
     fputws( L"Apply: ", stderr );
     dump_frame( stderr, frame );
 
-    frame->arg[0] = make_cons( frame->arg[0], frame->arg[1] );
+    set_reg( frame, 0, make_cons( frame->arg[0], frame->arg[1] ) );
-    inc_ref( frame->arg[0] );
+    set_reg( frame, 1, NIL );
-    frame->arg[1] = NIL;
 
     struct cons_pointer result = c_apply( frame, env );
 
@@ -653,15 +650,20 @@ lisp_read( struct stack_frame *frame, struct cons_pointer env ) {
  */
 struct cons_pointer
 lisp_print( struct stack_frame *frame, struct cons_pointer env ) {
+    struct cons_pointer result = NIL;
     FILE *output = stdout;
 
     if ( writep( frame->arg[1] ) ) {
         output = pointer2cell( frame->arg[1] ).payload.stream.stream;
     }
 
-    print( output, frame->arg[0] );
+    result = print( output, frame->arg[0] );
 
-    return NIL;
+  fputws( L"Print returning ", stderr);
+  print(stderr, result);
+  fputws( L"\n", stderr);
+
+    return result;
 }
 
 

src/print.c

@@ -103,7 +103,7 @@ void print_list( FILE * output, struct cons_pointer pointer ) {
  * Print the cons-space object indicated by `pointer` to the stream indicated
  * by `output`.
  */
-void print( FILE * output, struct cons_pointer pointer ) {
+struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     char *buffer;
 
@@ -132,8 +132,8 @@ void 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.
+                                                 cell.payload.lambda.
-                                                 lambda.body ) ) );
+                                                 body ) ) );
             break;
         case NILTV:
             fwprintf( output, L"nil" );
@@ -141,8 +141,8 @@ void 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.
+                                                 cell.payload.lambda.
-                                                 lambda.body ) ) );
+                                                 body ) ) );
             break;
         case READTV:
             fwprintf( output, L"(Input stream)" );
@@ -196,4 +196,6 @@ void print( FILE * output, struct cons_pointer pointer ) {
     if ( print_use_colours ) {
         fputws( L"\x1B[39m", output );
     }
+
+  return pointer;
 }

src/print.h

@@ -14,7 +14,7 @@
 #ifndef __print_h
 #define __print_h
 
-void print( FILE * output, struct cons_pointer pointer );
+struct cons_pointer print( FILE * output, struct cons_pointer pointer );
 extern int print_use_colours;
 
 #endif

src/repl.c

@@ -33,7 +33,7 @@
 struct cons_pointer repl_read( struct cons_pointer stream_pointer ) {
     struct stack_frame *frame = make_empty_frame( NULL, oblist );
 
-    frame->arg[0] = stream_pointer;
+    set_reg( frame, 0, stream_pointer );
     struct cons_pointer result = lisp_read( frame, oblist );
     free_stack_frame( frame );
 
@@ -46,7 +46,7 @@ struct cons_pointer repl_read( struct cons_pointer stream_pointer ) {
 struct cons_pointer repl_eval( struct cons_pointer input ) {
     struct stack_frame *frame = make_empty_frame( NULL, oblist );
 
-    frame->arg[0] = input;
+    set_reg( frame, 0, input );
     struct cons_pointer result = lisp_eval( frame, oblist );
 
     if ( !exceptionp( result ) ) {
@@ -63,8 +63,8 @@ struct cons_pointer repl_print( struct cons_pointer stream_pointer,
                                 struct cons_pointer value ) {
     struct stack_frame *frame = make_empty_frame( NULL, oblist );
 
-    frame->arg[0] = value;
+    set_reg( frame, 0, value );
-    frame->arg[1] = NIL /* stream_pointer */ ;
+    set_reg( frame, 1, stream_pointer );
     struct cons_pointer result = lisp_print( frame, oblist );
     free_stack_frame( frame );
 
@@ -82,7 +82,10 @@ void
 repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
       bool show_prompt ) {
     struct cons_pointer input_stream = make_read_stream( in_stream );
+    pointer2cell( input_stream ).count = MAXREFERENCE;
+
     struct cons_pointer output_stream = make_write_stream( out_stream );
+    pointer2cell( output_stream ).count = MAXREFERENCE;
 
     while ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
         if ( show_prompt ) {
@@ -90,21 +93,16 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
         }
 
         struct cons_pointer input = repl_read( input_stream );
+        inc_ref( input );
 
         if ( exceptionp( input ) ) {
+            if ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
+                repl_print( output_stream, input );
+            }
             break;
         } else {
-
+            repl_print( output_stream, repl_eval( input ) );
-            struct cons_pointer val = repl_eval( input );
-
-            if ( feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
-                /* suppress the 'end of stream' exception */
-                if ( !exceptionp( val ) ) {
-                    repl_print( output_stream, val );
-                }
-            } else {
-                repl_print( output_stream, val );
-            }
         }
+        dec_ref( input );
     }
 }

src/stack.c

@@ -49,7 +49,7 @@ struct stack_frame *make_empty_frame( struct stack_frame *previous,
     result->function = NIL;
 
     for ( int i = 0; i < args_in_frame; i++ ) {
-        result->arg[i] = NIL;
+        set_reg( result, i, NIL );
     }
 
     return result;
@@ -83,17 +83,15 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
          * https://github.com/simon-brooke/post-scarcity/wiki/parallelism
          */
         struct stack_frame *arg_frame = make_empty_frame( result, env );
-        arg_frame->arg[0] = cell.payload.cons.car;
+        set_reg( arg_frame, 0, cell.payload.cons.car );
-        inc_ref( arg_frame->arg[0] );
 
         struct cons_pointer val = lisp_eval( arg_frame, env );
         if ( exceptionp( val ) ) {
             exception = &val;
             break;
         } else {
-            result->arg[i] = val;
+            set_reg( result, i, val );
         }
-        inc_ref( val );
 
         free_stack_frame( arg_frame );
 
@@ -129,8 +127,7 @@ struct stack_frame *make_special_frame( struct stack_frame *previous,
          * stash them on more */
         struct cons_space_object cell = pointer2cell( args );
 
-        result->arg[i] = cell.payload.cons.car;
+        set_reg( result, i, cell.payload.cons.car );
-        inc_ref( result->arg[i] );
 
         args = cell.payload.cons.cdr;
     }

src/stack.h

@@ -24,6 +24,13 @@
 #ifndef __stack_h
 #define __stack_h
 
+/**
+ * set a register in a stack frame. Alwaye use this macro to do so,
+ • because that way we can be sure the inc_ref happens!
+ */
+#define set_reg(frame,register,value)frame->arg[register]=value; inc_ref(value)
+
+
 /**
  * Make an empty stack frame, and return it.
  * @param previous the current top-of-stack;