Much better debugging, but it still doesn't work

Doxyfile

@@ -32,7 +32,7 @@ DOXYFILE_ENCODING      = UTF-8
 # title of most generated pages and in a few other places.
 # The default value is: My Project.
 
-PROJECT_NAME           = "\"Post Scarcity\""
+PROJECT_NAME           = "Post Scarcity"
 
 # The PROJECT_NUMBER tag can be used to enter a project or revision number. This
 # could be handy for archiving the generated documentation or if some version
@@ -58,7 +58,7 @@ PROJECT_LOGO           =
 # entered, it will be relative to the location where doxygen was started. If
 # left blank the current directory will be used.
 
-OUTPUT_DIRECTORY       = /home/simon/workspace/post-scarcity/doc
+OUTPUT_DIRECTORY       = doc
 
 # If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub-
 # directories (in 2 levels) under the output directory of each output format and
@@ -778,7 +778,7 @@ WARN_FORMAT            = "$file:$line: $text"
 # messages should be written. If left blank the output is written to standard
 # error (stderr).
 
-WARN_LOGFILE           = 
+WARN_LOGFILE           = doxy.log
 
 #---------------------------------------------------------------------------
 # Configuration options related to the input files
@@ -790,7 +790,7 @@ WARN_LOGFILE           =
 # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING
 # Note: If this tag is empty the current directory is searched.
 
-INPUT                  = /home/simon/workspace/post-scarcity/src
+INPUT                  = src src/arith src/memory src/ops
 
 # This tag can be used to specify the character encoding of the source files
 # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses

Makefile

@@ -23,7 +23,7 @@ LDFLAGS := -lm
 $(TARGET): $(OBJS) Makefile
 	$(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
 
-doc: $(SRCS) Makefile
+doc: $(SRCS) Makefile Doxyfile
 	doxygen
 
 format: $(SRCS) $(HDRS) Makefile

src/arith/integer.c

@@ -13,6 +13,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "debug.h"
 
 /**
  * return the numeric value of this cell, as a C primitive double, not
@@ -40,9 +41,7 @@ struct cons_pointer make_integer( int64_t value ) {
     struct cons_space_object *cell = &pointer2cell( result );
     cell->payload.integer.value = value;
 
-#ifdef DEBUG
+    debug_dump_object( result, DEBUG_ARITH );
-    dump_object( stderr, result );
-#endif
 
     return result;
 }

src/arith/peano.c

@@ -16,6 +16,7 @@
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "debug.h"
 #include "equal.h"
 #include "integer.h"
 #include "intern.h"
@@ -86,8 +87,8 @@ long double to_long_double( struct cons_pointer arg ) {
             break;
     }
 
-    fputws( L"to_long_double( ", stderr );
+    debug_print( L"to_long_double( ", DEBUG_ARITH );
-    print( stderr, arg );
+    debug_print_object( arg, DEBUG_ARITH );
     fwprintf( stderr, L") => %lf\n", result );
 
     return result;
@@ -129,13 +130,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
     struct cons_space_object cell1 = pointer2cell( arg1 );
     struct cons_space_object cell2 = pointer2cell( arg2 );
 
-#ifdef DEBUG
+    debug_print( L"add_2( arg1 = ", DEBUG_ARITH );
-    fputws( L"add_2( arg1 = ", stderr );
+    debug_print_object( arg1, DEBUG_ARITH );
-    print( stderr, arg1 );
+    debug_print( L"; arg2 = ", DEBUG_ARITH );
-    fputws( L"; arg2 = ", stderr );
+    debug_print_object( arg2, DEBUG_ARITH );
-    print( stderr, arg2 );
+    debug_print( L"\n", DEBUG_ARITH );
-    fputws( L")\n", stderr );
-#endif
 
     if ( zerop( arg1 ) ) {
         result = arg2;
@@ -209,11 +208,9 @@ struct cons_pointer add_2( struct stack_frame *frame,
         }
     }
 
-#ifdef DEBUG
+    debug_print( L"}; => ", DEBUG_ARITH );
-    fputws( L"}; => ", stderr );
+    debug_print_object( arg2, DEBUG_ARITH );
-    print( stderr, arg2 );
+    debug_print( L"\n", DEBUG_ARITH );
-    fputws( L"\n", stderr );
-#endif
 
     return result;
 }
@@ -267,13 +264,11 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
     struct cons_space_object cell1 = pointer2cell( arg1 );
     struct cons_space_object cell2 = pointer2cell( arg2 );
 
-#ifdef DEBUG
+    debug_print( L"multiply_2( arg1 = ", DEBUG_ARITH );
-    fputws( L"multiply_2( arg1 = ", stderr );
+    debug_print_object( arg1, DEBUG_ARITH );
-    print( stderr, arg1 );
+    debug_print( L"; arg2 = ", DEBUG_ARITH );
-    fputws( L"; arg2 = ", stderr );
+    debug_print_object( arg2, DEBUG_ARITH );
-    print( stderr, arg2 );
+    debug_print( L")", DEBUG_ARITH );
-    fputws( L")\n", stderr );
-#endif
 
     if ( zerop( arg1 ) ) {
         result = arg2;
@@ -348,11 +343,9 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
         }
     }
 
-#ifdef DEBUG
+    debug_print( L" => ", DEBUG_ARITH );
-    fputws( L" => ", stderr );
+    debug_print_object( arg2, DEBUG_ARITH );
-    print( stderr, arg2 );
+    debug_print( L"\n", DEBUG_ARITH );
-    fputws( L"\n", stderr );
-#endif
 
     return result;
 }

src/arith/ratio.c

@@ -13,7 +13,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
-#include "dump.h"
+#include "debug.h"
 #include "equal.h"
 #include "integer.h"
 #include "lispops.h"
@@ -332,9 +332,8 @@ struct cons_pointer make_ratio( struct cons_pointer frame_pointer,
                              ( "Dividend and divisor of a ratio must be integers" ),
                              frame_pointer );
     }
-#ifdef DEBUG
+    debug_dump_object( result, DEBUG_ARITH );
-    dump_object( stderr, result );
+
-#endif
 
     return result;
 }

src/arith/real.c

@@ -9,7 +9,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
-#include "dump.h"
+#include "debug.h"
 #include "read.h"
 
 /**
@@ -23,9 +23,7 @@ struct cons_pointer make_real( long double value ) {
     struct cons_space_object *cell = &pointer2cell( result );
     cell->payload.real.value = value;
 
-#ifdef DEBUG
+    debug_dump_object( result, DEBUG_ARITH );
-    dump_object( stderr, result );
-#endif
 
     return result;
 }

src/debug.c

@@ -0,0 +1,65 @@
+/**
+ * debug.c
+ *
+ * Better debug log messages.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+/*
+ * wide characters
+ */
+#include <wchar.h>
+#include <wctype.h>
+
+#include "consspaceobject.h"
+#include "debug.h"
+#include "dump.h"
+#include "print.h"
+
+/**
+ * the controlling flags for `debug_print`; set in `init.c`, q.v.
+ */
+int verbosity = 0;
+
+/**
+ * print this debug `message` to stderr, if `verbosity` matches `level`.
+ * `verbosity is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
+ */
+void debug_print( wchar_t *message, int level ) {
+#ifdef DEBUG
+    if ( level & verbosity ) {
+        fputws( message, stderr );
+    }
+#endif
+}
+
+/**
+ * print the object indicated by this `pointer` to stderr, if `verbosity`
+ * matches `level`.`verbosity is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
+ */
+void debug_print_object( struct cons_pointer pointer, int level ) {
+#ifdef DEBUG
+    if ( level & verbosity ) {
+        print( stderr, pointer );
+    }
+#endif
+}
+
+/**
+ * Like `dump_object`, q.v., but protected by the verbosity mechanism.
+ */
+void debug_dump_object( struct cons_pointer pointer, int level ) {
+#ifdef DEBUG
+    if ( level & verbosity ) {
+        dump_object( stderr, pointer );
+    }
+#endif
+}

src/debug.h

@@ -0,0 +1,28 @@
+/**
+ * debug.h
+ *
+ * Better debug log messages.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdio.h>
+
+#ifndef __debug_print_h
+#define __debug_print_h
+
+#define DEBUG_ALLOC 1
+#define DEBUG_STACK 2
+#define DEBUG_ARITH 4
+#define DEBUG_EVAL 8
+#define DEBUG_LAMBDA 16
+#define DEBUG_BOOTSTRAP 32
+#define DEBUG_IO 64
+
+extern int verbosity;
+void debug_print( wchar_t *message, int level );
+void debug_print_object( struct cons_pointer pointer, int level );
+void debug_dump_object( struct cons_pointer pointer, int level );
+#endif

src/init.c

@@ -11,26 +11,32 @@
 
 #include <stdbool.h>
 #include <stdio.h>
+#include <stdlib.h>
 #include <unistd.h>
 #include <wchar.h>
 
 #include "version.h"
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "debug.h"
 #include "intern.h"
 #include "lispops.h"
 #include "peano.h"
 #include "print.h"
 #include "repl.h"
 
+// extern char *optarg; /* defined in unistd.h */
+
 void bind_function( char *name, struct cons_pointer ( *executable )
-                     ( struct stack_frame *, struct cons_pointer ) ) {
+                     ( struct stack_frame *,
+                       struct cons_pointer, struct cons_pointer ) ) {
     deep_bind( c_string_to_lisp_symbol( name ),
                make_function( NIL, executable ) );
 }
 
 void bind_special( char *name, struct cons_pointer ( *executable )
-                    ( struct stack_frame * frame, struct cons_pointer env ) ) {
+                    ( struct stack_frame *,
+                      struct cons_pointer, struct cons_pointer ) ) {
     deep_bind( c_string_to_lisp_symbol( name ),
                make_special( NIL, executable ) );
 }
@@ -46,7 +52,7 @@ int main( int argc, char *argv[] ) {
     bool dump_at_end = false;
     bool show_prompt = false;
 
-    while ( ( option = getopt( argc, argv, "pdc" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "pdcv:" ) ) != -1 ) {
         switch ( option ) {
             case 'c':
                 print_use_colours = true;
@@ -57,6 +63,8 @@ int main( int argc, char *argv[] ) {
             case 'p':
                 show_prompt = true;
                 break;
+            case 'v':
+                verbosity = atoi( optarg );
             default:
                 fwprintf( stderr, L"Unexpected option %c\n", option );
                 break;
@@ -68,9 +76,15 @@ int main( int argc, char *argv[] ) {
                   L"Post scarcity software environment version %s\n\n",
                   VERSION );
     }
-
+#ifdef DEBUG
+    fputws( L"About to initialise cons pages\n", stderr );
+#endif
     initialise_cons_pages(  );
 
+#ifdef DEBUG
+    fputws( L"Initialised cons pages, about to bind\n", stderr );
+#endif
+
     /*
      * privileged variables (keywords)
      */

src/memory/conspage.c

@@ -18,6 +18,7 @@
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "dump.h"
 
 /**
  * Flag indicating whether conspage initialisation has been done.
@@ -168,7 +169,7 @@ void free_cell( struct cons_pointer pointer ) {
             fwprintf( stderr, L"About to free vector-space object at %ld\n",
                       cell->payload.vectorp.address );
 #endif
-            free( ( void * ) cell->payload.vectorp.address );
+            //free( ( void * ) cell->payload.vectorp.address );
             break;
 
     }

src/memory/consspaceobject.h

@@ -133,7 +133,7 @@
  * A pointer to an object in vector space.
  */
 #define VECTORPOINTTAG  "VECP"
-#define VECTORPOINTTV 0
+#define VECTORPOINTTV 1346585942
 /**
  * An open write stream.
  */
@@ -263,9 +263,10 @@
  * An indirect pointer to a cons cell
  */
 struct cons_pointer {
-    uint32_t page;              /* the index of the page on which this cell
+   /** the index of the page on which this cell resides */
-                                 * resides */
+    uint32_t page;
-    uint32_t offset;            /* the index of the cell within the page */
+    /** the index of the cell within the page */
+    uint32_t offset;
 };
 
 /*
@@ -421,7 +422,7 @@ struct vectorp_payload {
                                  * tag. */
         uint32_t value;         /* the tag considered as a number */
     } tag;
-    struct vector_space_object *address;
+    void *address;
     /* the address of the actual vector space
      * object (TODO: will change when I actually
      * implement vector space) */

src/memory/cursor.c

@@ -0,0 +1,9 @@
+/*
+ * a cursor is a cons-space object which holds:
+ * 1. a pointer to a vector (i.e. a vector-space object which holds an
+ *    array of `cons_pointer`);
+ * 2. an integer offset into that array.
+ *
+ * this provides a mechanism for iterating through vectors (actually, in
+ * either direction)
+ */

src/memory/dump.c

@@ -20,6 +20,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "debug.h"
 #include "print.h"
 #include "stack.h"
 #include "vectorspace.h"
@@ -111,11 +112,25 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
             dump_string_cell( output, L"Symbol", pointer );
             break;
         case VECTORPOINTTV:{
+                fwprintf( output,
+                          L"\t\tPointer to vector-space object at %p\n",
+                          cell.payload.vectorp.address );
                 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 );
+                          &vso->header.tag.bytes, vso->header.size );
+                switch ( vso->header.tag.value ) {
+                    case STACKFRAMETV:
+                        dump_frame( output, pointer );
+                        break;
+                    default:
+                        fputws( L"(Unknown vector type)\n", output );
+                        break;
                 }
+            }
+            break;
+        default:
+            fputws( L"(Unknown cons space type)\n", output );
             break;
     }
 }

src/memory/stack.c

@@ -19,6 +19,8 @@
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "debug.h"
+#include "dump.h"
 #include "lispops.h"
 #include "print.h"
 #include "stack.h"
@@ -30,21 +32,24 @@
  */
 struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
     struct stack_frame *result = NULL;
-    fputws
+    debug_print
         ( L"get_stack_frame: about to get a pointer to the vector space object\n",
-          stderr );
+          DEBUG_ALLOC );
     struct vector_space_object *vso =
         pointer2cell( pointer ).payload.vectorp.address;
-    fputws( L"get_stack_frame: got a pointer, about to test it\n", stderr );
+    debug_print( L"get_stack_frame: got a pointer, about to test it\n",
+                 DEBUG_ALLOC );
 
-    if ( vectorpointp( pointer ) ) {  // && stackframep(vso)){
+    if ( vectorpointp( pointer ) && stackframep( vso ) ) {
-        fputws( L"get_stack_frame: pointer is good, about to set the result\n",
+        debug_print
-                stderr );
+            ( L"get_stack_frame: pointer is good, about to set the result\n",
+              DEBUG_ALLOC );
 
         result = ( struct stack_frame * ) &( vso->payload );
-        fputws( L"get_stack_frame: all good, returning\n", stderr );
+        fwprintf( stderr, L"get_stack_frame: all good, returning %p\n",
+                  result );
     } else {
-        fputws( L"get_stack_frame: fail, returning NULL\n", stderr );
+        debug_print( L"get_stack_frame: fail, returning NULL\n", DEBUG_ALLOC );
     }
 
     return result;
@@ -57,11 +62,20 @@ 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 ) {
-    fputws( L"Entering make_empty_frame\n", stderr );
+    debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC );
     struct cons_pointer result =
         make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) );
+
+    debug_dump_object( result, DEBUG_ALLOC );
+
+    fwprintf( stderr,
+              L"make_empty_frame: got vector_space_object with size %lu, tag %4.4s\n",
+              pointer_to_vso( result )->header.size,
+              &pointer_to_vso( result )->header.tag.bytes );
+
     if ( !nilp( result ) ) {
-        fputws( L"make_empty_frame: about to call get_stack_frame\n", stderr );
+        debug_print( L"make_empty_frame: about to call get_stack_frame\n",
+                     DEBUG_ALLOC );
         struct stack_frame *frame = get_stack_frame( result );
         /*
          * TODO: later, pop a frame off a free-list of stack frames
@@ -69,9 +83,10 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
 
         fwprintf( stderr,
                   L"make_empty_frame: about to set previous to %4.4s\n",
-                  pointer2cell( previous ).tag );
+                  &pointer2cell( previous ).tag.bytes );
         frame->previous = previous;
-        fputws( L"make_empty_frame: about to call inc_ref\n", stderr );
+        debug_print( L"make_empty_frame: about to call inc_ref\n",
+                     DEBUG_ALLOC );
         inc_ref( previous );
 
         /*
@@ -82,13 +97,13 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
         frame->function = NIL;
         frame->args = 0;
 
-        fputws( L"make_empty_frame: about to initialise arg registers\n",
+        debug_print( L"make_empty_frame: about to initialise arg registers\n",
-                stderr );
+                     DEBUG_ALLOC );
         for ( int i = 0; i < args_in_frame; i++ ) {
             set_reg( frame, i, NIL );
         }
     }
-    fputws( L"Leaving make_empty_frame\n", stderr );
+    debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC );
 
     return result;
 }
@@ -104,7 +119,7 @@ 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 ) {
-    fputws( L"Entering make_stack_frame\n", stderr );
+    debug_print( L"Entering make_stack_frame\n", DEBUG_ALLOC );
     struct cons_pointer result = make_empty_frame( previous );
 
     if ( nilp( result ) ) {
@@ -164,12 +179,11 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 frame->more = more;
                 inc_ref( more );
             }
-#ifdef DEBUG
+
-            dump_frame( stderr, result );
+            debug_dump_object( result, DEBUG_ALLOC );
-#endif
         }
     }
-    fputws( L"Leaving make_stack_frame\n", stderr );
+    debug_print( L"Leaving make_stack_frame\n", DEBUG_ALLOC );
 
     return result;
 }
@@ -185,7 +199,7 @@ 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 ) {
-    fputws( L"Entering make_special_frame\n", stderr );
+    debug_print( L"Entering make_special_frame\n", DEBUG_ALLOC );
 
     struct cons_pointer result = make_empty_frame( previous );
 
@@ -213,12 +227,11 @@ struct cons_pointer make_special_frame( struct cons_pointer previous,
                 frame->more = args;
                 inc_ref( args );
             }
-#ifdef DEBUG
+
-            dump_frame( stderr, result );
+            debug_dump_object( result, DEBUG_ALLOC );
-#endif
         }
     }
-    fputws( L"Leaving make_special_frame\n", stderr );
+    debug_print( L"Leaving make_special_frame\n", DEBUG_ALLOC );
 
     return result;
 }

src/memory/stack.h

@@ -33,13 +33,13 @@
 /**
  * is this vector-space object a stack frame?
  */
-#define stackframep(vso)(vso->header.tag.value == STACKFRAMETV)
+#define stackframep(vso)(((struct vector_space_object *)vso)->header.tag.value == STACKFRAMETV)
 
 /**
  * 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)
+#define set_reg(frame,register,value){frame->arg[register]=value; inc_ref(value);}
 
 struct stack_frame *get_stack_frame( struct cons_pointer pointer );
 

src/memory/vectorspace.c

@@ -21,6 +21,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "dump.h"
 #include "vectorspace.h"
 
 
@@ -30,19 +31,18 @@
  * 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 cons_pointer make_vec_pointer( struct vector_space_object *address ) {
-                                      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 );
+    struct cons_space_object *cell = &pointer2cell( pointer );
     fwprintf( stderr,
-              L"make_vec_pointer: allocated cell, about to write tag '%s'\n",
+              L"make_vec_pointer: tag written, about to set pointer address to %p\n",
-              tag );
+              address );
-    strncpy( &cell.payload.vectorp.tag.bytes[0], tag, 4 );
+    cell->payload.vectorp.address = address;
-    fputws( L"make_vec_pointer: tag written, about to set pointer address\n",
+    fwprintf( stderr, L"make_vec_pointer: all good, returning pointer to %p\n",
-            stderr );
+              cell->payload.vectorp.address );
-    cell.payload.vectorp.address = address;
+
-    fputws( L"make_vec_pointer: all good, returning\n", stderr );
+    dump_object( stderr, pointer );
 
     return pointer;
 }
@@ -66,24 +66,32 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
     struct vector_space_object *vso = malloc( padded );
 
     if ( vso != NULL ) {
-        fwprintf( stderr, L"make_vso: about to write tag '%s'\n", tag );
+        fwprintf( stderr,
+                  L"make_vso: about to write tag '%s' into vso at %p\n", tag,
+                  vso );
         strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH );
-        vso->header.vecp = make_vec_pointer( tag, vso );
+        result = make_vec_pointer( vso );
+        dump_object( stderr, result );
+        vso->header.vecp = result;
+        // memcpy(vso->header.vecp, result, sizeof(struct cons_pointer));
+
         vso->header.size = payload_size;
 
 #ifdef DEBUG
         fwprintf( stderr,
-                  L"Allocated vector-space object of type %4.4s, total size %ld, payload size %ld\n",
+                  L"Allocated vector-space object of type %4.4s, total size %ld, payload size %ld, at address %p, payload address %p\n",
-                  tag, total_size, payload_size );
+                  &vso->header.tag.bytes, total_size, vso->header.size, vso,
+                  &vso->payload );
         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 );
+#ifdef DEBUG
+    fwprintf( stderr, L"make_vso: all good, returning pointer to %p\n",
+              pointer2cell( result ).payload.vectorp.address );
+#endif
 
     return result;
 }

src/memory/vectorspace.h

@@ -40,7 +40,7 @@
 #define VECTORTAG "VECT"
 #define VECTORTV 0
 
-#define pointer_to_vso(pointer)((vectorpointp(pointer)? pointer2cell(pointer).payload.vectorp.address : NULL))
+#define pointer_to_vso(pointer)((vectorpointp(pointer)? (struct vector_space_object *) pointer2cell(pointer).payload.vectorp.address : (struct vector_space_object *) NULL))
 #define vso_get_vecp(vso)((vso->header.vecp))
 
 struct cons_pointer make_vso( char *tag, uint64_t payload_size );

src/ops/intern.c

@@ -21,6 +21,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "debug.h"
 #include "equal.h"
 #include "lispops.h"
 #include "print.h"
@@ -56,22 +57,22 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
             struct cons_space_object entry =
                 pointer2cell( pointer2cell( next ).payload.cons.car );
 
-            fputws( L"Internedp: checking whether `", stderr );
+            debug_print( L"Internedp: checking whether `", DEBUG_ALLOC );
-            print( stderr, key );
+            debug_print_object( key, DEBUG_ALLOC );
-            fputws( L"` equals `", stderr );
+            debug_print( L"` equals `", DEBUG_ALLOC );
-            print( stderr, entry.payload.cons.car );
+            debug_print_object( entry.payload.cons.car, DEBUG_ALLOC );
-            fputws( L"`\n", stderr );
+            debug_print( L"`\n", DEBUG_ALLOC );
 
             if ( equal( key, entry.payload.cons.car ) ) {
                 result = entry.payload.cons.car;
             }
         }
     } else {
-        fputws( L"`", stderr );
+        debug_print( L"`", DEBUG_ALLOC );
-        print( stderr, key );
+        debug_print_object( key, DEBUG_ALLOC );
-        fputws( L"` is a ", stderr );
+        debug_print( L"` is a ", DEBUG_ALLOC );
-        print( stderr, c_type( key ) );
+        debug_print_object( c_type( key ), DEBUG_ALLOC );
-        fputws( L", not a SYMB", stderr );
+        debug_print( L", not a SYMB", DEBUG_ALLOC );
     }
 
     return result;
@@ -120,7 +121,17 @@ bind( struct cons_pointer key, struct cons_pointer value,
  */
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
+    debug_print( L"Entering deep_bind\n", DEBUG_ALLOC );
+    debug_print( L"\tSetting ", DEBUG_ALLOC );
+    debug_print_object( key, DEBUG_ALLOC );
+    debug_print( L" to ", DEBUG_ALLOC );
+    debug_print_object( value, DEBUG_ALLOC );
+    debug_print( L"\n", DEBUG_ALLOC );
+
     oblist = bind( key, value, oblist );
+
+    debug_print( L"Leaving deep_bind\n", DEBUG_ALLOC );
+
     return oblist;
 }
 

src/ops/lispops.c

@@ -26,6 +26,8 @@
 
 #include "consspaceobject.h"
 #include "conspage.h"
+#include "debug.h"
+#include "dump.h"
 #include "equal.h"
 #include "integer.h"
 #include "intern.h"
@@ -83,9 +85,8 @@ struct cons_pointer eval_form( struct stack_frame *parent,
                                struct cons_pointer parent_pointer,
                                struct cons_pointer form,
                                struct cons_pointer env ) {
-    fputws( L"eval_form: ", stderr );
+    debug_print( L"eval_form: ", DEBUG_EVAL );
-    print( stderr, form );
+    debug_dump_object( form, DEBUG_EVAL );
-    fputws( L"\n", stderr );
 
     struct cons_pointer result = NIL;
     struct cons_pointer next_pointer = make_empty_frame( parent_pointer );
@@ -148,9 +149,8 @@ struct cons_pointer compose_body( struct stack_frame *frame ) {
         }
     }
 
-    fputws( L"compose_body returning ", stderr );
+    debug_print( L"compose_body returning ", DEBUG_LAMBDA );
-    print( stderr, body );
+    debug_dump_object( body, DEBUG_LAMBDA );
-    fputws( L"\n", stderr );
 
     return body;
 }
@@ -180,13 +180,10 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
 }
 
 void log_binding( struct cons_pointer name, struct cons_pointer val ) {
-#ifdef DEBUG
+    debug_print( L"\n\tBinding ", DEBUG_ALLOC );
-    fputws( L"\n\tBinding ", stderr );
+    debug_dump_object( name, DEBUG_ALLOC );
-    print( stderr, name );
+    debug_print( L" to ", DEBUG_ALLOC );
-    fputws( L" to ", stderr );
+    debug_dump_object( val, DEBUG_ALLOC );
-    print( stderr, val );
-    fputws( L"\"\n", stderr );
-#endif
 }
 
 /**
@@ -236,9 +233,9 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
     while ( !nilp( body ) ) {
         struct cons_pointer sexpr = c_car( body );
         body = c_cdr( body );
-#ifdef DEBUG
+
-        fputws( L"In lambda: ", stderr );
+        debug_print( L"In lambda: ", DEBUG_LAMBDA );
-#endif
+
         result = eval_form( frame, frame_pointer, sexpr, new_env );
     }
 
@@ -414,8 +411,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
     struct cons_pointer result = frame->arg[0];
     struct cons_space_object cell = pointer2cell( frame->arg[0] );
 
+    debug_print( L"Eval: ", DEBUG_EVAL );
 #ifdef DEBUG
-    fputws( L"Eval: ", stderr );
     dump_frame( stderr, frame_pointer );
 #endif
 
@@ -455,11 +452,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
             break;
     }
 
-#ifdef DEBUG
+    debug_print( L"Eval returning ", DEBUG_EVAL );
-    fputws( L"Eval returning ", stderr );
+    debug_dump_object( result, DEBUG_EVAL );
-    print( stderr, result );
-    fputws( L"\n", stderr );
-#endif
 
     return result;
 }
@@ -476,7 +470,7 @@ struct cons_pointer
 lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
 #ifdef DEBUG
-    fputws( L"Apply: ", stderr );
+    debug_print( L"Apply: ", DEBUG_EVAL );
     dump_frame( stderr, frame_pointer );
 #endif
     set_reg( frame, 0, make_cons( frame->arg[0], frame->arg[1] ) );
@@ -484,11 +478,8 @@ lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     struct cons_pointer result = c_apply( frame, frame_pointer, env );
 
-#ifdef DEBUG
+    debug_print( L"Apply returning ", DEBUG_EVAL );
-    fputws( L"Apply returning ", stderr );
+    debug_dump_object( result, DEBUG_EVAL );
-    print( stderr, result );
-    fputws( L"\n", stderr );
-#endif
 
     return result;
 }
@@ -690,13 +681,20 @@ lisp_equal( 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 ) {
+#ifdef DEBUG
+    debug_print( L"entering lisp_read\n", DEBUG_IO );
+#endif
     FILE *input = stdin;
 
     if ( readp( frame->arg[0] ) ) {
         input = pointer2cell( frame->arg[0] ).payload.stream.stream;
     }
 
-    return read( frame, frame_pointer, input );
+    struct cons_pointer result = read( frame, frame_pointer, input );
+    debug_print( L"lisp_read returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
+    return result;
 }
 
 
@@ -745,23 +743,22 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame,
 struct cons_pointer
 lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-#ifdef DEBUG
+    debug_print( L"Entering print\n", DEBUG_IO );
-    fputws( L"Entering print\n", stderr );
-#endif
     struct cons_pointer result = NIL;
     FILE *output = stdout;
 
     if ( writep( frame->arg[1] ) ) {
+        debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
+        debug_dump_object( frame->arg[1], DEBUG_IO );
         output = pointer2cell( frame->arg[1] ).payload.stream.stream;
     }
+    debug_print( L"lisp_print: about to print\n", DEBUG_IO );
+    debug_dump_object( frame->arg[0], DEBUG_IO );
 
     result = print( output, frame->arg[0] );
 
-#ifdef DEBUG
+    debug_print( L"lisp_print returning\n", DEBUG_IO );
-    fputws( L"Print returning ", stderr );
+    debug_dump_object( result, DEBUG_IO );
-    // print( stderr, result );
-    fputws( L"\n", stderr );
-#endif
 
     return result;
 }
@@ -828,8 +825,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     for ( int i = 0; i < args_in_frame && !done; i++ ) {
         struct cons_pointer clause_pointer = frame->arg[i];
-        fputws( L"Cond clause: ", stderr );
+        debug_print( L"Cond clause: ", DEBUG_EVAL );
-        print( stderr, clause_pointer );
+        debug_dump_object( clause_pointer, DEBUG_EVAL );
 
         if ( consp( clause_pointer ) ) {
             struct cons_space_object cell = pointer2cell( clause_pointer );
@@ -876,8 +873,8 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
 struct cons_pointer
 throw_exception( struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
-    fwprintf( stderr, L"\nERROR: " );
+    debug_print( L"\nERROR: ", DEBUG_EVAL );
-    print( stderr, message );
+    debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
     struct cons_space_object cell = pointer2cell( message );

src/ops/read.c

@@ -18,6 +18,8 @@
 #include <wctype.h>
 
 #include "consspaceobject.h"
+#include "debug.h"
+#include "dump.h"
 #include "integer.h"
 #include "intern.h"
 #include "lispops.h"
@@ -59,6 +61,7 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
 struct cons_pointer read_continuation( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        FILE * input, wint_t initial ) {
+    debug_print( L"entering read_continuation\n", DEBUG_IO );
     struct cons_pointer result = NIL;
 
     wint_t c;
@@ -141,6 +144,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 break;
         }
     }
+    debug_print( L"read_continuation returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
 
     return result;
 }
@@ -154,6 +159,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
                                  FILE * input,
                                  wint_t initial, bool seen_period ) {
+    debug_print( L"entering read_number\n", DEBUG_IO );
     struct cons_pointer result = NIL;
     int64_t accumulator = 0;
     int64_t dividend = 0;
@@ -210,9 +216,6 @@ struct cons_pointer read_number( struct stack_frame *frame,
         if ( negative ) {
             rv = 0 - rv;
         }
-#ifdef DEBUG
-        fwprintf( stderr, L"read_numer returning %Lf\n", rv );
-#endif
         result = make_real( rv );
     } else if ( dividend != 0 ) {
         result =
@@ -225,6 +228,9 @@ struct cons_pointer read_number( struct stack_frame *frame,
         result = make_integer( accumulator );
     }
 
+    debug_print( L"read_number returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
     return result;
 }
 
@@ -248,12 +254,9 @@ struct cons_pointer read_list( struct stack_frame *frame,
             make_cons( car,
                        read_list( frame, frame_pointer, input,
                                   fgetwc( input ) ) );
+    } else {
+        debug_print( L"End of list detected\n", DEBUG_IO );
     }
-#ifdef DEBUG
-    else {
-        fwprintf( stderr, L"End of list detected\n" );
-    }
-#endif
 
     return result;
 }
@@ -324,11 +327,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
             break;
     }
 
-#ifdef DEBUG
+    debug_print( L"read_symbol returning\n", DEBUG_IO );
-    fputws( L"Read symbol '", stderr );
+    debug_dump_object( result, DEBUG_IO );
-    print( stderr, result );
-    fputws( L"'\n", stderr );
-#endif
 
     return result;
 }

src/repl.c

@@ -13,6 +13,7 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "dump.h"
 #include "intern.h"
 #include "lispops.h"
 #include "read.h"
@@ -32,19 +33,25 @@
  */
 struct cons_pointer repl_read( struct cons_pointer stream_pointer ) {
     struct cons_pointer result = NIL;
+    fputws( L"Entered repl_read\n", stderr );
     struct cons_pointer frame_pointer = make_empty_frame( NIL );
+    fputws( L"repl_read: got stack_frame pointer\n", stderr );
+    dump_object( stderr, frame_pointer );
     if ( !nilp( frame_pointer ) ) {
         inc_ref( frame_pointer );
         struct stack_frame *frame = get_stack_frame( frame_pointer );
 
         if ( frame != NULL ) {
-
+            fputws( L"repl_read: about to set register\n", stderr );
             set_reg( frame, 0, stream_pointer );
+            fputws( L"repl_read: about to read\n", stderr );
             struct cons_pointer result =
                 lisp_read( frame, frame_pointer, oblist );
         }
         dec_ref( frame_pointer );
     }
+    fputws( L"repl_read: returning\n", stderr );
+    dump_object( stderr, result );
 
     return result;
 }
@@ -53,6 +60,7 @@ struct cons_pointer repl_read( struct cons_pointer stream_pointer ) {
  * Dummy up a Lisp eval call with its own stack frame.
  */
 struct cons_pointer repl_eval( struct cons_pointer input ) {
+    fputws( L"Entered repl_eval\n", stderr );
     struct cons_pointer result = NIL;
     struct cons_pointer frame_pointer = make_empty_frame( NIL );
     if ( !nilp( frame_pointer ) ) {
@@ -66,6 +74,8 @@ struct cons_pointer repl_eval( struct cons_pointer input ) {
 
         dec_ref( frame_pointer );
     }
+    fputws( L"repl_eval: returning\n", stderr );
+    dump_object( stderr, result );
 
     return result;
 }
@@ -75,6 +85,7 @@ struct cons_pointer repl_eval( struct cons_pointer input ) {
  */
 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 ) ) {
@@ -102,12 +113,12 @@ struct cons_pointer repl_print( struct cons_pointer stream_pointer,
 void
 repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
       bool show_prompt ) {
+    fputws( L"Entered repl\n", stderr );
     struct cons_pointer input_stream = make_read_stream( in_stream );
-    pointer2cell( input_stream ).count = MAXREFERENCE;
+    inc_ref( input_stream );
 
     struct cons_pointer output_stream = make_write_stream( out_stream );
-    pointer2cell( output_stream ).count = MAXREFERENCE;
+    inc_ref( output_stream );
-
     while ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
         if ( show_prompt ) {
             fwprintf( out_stream, L"\n:: " );