From 72548097cf9362e0c1f29559e81403267940a8c0 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 11:21:11 +0000
Subject: [PATCH 01/19] Rewriting intern. This is badly broken, but I think on
 the road to better.

---
 src/init.c                   |  3 ++
 src/memory/consspaceobject.c |  2 +-
 src/ops/equal.c              |  3 +-
 src/ops/intern.c             | 97 +++++++++++++++++++++++-------------
 src/ops/intern.h             |  3 ++
 src/ops/lispops.c            | 33 ++++++++++--
 src/ops/lispops.h            |  3 ++
 7 files changed, 103 insertions(+), 41 deletions(-)

diff --git a/src/init.c b/src/init.c
index f1301ee..5febcbc 100644
--- a/src/init.c
+++ b/src/init.c
@@ -401,6 +401,9 @@ int main( int argc, char *argv[] ) {
     bind_function( L"inspect",
                    L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.",
                    &lisp_inspect );
+    bind_function( L"interned?",
+                   L"`(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.",
+                   &lisp_internedp );
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3793709..8c4c5c0 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -388,7 +388,7 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
         result = make_string_like_thing( c, tail, tag );
 
         if ( tag == KEYTV ) {
-            struct cons_pointer r = internedp( result, oblist );
+            struct cons_pointer r = interned( result, oblist );
 
             if ( nilp( r ) ) {
                 intern( result, oblist );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index b4412fb..ea813a9 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -375,8 +375,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     memset( a_buff, 0, sizeof( a_buff ) );
                     memset( b_buff, 0, sizeof( b_buff ) );
 
-                    for ( ;
-                          ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
+                    for ( ; ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
                           && !nilp( b ); i++ ) {
                         a_buff[i] = cell_a->payload.string.character;
                         a = c_cdr( a );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index e064ac4..39e121f 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -270,54 +270,81 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
 // (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
 
 /**
- * Implementation of interned? in C. The final implementation if interned? will
- * deal with stores which can be association lists or hashtables or hybrids of
- * the two, but that will almost certainly be implemented in lisp.
- *
  * If this key is lexically identical to a key in this store, return the key
  * from the store (so that later when we want to retrieve a value, an eq test
  * will work); otherwise return NIL.
  */
-struct cons_pointer
-internedp( struct cons_pointer key, struct cons_pointer store ) {
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        // TODO: I see what I was doing here and it would be the right thing to 
-        // do for stores which are old-fashioned assoc lists, but it will not work
-        // for my new hybrid stores.
-        // for ( struct cons_pointer next = store;
-        //       nilp( result ) && consp( next );
-        //       next = pointer2cell( next ).payload.cons.cdr ) {
-        //     struct cons_space_object entry =
-        //         pointer2cell( pointer2cell( next ).payload.cons.car );
+        struct cons_space_object *cell = &pointer2cell( store );
 
-        //     debug_print( L"Internedp: checking whether `", DEBUG_BIND );
-        //     debug_print_object( key, DEBUG_BIND );
-        //     debug_print( L"` equals `", DEBUG_BIND );
-        //     debug_print_object( entry.payload.cons.car, DEBUG_BIND );
-        //     debug_print( L"`\n", DEBUG_BIND );
+        switch ( cell->tag.value ) {
+            case CONSTV:
+                for ( struct cons_pointer next = store;
+                      nilp( result ) && consp( next );
+                      next = c_cdr( next) ) {
+                    if ( !nilp( next ) ) {
+                        // struct cons_space_object entry =
+                        //     pointer2cell( c_car( next) );
 
-        //     if ( equal( key, entry.payload.cons.car ) ) {
-        //         result = entry.payload.cons.car;
-        //     }
-        if ( !nilp( c_assoc( key, store ) ) ) {
-            result = key;
-        } else if ( equal( key, privileged_symbol_nil ) ) {
-            result = privileged_symbol_nil;
+                        if ( equal( key, c_car(next) ) ) {
+                            result = key;
+                        }
+                    }
+                }
+                break;
+            case VECTORPOINTTV:
+                if ( hashmapp( store ) || namespacep( store ) ) {
+                    // get the right hash bucket and recursively call interned on that.
+                    struct vector_space_object *map = pointer_to_vso( store );
+                    uint32_t bucket_no =
+                        get_hash( key ) % map->payload.hashmap.n_buckets;
+
+                    result =
+                        interned( key,
+                                  map->payload.hashmap.buckets[bucket_no] );
+                } else {
+                    result =
+                        throw_exception( make_cons
+                                         ( c_string_to_lisp_string
+                                           ( L"Unexpected store type: " ),
+                                           c_type( store ) ), NIL );
+                }
+                break;
+            default:
+                result =
+                    throw_exception( make_cons
+                                     ( c_string_to_lisp_string
+                                       ( L"Unexpected store type: " ),
+                                       c_type( store ) ), NIL );
+                break;
         }
     } else {
-        debug_print( L"`", DEBUG_BIND );
-        debug_print_object( key, DEBUG_BIND );
-        debug_print( L"` is a ", DEBUG_BIND );
-        debug_printf( DEBUG_BIND, L"%4.4s",
-                      ( char * ) pointer2cell( key ).tag.bytes );
-        debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
+        result =
+            throw_exception( make_cons
+                             ( c_string_to_lisp_string
+                               ( L"Unexpected key type: " ), c_type( key ) ),
+                             NIL );
     }
 
     return result;
 }
 
+/**
+ * @brief Implementation of `interned?` in C: predicate wrapped around interned.
+ * 
+ * @param key the key to search for.
+ * @param store the store to search in.
+ * @return struct cons_pointer `t` if the key was found, else `nil`.
+ */
+struct cons_pointer internedp( struct cons_pointer key,
+                               struct cons_pointer store ) {
+    return nilp( interned( key, store ) ) ? NIL : TRUE;
+}
+
 /**
  * Implementation of assoc in C. Like interned?, the final implementation will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -370,7 +397,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 // #endif
                 }
             }
-        } else if ( hashmapp( store ) ) {
+        } else if ( hashmapp( store ) || namespacep( store ) ) {
             result = hashmap_get( store, key );
         } else if ( !nilp( store ) ) {
 // #ifdef DEBUG        
@@ -426,7 +453,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = vectorpointp( store );
+    bool deep = eq( store, oblist);
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -480,7 +507,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound
+         * not currently bound. TODO: should this bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/intern.h b/src/ops/intern.h
index bc22bf7..4043e66 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -49,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer environment );
+
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 7333c3f..be4227b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -517,8 +517,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
         case SYMBOLTV:
             {
-                struct cons_pointer canonical =
-                    internedp( frame->arg[0], env );
+                struct cons_pointer canonical = interned( frame->arg[0], env );
                 if ( nilp( canonical ) ) {
                     struct cons_pointer message =
                         make_cons( c_string_to_lisp_string
@@ -835,7 +834,35 @@ struct cons_pointer lisp_length( struct stack_frame *frame,
 struct cons_pointer
 lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    return c_assoc( frame->arg[0], frame->arg[1] );
+    return c_assoc( frame->arg[0],
+                    nilp( frame->arg[1] ) ? oblist : frame->arg[1] );
+}
+
+/**
+ * @brief `(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.
+ * 
+ * @param frame 
+ * @param frame_pointer 
+ * @param env 
+ * @return struct cons_pointer 
+ */
+struct cons_pointer
+lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                struct cons_pointer env ) {
+    struct cons_pointer result = internedp( frame->arg[0],
+                                            nilp( frame->
+                                                  arg[1] ) ? oblist : frame->
+                                            arg[1] );
+
+    if ( exceptionp( result ) ) {
+        struct cons_pointer old = result;
+        struct cons_space_object *cell = &( pointer2cell( result ) );
+        result =
+            throw_exception( cell->payload.exception.payload, frame_pointer );
+        dec_ref( old );
+    }
+
+    return result;
 }
 
 struct cons_pointer c_keys( struct cons_pointer store ) {
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index aea8772..06407c2 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -131,6 +131,9 @@ struct cons_pointer lisp_cdr( struct stack_frame *frame,
 struct cons_pointer lisp_inspect( struct stack_frame *frame,
                                   struct cons_pointer frame_pointer,
                                   struct cons_pointer env );
+struct cons_pointer lisp_internedp( struct stack_frame *frame,
+                                    struct cons_pointer frame_pointer,
+                                    struct cons_pointer env );
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env );

From 54f6f023c63035567ca88e89ab398d0a970f1b67 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 12:24:59 +0000
Subject: [PATCH 02/19] More debugging output. Getting desperate!

---
 src/io/io.c       |  4 ++--
 src/memory/dump.c |  8 ++++----
 src/ops/intern.c  | 39 ++++++++++++++++++++-------------------
 src/ops/lispops.c | 24 ++++++++++--------------
 4 files changed, 36 insertions(+), 39 deletions(-)

diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 39e121f..5a81fb3 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -278,19 +278,22 @@ struct cons_pointer interned( struct cons_pointer key,
                               struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
+    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     if ( symbolp( key ) || keywordp( key ) ) {
         struct cons_space_object *cell = &pointer2cell( store );
 
         switch ( cell->tag.value ) {
             case CONSTV:
                 for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next );
-                      next = c_cdr( next) ) {
+                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
                     if ( !nilp( next ) ) {
                         // struct cons_space_object entry =
                         //     pointer2cell( c_car( next) );
 
-                        if ( equal( key, c_car(next) ) ) {
+                        if ( equal( key, c_car( next ) ) ) {
                             result = key;
                         }
                     }
@@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key,
                              NIL );
     }
 
+    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     return result;
 }
 
@@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
+    debug_print(L"hashmap_put:\n", DEBUG_BIND);
+    debug_dump_object( mapp, DEBUG_BIND);
+
     return mapp;
 }
 
-    /**
-     * Return a new key/value store containing all the key/value pairs in this
-     * store with this key/value pair added to the front.
-     */
+/**
+ * If this store is modifiable, add this key value pair to it. Otherwise,
+ * return a new key/value store containing all the key/value pairs in this
+ * store with this key/value pair added to the front.
+ */
 struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                          struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = eq( store, oblist);
+    bool deep = eq( store, oblist );
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                       pointer2cell( store ).payload.vectorp.tag.bytes );
     }
 #endif
-    if ( nilp( value ) ) {
-        result = store;
-    } else if ( nilp( store ) || consp( store ) ) {
+    if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
         result = hashmap_put( store, key, value );
@@ -479,16 +488,8 @@ struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     debug_print( L"Entering deep_bind\n", DEBUG_BIND );
 
-    struct cons_pointer old = oblist;
-
     oblist = set( key, value, oblist );
 
-    // The oblist is not now an assoc list, and I don't think it will be again.
-    // if ( consp( oblist ) ) {
-    //     inc_ref( oblist );
-    //     dec_ref( old );
-    // }
-
     debug_print( L"deep_bind returning ", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
     debug_println( DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index be4227b..4a89d98 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.
-                              special.executable ) ( get_stack_frame
-                                                     ( next_pointer ),
-                                                     next_pointer, env );
+                            ( *fn_cell.payload.special.
+                              executable ) ( get_stack_frame( next_pointer ),
+                                             next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -850,9 +849,8 @@ struct cons_pointer
 lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer result = internedp( frame->arg[0],
-                                            nilp( frame->
-                                                  arg[1] ) ? oblist : frame->
-                                            arg[1] );
+                                            nilp( frame->arg[1] ) ? oblist :
+                                            frame->arg[1] );
 
     if ( exceptionp( result ) ) {
         struct cons_pointer old = result;
@@ -1313,8 +1311,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1497,14 +1494,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From a1c377bc7c7ded8b175a346e9028212db418bc51 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 15:15:42 +0000
Subject: [PATCH 03/19] Established intern bug is in getting, not setting;
 improved exceptions.

---
 src/arith/peano.c            |  36 ++++--
 src/arith/ratio.c            |  16 ++-
 src/init.c                   |  10 +-
 src/io/read.c                |  15 ++-
 src/memory/consspaceobject.c |  14 +++
 src/memory/consspaceobject.h |  17 +++
 src/ops/intern.c             |  21 ++--
 src/ops/lispops.c            | 206 ++++++++++++++++++++++++-----------
 src/ops/lispops.h            |   3 +-
 9 files changed, 241 insertions(+), 97 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 995ce0f..3e85412 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,7 +296,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -319,7 +320,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -332,7 +334,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -428,7 +431,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -454,7 +458,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -467,7 +472,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -620,7 +626,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -650,7 +657,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -661,7 +669,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -732,7 +741,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -762,7 +772,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -774,7 +785,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 1c20a4f..011ef43 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,7 +114,9 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( make_cons( c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( 
+                            c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -154,7 +156,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -234,7 +237,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -269,7 +273,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -337,7 +342,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
+                            c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 5febcbc..8c8da7c 100644
--- a/src/init.c
+++ b/src/init.c
@@ -84,12 +84,18 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
+    // we can't make this string when we need it, because memory is then 
+    // exhausted!
     if ( nilp( privileged_string_memory_exhausted ) ) {
-        // we can't make this string when we need it, because memory is then 
-        // exhausted!
         privileged_string_memory_exhausted =
             c_string_to_lisp_string( L"Memory exhausted." );
     }
+    if ( nilp( privileged_keyword_location ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
+    }
+    if ( nilp( privileged_keyword_payload ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/io/read.c b/src/io/read.c
index 9ca49f0..5ffb143 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,7 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -177,7 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -266,7 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception( make_cons( c_string_to_lisp_string
+                        throw_exception(c_string_to_lisp_symbol( L"read"),
+                             make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -313,7 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -324,7 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8c4c5c0..c461f10 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -27,6 +27,20 @@
 #include "memory/vectorspace.h"
 #include "ops/intern.h"
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`q.v.
+ */
+struct cons_pointer privileged_keyword_location = NIL;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`, q.v.
+ */
+struct cons_pointer privileged_keyword_payload = NIL;
+
+
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index adde136..bddd232 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -56,6 +56,18 @@
  */
 #define EXCEPTIONTV 1346721861
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_location;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_payload;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
@@ -296,6 +308,11 @@
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
+
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 5a81fb3..2764bae 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,7 +311,8 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( make_cons
+                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                          ( c_string_to_lisp_string
                                            ( L"Unexpected store type: " ),
                                            c_type( store ) ), NIL );
@@ -319,7 +320,8 @@ struct cons_pointer interned( struct cons_pointer key,
                 break;
             default:
                 result =
-                    throw_exception( make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -327,7 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -389,7 +392,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_append
+                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
+                            c_append
                                              ( c_string_to_lisp_string
                                                ( L"Store entry is of unknown type: " ),
                                                c_type( entry_ptr ) ), NIL );
@@ -413,7 +417,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_append
+                throw_exception( c_string_to_lisp_symbol(L"assoc"),
+                    c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
@@ -448,8 +453,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
-    debug_print(L"hashmap_put:\n", DEBUG_BIND);
-    debug_dump_object( mapp, DEBUG_BIND);
+    debug_print( L"hashmap_put:\n", DEBUG_BIND );
+    debug_dump_object( mapp, DEBUG_BIND );
 
     return mapp;
 }
@@ -508,7 +513,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound. TODO: should this bind to NIL?
+         * not currently bound. TODO: this should bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4a89d98..3cb0287 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -248,7 +248,7 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * Evaluate a lambda or nlambda expression.
  */
 struct cons_pointer
-eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
+eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
              struct cons_pointer frame_pointer, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
 #ifdef DEBUG
@@ -257,8 +257,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 #endif
 
     struct cons_pointer new_env = env;
-    struct cons_pointer names = cell.payload.lambda.args;
-    struct cons_pointer body = cell.payload.lambda.body;
+    struct cons_pointer names = cell->payload.lambda.args;
+    struct cons_pointer body = cell->payload.lambda.body;
 
     if ( consp( names ) ) {
         /* if `names` is a list, bind successive items from that list
@@ -328,6 +328,57 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
     return result;
 }
 
+/**
+ * if `r` is an exception, and it doesn't have a location, fix up its location from
+ * the name associated with this fn_pointer, if any. 
+ */
+struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
+                                                    struct cons_pointer
+                                                    fn_pointer ) {
+    struct cons_pointer result = r;
+        
+    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
+
+        struct cons_pointer payload =
+            pointer2cell( result ).payload.exception.payload;
+        /* TODO: should name_key also be a privileged keyword? */
+        struct cons_pointer name_key =
+                        c_string_to_lisp_keyword( L"name" );
+
+        switch ( get_tag_value( payload ) ) {
+            case NILTV:
+            case CONSTV:
+            case HASHTV:
+                {
+                    if ( nilp( c_assoc( privileged_keyword_location ,
+                           payload ) )) {
+                        pointer2cell( result ).payload.exception.payload =
+                            set( privileged_keyword_location,
+                                    c_assoc( name_key,
+                                             fn_cell->payload.function.meta ),
+                                    payload );
+                    }
+                }
+                break;
+            default:
+                pointer2cell( result ).payload.exception.payload =
+                    make_cons( 
+                        make_cons( privileged_keyword_location,
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ) ),
+                               make_cons( 
+                                    make_cons( privileged_keyword_payload,
+                                            payload ) , 
+                                            NIL ));
+        }
+
+        dec_ref( name_key);
+    }
+
+    return result;
+}
+
 
 /**
  * Internal guts of apply.
@@ -348,10 +399,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( exceptionp( fn_pointer ) ) {
         result = fn_pointer;
     } else {
-        struct cons_space_object fn_cell = pointer2cell( fn_pointer );
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
         struct cons_pointer args = c_cdr( frame->arg[0] );
 
-        switch ( fn_cell.tag.value ) {
+        switch ( get_tag_value( fn_pointer ) ) {
             case EXCEPTIONTV:
                 /* just pass exceptions straight back */
                 result = fn_pointer;
@@ -369,10 +420,15 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         struct stack_frame *next =
                             get_stack_frame( next_pointer );
 
-                        result =
-                            ( *fn_cell.payload.function.executable ) ( next,
-                                                                       next_pointer,
-                                                                       env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
+                                                                 ( next,
+                                                                   next_pointer,
+                                                                   env ),
+                                                                 fn_pointer );
                         dec_ref( next_pointer );
                     }
                 }
@@ -406,18 +462,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 }
                 break;
 
-            case VECTORPOINTTV:
-                switch ( pointer_to_vso( fn_pointer )->header.tag.value ) {
-                    case HASHTV:
-                        /* \todo: if arg[0] is a CONS, treat it as a path */
-                        result = c_assoc( eval_form( frame,
-                                                     frame_pointer,
-                                                     c_car( c_cdr
-                                                            ( frame->arg
-                                                              [0] ) ), env ),
-                                          fn_pointer );
-                        break;
-                }
+            case HASHTV:
+                /* \todo: if arg[0] is a CONS, treat it as a path */
+                result = c_assoc( eval_form( frame,
+                                             frame_pointer,
+                                             c_car( c_cdr
+                                                    ( frame->arg
+                                                      [0] ) ), env ),
+                                  fn_pointer );
                 break;
 
             case NLAMBDATV:
@@ -441,14 +493,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+                    // inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
-                        result =
-                            ( *fn_cell.payload.special.
-                              executable ) ( get_stack_frame( next_pointer ),
-                                             next_pointer, env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
+                                                                 ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -464,13 +518,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     memset( buffer, '\0', bs );
                     swprintf( buffer, bs,
                               L"Unexpected cell with tag %d (%4.4s) in function position",
-                              fn_cell.tag.value, &fn_cell.tag.bytes[0] );
+                              fn_cell->tag.value, &( fn_cell->tag.bytes[0] ) );
                     struct cons_pointer message =
                         c_string_to_lisp_string( buffer );
                     free( buffer );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"apply" ),
+                                         message, frame_pointer );
                 }
         }
+
     }
 
     debug_print( L"c_apply: returning: ", DEBUG_EVAL );
@@ -507,9 +564,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
     debug_dump_object( frame_pointer, DEBUG_EVAL );
 
     struct cons_pointer result = frame->arg[0];
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
             result = c_apply( frame, frame_pointer, env );
             break;
@@ -522,7 +579,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         make_cons( c_string_to_lisp_string
                                    ( L"Attempt to take value of unbound symbol." ),
                                    frame->arg[0] );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"eval" ),
+                                         message, frame_pointer );
                 } else {
                     result = c_assoc( canonical, env );
                     inc_ref( result );
@@ -623,7 +682,8 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = frame->arg[1];
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -662,7 +722,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = val;
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set!" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set!` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -734,24 +795,25 @@ struct cons_pointer
 lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.car;
+            result = cell->payload.cons.car;
             break;
         case NILTV:
             break;
         case READTV:
             result =
-                make_string( url_fgetwc( cell.payload.stream.stream ), NIL );
+                make_string( url_fgetwc( cell->payload.stream.stream ), NIL );
             break;
         case STRINGTV:
-            result = make_string( cell.payload.string.character, NIL );
+            result = make_string( cell->payload.string.character, NIL );
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"car" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CAR of non sequence" ),
                                  frame_pointer );
     }
@@ -778,24 +840,25 @@ struct cons_pointer
 lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.cdr;
+            result = cell->payload.cons.cdr;
             break;
         case NILTV:
             break;
         case READTV:
-            url_fgetwc( cell.payload.stream.stream );
+            url_fgetwc( cell->payload.stream.stream );
             result = frame->arg[0];
             break;
         case STRINGTV:
-            result = cell.payload.string.cdr;
+            result = cell->payload.string.cdr;
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"cdr" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CDR of non sequence" ),
                                  frame_pointer );
     }
@@ -856,7 +919,8 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
         struct cons_pointer old = result;
         struct cons_space_object *cell = &( pointer2cell( result ) );
         result =
-            throw_exception( cell->payload.exception.payload, frame_pointer );
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             cell->payload.exception.payload, frame_pointer );
         dec_ref( old );
     }
 
@@ -1213,7 +1277,8 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
 #endif
         }
     } else {
-        result = throw_exception( c_string_to_lisp_string
+        result = throw_exception( c_string_to_lisp_symbol( L"cond" ),
+                                  c_string_to_lisp_string
                                   ( L"Arguments to `cond` must be lists" ),
                                   frame_pointer );
     }
@@ -1271,18 +1336,25 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * pointer to the frame in which the exception occurred.
  */
 struct cons_pointer
-throw_exception( struct cons_pointer message,
+throw_exception( struct cons_pointer location,
+                 struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
     debug_print( L"\nERROR: ", DEBUG_EVAL );
     debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
-    struct cons_space_object cell = pointer2cell( message );
+    struct cons_space_object *cell = &pointer2cell( message );
 
-    if ( cell.tag.value == EXCEPTIONTV ) {
+    if ( cell->tag.value == EXCEPTIONTV ) {
         result = message;
     } else {
-        result = make_exception( message, frame_pointer );
+        result =
+            make_exception( make_cons
+                            ( make_cons( privileged_keyword_location,
+                                         location ),
+                              make_cons( make_cons
+                                         ( privileged_keyword_payload,
+                                           message ), NIL ) ), frame_pointer );
     }
 
     return result;
@@ -1295,7 +1367,7 @@ throw_exception( struct cons_pointer message,
  * normally return. A function which detects a problem it cannot resolve
  * *should* return an exception.
  *
- * * (exception message frame)
+ * * (exception message location)
  *
  * @param frame my stack frame.
  * @param frame_pointer a pointer to my stack_frame.
@@ -1310,7 +1382,9 @@ struct cons_pointer
 lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
+
     return exceptionp( message ) ? message : throw_exception( message,
+                                                              frame->arg[1],
                                                               frame->previous );
 }
 
@@ -1444,24 +1518,24 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
                                  struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
     struct cons_pointer source_key = c_string_to_lisp_keyword( L"source" );
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case FUNCTIONTV:
-            result = c_assoc( source_key, cell.payload.function.meta );
+            result = c_assoc( source_key, cell->payload.function.meta );
             break;
         case SPECIALTV:
-            result = c_assoc( source_key, cell.payload.special.meta );
+            result = c_assoc( source_key, cell->payload.special.meta );
             break;
         case LAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"lambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
         case NLAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"nlambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
     }
     // \todo suffers from premature GC, and I can't see why!
@@ -1484,7 +1558,8 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                       c_append( c_cdr( l1 ), l2 ) );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
@@ -1505,12 +1580,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                                 pointer2cell( l1 ).tag.value );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
         default:
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"append" ),
+                             c_string_to_lisp_string
                              ( L"Can't append: not a sequence" ), NIL );
             break;
     }
@@ -1622,7 +1699,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
             bindings = make_cons( make_cons( symbol, val ), bindings );
         } else {
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"let" ),
+                                 c_string_to_lisp_string
                                  ( L"Let: cannot bind, not a symbol" ),
                                  frame_pointer );
             break;
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 06407c2..da2428a 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -196,7 +196,8 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
  * signature of a lisp function; but it is nevertheless to be preferred to
  * make_exception. A real `throw_exception`, which does, will be needed.
  */
-struct cons_pointer throw_exception( struct cons_pointer message,
+struct cons_pointer throw_exception( struct cons_pointer location,
+                                     struct cons_pointer message,
                                      struct cons_pointer frame_pointer );
 
 struct cons_pointer lisp_exception( struct stack_frame *frame,

From bcb227a5f99b172b48e629dd88941f5eebdcf21b Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 18:09:48 +0000
Subject: [PATCH 04/19] Still not working, but I have increasing confidence I'm
 on the right track.

---
 src/arith/peano.c            | 58 +++++++++++++++++++-----------------
 src/arith/ratio.c            | 21 +++++++------
 src/init.c                   |  5 +++-
 src/io/io.c                  |  4 +--
 src/io/read.c                | 20 ++++++-------
 src/memory/consspaceobject.c |  8 ++---
 src/memory/dump.c            |  8 ++---
 src/memory/stack.c           |  4 +++
 src/ops/intern.c             | 33 ++++++++++----------
 src/ops/lispops.c            | 57 ++++++++++++++++-------------------
 10 files changed, 110 insertions(+), 108 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 3e85412..9a1b478 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,10 +296,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -320,10 +321,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -334,8 +336,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                     c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -431,8 +433,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -458,8 +460,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -472,8 +474,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                          make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -626,8 +628,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -657,8 +659,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -669,8 +671,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -741,8 +743,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -772,8 +774,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -785,8 +787,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 011ef43..82f9138 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,9 +114,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( 
-                            c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -156,8 +155,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -237,8 +236,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -273,8 +272,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -342,8 +341,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio" ),
+                             c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 8c8da7c..04eeeed 100644
--- a/src/init.c
+++ b/src/init.c
@@ -293,6 +293,8 @@ int main( int argc, char *argv[] ) {
      */
     bind_symbol_value( privileged_symbol_nil, NIL, true );
     bind_value( L"t", TRUE, true );
+    bind_symbol_value( privileged_keyword_location, TRUE, true );
+    bind_symbol_value( privileged_keyword_payload, TRUE, true );
 
     /*
      * standard input, output, error and sink streams
@@ -413,7 +415,8 @@ int main( int argc, char *argv[] ) {
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
-    bind_function( L"list", L"`(list args...): Return a list of these `args`.",
+    bind_function( L"list",
+                   L"`(list args...)`: Return a list of these `args`.",
                    &lisp_list );
     bind_function( L"mapcar",
                    L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.",
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/io/read.c b/src/io/read.c
index 5ffb143..fee80b3 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,8 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read" ),
+                             c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -178,8 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                          c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -268,8 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception(c_string_to_lisp_symbol( L"read"),
-                             make_cons( c_string_to_lisp_string
+                        throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                         make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -316,8 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -328,8 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index c461f10..2848b83 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -39,8 +39,6 @@ struct cons_pointer privileged_keyword_location = NIL;
  */
 struct cons_pointer privileged_keyword_payload = NIL;
 
-
-
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
@@ -49,11 +47,11 @@ struct cons_pointer privileged_keyword_payload = NIL;
 bool check_tag( struct cons_pointer pointer, uint32_t value ) {
     bool result = false;
 
-    struct cons_space_object cell = pointer2cell( pointer );
-    result = cell.tag.value == value;
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    result = cell->tag.value == value;
 
     if ( result == false ) {
-        if ( cell.tag.value == VECTORPOINTTV ) {
+        if ( cell->tag.value == VECTORPOINTTV ) {
             struct vector_space_object *vec = pointer_to_vso( pointer );
 
             if ( vec != NULL ) {
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index b6833c9..7f5d581 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -161,6 +161,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                                 env );
                 frame->more = more;
                 inc_ref( more );
+
+                for ( ; !nilp( args ); args = c_cdr( args ) ) {
+                    frame->args++;
+                }
             }
         }
         debug_print( L"make_stack_frame: returning\n", DEBUG_STACK );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 2764bae..ee15485 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,17 +311,17 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
-                                         ( c_string_to_lisp_string
-                                           ( L"Unexpected store type: " ),
-                                           c_type( store ) ), NIL );
+                        throw_exception( c_string_to_lisp_symbol
+                                         ( L"interned?" ),
+                                         make_cons( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( store ) ), NIL );
                 }
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                                     make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -329,8 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -392,11 +392,12 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
-                            c_append
-                                             ( c_string_to_lisp_string
-                                               ( L"Store entry is of unknown type: " ),
-                                               c_type( entry_ptr ) ), NIL );
+                            throw_exception( c_string_to_lisp_symbol
+                                             ( L"assoc" ),
+                                             c_append( c_string_to_lisp_string
+                                                       ( L"Store entry is of unknown type: " ),
+                                                       c_type( entry_ptr ) ),
+                                             NIL );
                     }
 
 // #ifdef DEBUG
@@ -417,8 +418,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_string_to_lisp_symbol(L"assoc"),
-                    c_append
+                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
+                                 c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 3cb0287..98497f6 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -336,44 +336,43 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                                                     struct cons_pointer
                                                     fn_pointer ) {
     struct cons_pointer result = r;
-        
-    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+
+    if ( exceptionp( result )
+         && ( functionp( fn_pointer ) || specialp( fn_pointer ) ) ) {
         struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
 
         struct cons_pointer payload =
             pointer2cell( result ).payload.exception.payload;
         /* TODO: should name_key also be a privileged keyword? */
-        struct cons_pointer name_key =
-                        c_string_to_lisp_keyword( L"name" );
+        struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
 
         switch ( get_tag_value( payload ) ) {
             case NILTV:
             case CONSTV:
             case HASHTV:
                 {
-                    if ( nilp( c_assoc( privileged_keyword_location ,
-                           payload ) )) {
+                    if ( nilp( c_assoc( privileged_keyword_location,
+                                        payload ) ) ) {
                         pointer2cell( result ).payload.exception.payload =
                             set( privileged_keyword_location,
-                                    c_assoc( name_key,
-                                             fn_cell->payload.function.meta ),
-                                    payload );
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ),
+                                 payload );
                     }
                 }
                 break;
             default:
                 pointer2cell( result ).payload.exception.payload =
-                    make_cons( 
-                        make_cons( privileged_keyword_location,
-                                 c_assoc( name_key,
-                                          fn_cell->payload.function.meta ) ),
-                               make_cons( 
-                                    make_cons( privileged_keyword_payload,
-                                            payload ) , 
-                                            NIL ));
+                    make_cons( make_cons( privileged_keyword_location,
+                                          c_assoc( name_key,
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
+                               make_cons( make_cons
+                                          ( privileged_keyword_payload,
+                                            payload ), NIL ) );
         }
 
-        dec_ref( name_key);
+        dec_ref( name_key );
     }
 
     return result;
@@ -421,10 +420,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -498,10 +494,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1385,7 +1378,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1569,13 +1563,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 3a1f64d7ffc17bc5b2a1b1d0bd187d073d336693 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sun, 1 Mar 2026 20:04:21 +0000
Subject: [PATCH 05/19] Well, I'm back to the same failed unit tests as the
 develop branch

and I *feel* that the intern code is better. But it's not without
problems and I don't think I can release at this. But it may be
ready to merge back.
---
 docs/Interning-strings.md    |  44 +++----
 lisp/documentation.lisp      |  29 +++++
 src/debug.c                  |  19 +++
 src/debug.h                  |   1 +
 src/init.c                   |   2 +-
 src/io/io.c                  |   4 +-
 src/io/print.c               |   2 +-
 src/memory/conspage.c        |   5 +-
 src/memory/consspaceobject.c |  31 +++--
 src/memory/consspaceobject.h |  10 +-
 src/memory/dump.c            |   8 +-
 src/ops/equal.c              |   4 +-
 src/ops/intern.c             | 227 ++++++++++++++++++-----------------
 src/ops/intern.h             |  11 +-
 src/ops/lispops.c            |  71 ++++++++---
 15 files changed, 284 insertions(+), 184 deletions(-)

diff --git a/docs/Interning-strings.md b/docs/Interning-strings.md
index b92ded5..af135a1 100644
--- a/docs/Interning-strings.md
+++ b/docs/Interning-strings.md
@@ -12,58 +12,50 @@ causes an unbound variable exception to be thrown, while
 
 returns the value **"froboz"**. This begs the question of whether there's any difference between **"froboz"** and **'froboz**, and the answer is that at this point I don't know.
 
-There will be a concept of a root [namespace](Namespace.html), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
+There will be a concept of a root [namespace](Namespace.md), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
 
 There must be some notation to say distinguish a request for the value of a name in the root namespace and the value of a name in the current namespace. For now I'm proposing that:
 
-    (eval froboz)
+    (eval 'froboz)
 
 will return the value that **froboz** is bound to in the current namespace;
 
-    (eval .froboz)
+    (eval ::/froboz)
 
 will return the value that **froboz** is bound to in the root namespace;
 
-    (eval foobar.froboz)
+    (eval 'foobar/froboz)
 
 will return the value that **froboz** is bound to in a namespace which is the value of the name **foobar** in the current namespace; and that
 
-    (eval .system.users.simon.environment.froboz)
+    (eval ::users:simon:environment/froboz)
 
-will return the value that **froboz** is bound to in the environment of the user of the system called **simon**.
+will return the value that **froboz** is bound to in the environment of the user of the system called **simon** (if that is readable by you).
 
-The exact path separator syntax may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
+The [exact path separator syntax](Paths.md) may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
 
-Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.html) of individual path elements.
+Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.md) of individual path elements.
 
 Obviously this means there may be arbitrarily many paths which reference the same data item. This is intended.
 
 ## Related functions
 
-### (intern! string)
+### (intern! path)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
-### (intern! string T)
+### (intern! path T)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
-### (intern! string T write-access-list)
-
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [access control](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **:friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
 ### (set! string value)
 
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
 ### (set! string value T)
 
 Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
-### (set! string value T write-access-list)
-
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [access control](Access-control.html) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
 ### (put! string token value)
 
 Considers *string* as the path to some namespace, and binds *token* in that namespace to *value*. *Token* should not contain any path separator syntax. If the namespace doesn't exist or if the current user is not entitled to write to the namespace, throws an exception.
@@ -71,16 +63,16 @@ Considers *string* as the path to some namespace, and binds *token* in that name
 ### (string-to-path string)
 
 Behaviour as follows:
-    (string-to-path "foo.bar.ban") => ("foo" "bar" "ban")
-    (string-to-path ".foo.bar.ban") => ("" "foo" "bar" "ban")
+    (string-to-path ":foo:bar/ban") => (-> (environment) :foo :bar 'ban)
+    (string-to-path "::foo:bar/ban") => (-> (oblist) :foo :bar 'ban)
 
-Obviously if the current user can't read the string, throws an exception.
+Obviously if the current user can't read the string, throws an exception. `(oblist)` is currently (version 0.0.6) a function which returns the current value of the root namespace; `(environment)` is a proposed function which returns the current value of the environment of current user (with possibly `(environmnt user-name)` returning the value of the environment of the user indicated by `user-name`, if that is readable by you). The symbol `->` represents a threading macro [similar to Clojure's](https://clojuredocs.org/clojure.core/-%3E).
 
 ### (path-to-string list-of-strings)
 
 Behaviour as follows:
-    (path-to-string '("foo" "bar" "ban")) => "foo.bar.ban"
-    (path-to-string '("" "foo" "bar" "ban")) => ".foo.bar.ban"
+    (path-to-string '(:foo :bar 'ban)) => ":foo:bar/ban"
+    (path-to-string '("" :foo :bar 'ban)) => "::foo:bar/ban"
 
 Obviously if the current user can't read some element of *list-of-strings*, throws an exception.
 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 33fd1e5..7f5867b 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -3,6 +3,31 @@
 ;; `nth` (from `nth.lisp`)
 ;; `string?` (from `types.lisp`)
 
+(set! nil? (lambda 
+          (o) 
+          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
+          (= o nil)))
+
+(set! member? (lambda
+            (item collection)
+            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+            ;; (print (list "In member? item is " item "; collection is " collection))
+            ;; (println)
+            (cond
+              ((= nil collection) nil)
+              ((= item (car collection)) t)
+              (t (member? item (cdr collection))))))
+
+;; (member? (type member?) '("LMDA" "NLMD"))
+
+(set! nth (lambda (n l) 
+    "Return the `n`th member of this list `l`, or `nil` if none."
+    (cond ((= nil l) nil)
+        ((= n 1) (car l))
+        (t (nth (- n 1) (cdr l))))))
+
+(set! string? (lambda (o) "True if `o` is a string." (= (type o) "STRG") ) )
+
 (set! documentation (lambda (object)
     "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
    (cond ((member? (type object) '("FUNC" "SPFM"))
@@ -15,3 +40,7 @@
 
 (set! doc documentation)
 
+(documentation apply)
+
+;; (documentation member?)
+
diff --git a/src/debug.c b/src/debug.c
index 1b895c2..631149d 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -32,6 +32,25 @@
  */
 int verbosity = 0;
 
+/**
+ * When debugging, we want to see exceptions as they happen, because they may
+ * not make their way back down the stack to whatever is expected to handle
+ * them.
+ */
+void debug_print_exception( struct cons_pointer ex_ptr ) {
+#ifdef DEBUG
+    if ( ( verbosity != 0 ) && exceptionp( ex_ptr ) ) {
+        fwide( stderr, 1 );
+        fputws( L"EXCEPTION: ", stderr );
+
+        URL_FILE *ustderr = file_to_url_file( stderr );
+        fwide( stderr, 1 );
+        print( ustderr, ex_ptr );
+        free( ustderr );
+    }
+#endif
+}
+
 /**
  * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
  *
diff --git a/src/debug.h b/src/debug.h
index ef3799d..2e59932 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -81,6 +81,7 @@
 
 extern int verbosity;
 
+void debug_print_exception( struct cons_pointer ex_ptr );
 void debug_print( wchar_t *message, int level );
 void debug_print_128bit( __int128_t n, int level );
 void debug_println( int level );
diff --git a/src/init.c b/src/init.c
index 04eeeed..74b6d94 100644
--- a/src/init.c
+++ b/src/init.c
@@ -325,7 +325,7 @@ int main( int argc, char *argv[] ) {
                                                   ( c_string_to_lisp_keyword
                                                     ( L"url" ),
                                                     c_string_to_lisp_string
-                                                    ( L"system:standard output]" ) ),
+                                                    ( L"system:standard output" ) ),
                                                   NIL ) ), false );
     bind_value( L"*log*",
                 make_write_stream( file_to_url_file( stderr ),
diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/io/print.c b/src/io/print.c
index fdd6ed4..a8f2770 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -101,7 +101,7 @@ void print_map( URL_FILE *output, struct cons_pointer map ) {
             struct cons_pointer key = c_car( ks );
             print( output, key );
             url_fputwc( btowc( ' ' ), output );
-            print( output, hashmap_get( map, key ) );
+            print( output, hashmap_get( map, key, false ) );
 
             if ( !nilp( c_cdr( ks ) ) ) {
                 url_fputws( L", ", output );
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index d7d5cd0..3d96647 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -250,8 +250,9 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
             total_cells_allocated++;
 
             debug_printf( DEBUG_ALLOC,
-                          L"Allocated cell of type '%4.4s' at %d, %d \n",
-                          cell->tag.bytes, result.page, result.offset );
+                          L"Allocated cell of type %4.4s at %u, %u \n",
+                          ( ( char * ) cell->tag.bytes ), result.page,
+                          result.offset );
         } else {
             debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
         }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 2848b83..3d8fe78 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -78,7 +78,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
         cell->count++;
 #ifdef DEBUG
         debug_printf( DEBUG_ALLOC,
-                      L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d",
+                      L"\nIncremented cell of type %4.4s at page %u, offset %u to count %u",
                       ( ( char * ) cell->tag.bytes ), pointer.page,
                       pointer.offset, cell->count );
         if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
@@ -131,6 +131,19 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
     return pointer;
 }
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer ) {
+    uint32_t result = pointer2cell( pointer ).tag.value;
+
+    if ( result == VECTORPOINTTV ) {
+        result = pointer_to_vso( pointer )->header.tag.value;
+    }
+
+    return result;
+}
+
 /**
  * Get the Lisp type of the single argument.
  * @param pointer a pointer to the object whose type is requested.
@@ -399,15 +412,15 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
     if ( tag == SYMBOLTV || tag == KEYTV ) {
         result = make_string_like_thing( c, tail, tag );
 
-        if ( tag == KEYTV ) {
-            struct cons_pointer r = interned( result, oblist );
+        // if ( tag == KEYTV ) {
+        //     struct cons_pointer r = interned( result, oblist );
 
-            if ( nilp( r ) ) {
-                intern( result, oblist );
-            } else {
-                result = r;
-            }
-        }
+        //     if ( nilp( r ) ) {
+        //         intern( result, oblist );
+        //     } else {
+        //         result = r;
+        //     }
+        // }
     } else {
         result =
             make_exception( c_string_to_lisp_string
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index bddd232..1357f34 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -308,11 +308,6 @@ extern struct cons_pointer privileged_keyword_payload;
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
-/**
- * given a cons_pointer as argument, return the tag.
- */
-#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
-
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
@@ -727,6 +722,11 @@ struct cons_pointer inc_ref( struct cons_pointer pointer );
 
 struct cons_pointer dec_ref( struct cons_pointer pointer );
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer );
+
 struct cons_pointer c_type( struct cons_pointer pointer );
 
 struct cons_pointer c_car( struct cons_pointer arg );
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index ea813a9..b2d0fa2 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -272,7 +272,9 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
 
         for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
             struct cons_pointer key = c_car( i );
-            if ( !equal( hashmap_get( a, key ), hashmap_get( b, key ) ) ) {
+            if ( !equal
+                 ( hashmap_get( a, key, false ),
+                   hashmap_get( b, key, false ) ) ) {
                 result = false;
                 break;
             }
diff --git a/src/ops/intern.c b/src/ops/intern.c
index ee15485..ae9800a 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -205,7 +205,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
             for ( struct cons_pointer keys = hashmap_keys( assoc );
                   !nilp( keys ); keys = c_cdr( keys ) ) {
                 struct cons_pointer key = c_car( keys );
-                hashmap_put( mapp, key, hashmap_get( assoc, key ) );
+                hashmap_put( mapp, key, hashmap_get( assoc, key, false ) );
             }
         }
     }
@@ -216,17 +216,33 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
 /** Get a value from a hashmap. 
   *
   * Note that this is here, rather than in memory/hashmap.c, because it is 
-  * closely tied in with c_assoc, q.v.
+  * closely tied in with search_store, q.v.
   */
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key ) {
+                                 struct cons_pointer key, bool return_key ) {
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get: key is `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( mapp ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
+
     struct cons_pointer result = NIL;
     if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) {
         struct vector_space_object *map = pointer_to_vso( mapp );
         uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
 
-        result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] );
+        result =
+            search_store( key, map->payload.hashmap.buckets[bucket_no],
+                          return_key );
     }
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get returning: `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+#endif
 
     return result;
 }
@@ -267,82 +283,134 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
     return result;
 }
 
-// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
-
 /**
- * If this key is lexically identical to a key in this store, return the key
- * from the store (so that later when we want to retrieve a value, an eq test
- * will work); otherwise return NIL.
+ * @brief `(search-store key store return-key?)` Search this `store` for this
+ * a key lexically identical to this `key`. 
+ *
+ * If found, then, if `return-key?` is non-nil, return the copy found in the 
+ * `store`, else return the value associated with it.
+ *
+ * At this stage the following structures are legal stores:
+ * 1. an association list comprising (key . value) dotted pairs;
+ * 2. a hashmap;
+ * 3. a namespace (which for these purposes is identical to a hashmap);
+ * 4. a hybrid list comprising both (key . value) pairs and hashmaps as first
+ *    level items;
+ * 5. such a hybrid list, but where the last CDR pointer is to a hashmap
+ *    rather than to a cons sell or to `nil`.
+ *
+ * This is over-complex and type 5 should be disallowed, but it will do for 
+ * now.
  */
-struct cons_pointer interned( struct cons_pointer key,
-                              struct cons_pointer store ) {
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store,
+                                  bool return_key ) {
     struct cons_pointer result = NIL;
 
-    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+#ifdef DEBUG
+    debug_print( L"\nsearch_store; key is `", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
-    debug_print( L"`\n", DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( store ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        struct cons_space_object *cell = &pointer2cell( store );
+        struct cons_space_object *store_cell = &pointer2cell( store );
 
-        switch ( cell->tag.value ) {
+        switch ( get_tag_value( store ) ) {
             case CONSTV:
-                for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
-                    if ( !nilp( next ) ) {
-                        // struct cons_space_object entry =
-                        //     pointer2cell( c_car( next) );
+                for ( struct cons_pointer cursor = store;
+                      nilp( result ) && ( consp( cursor )
+                                          || hashmapp( cursor ) );
+                      cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                    switch ( get_tag_value( cursor ) ) {
+                        case CONSTV:
+                            struct cons_pointer entry_ptr = c_car( cursor );
 
-                        if ( equal( key, c_car( next ) ) ) {
-                            result = key;
-                        }
+                            switch ( get_tag_value( entry_ptr ) ) {
+                                case CONSTV:
+                                    if ( equal( key, c_car( entry_ptr ) ) ) {
+                                        result =
+                                            return_key ? c_car( entry_ptr ) :
+                                            c_cdr( entry_ptr );
+                                    }
+                                    break;
+                                case HASHTV:
+                                case NAMESPACETV:
+                                    // TODO: I think this should be impossible, and we should maybe
+                                    // throw an exception.
+                                    result =
+                                        hashmap_get( entry_ptr, key,
+                                                     return_key );
+                                    break;
+                                default:
+                                    result =
+                                        throw_exception
+                                        ( c_string_to_lisp_symbol
+                                          ( L"search-store (entry)" ),
+                                          make_cons( c_string_to_lisp_string
+                                                     ( L"Unexpected store type: " ),
+                                                     c_type( c_car
+                                                             ( entry_ptr ) ) ),
+                                          NIL );
+
+                            }
+                            break;
+                        case HASHTV:
+                        case NAMESPACETV:
+                            debug_print
+                                ( L"\n\tHashmap as top-level value in list",
+                                  DEBUG_BIND );
+                            result = hashmap_get( cursor, key, return_key );
+                            break;
+                        default:
+                            result =
+                                throw_exception( c_string_to_lisp_symbol
+                                                 ( L"search-store (cursor)" ),
+                                                 make_cons
+                                                 ( c_string_to_lisp_string
+                                                   ( L"Unexpected store type: " ),
+                                                   c_type( cursor ) ), NIL );
                     }
                 }
                 break;
-            case VECTORPOINTTV:
-                if ( hashmapp( store ) || namespacep( store ) ) {
-                    // get the right hash bucket and recursively call interned on that.
-                    struct vector_space_object *map = pointer_to_vso( store );
-                    uint32_t bucket_no =
-                        get_hash( key ) % map->payload.hashmap.n_buckets;
-
-                    result =
-                        interned( key,
-                                  map->payload.hashmap.buckets[bucket_no] );
-                } else {
-                    result =
-                        throw_exception( c_string_to_lisp_symbol
-                                         ( L"interned?" ),
-                                         make_cons( c_string_to_lisp_string
-                                                    ( L"Unexpected store type: " ),
-                                                    c_type( store ) ), NIL );
-                }
+            case HASHTV:
+            case NAMESPACETV:
+                result = hashmap_get( store, key, return_key );
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
-                                     make_cons
-                                     ( c_string_to_lisp_string
-                                       ( L"Unexpected store type: " ),
-                                       c_type( store ) ), NIL );
+                    throw_exception( c_string_to_lisp_symbol
+                                     ( L"search-store (store)" ),
+                                     make_cons( c_string_to_lisp_string
+                                                ( L"Unexpected store type: " ),
+                                                c_type( store ) ), NIL );
                 break;
         }
     } else {
+        // failing with key type NIL here (?). Probably worth dumping the stack?
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+            throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
                              make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
     }
 
-    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print( L"search-store: returning `", DEBUG_BIND );
     debug_print_object( result, DEBUG_BIND );
     debug_print( L"`\n", DEBUG_BIND );
 
     return result;
 }
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
+    return search_store( key, store, true );
+}
+
 /**
  * @brief Implementation of `interned?` in C: predicate wrapped around interned.
  * 
@@ -365,68 +433,7 @@ struct cons_pointer internedp( struct cons_pointer key,
  */
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store ) {
-    struct cons_pointer result = NIL;
-
-    if ( !nilp( key ) ) {
-        if ( consp( store ) ) {
-            for ( struct cons_pointer next = store;
-                  nilp( result ) && ( consp( next ) || hashmapp( next ) );
-                  next = pointer2cell( next ).payload.cons.cdr ) {
-                if ( consp( next ) ) {
-// #ifdef DEBUG
-//                     debug_print( L"\nc_assoc; key is `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"`\n", DEBUG_BIND );
-// #endif
-
-                    struct cons_pointer entry_ptr = c_car( next );
-                    struct cons_space_object entry = pointer2cell( entry_ptr );
-
-                    switch ( entry.tag.value ) {
-                        case CONSTV:
-                            if ( equal( key, entry.payload.cons.car ) ) {
-                                result = entry.payload.cons.cdr;
-                            }
-                            break;
-                        case VECTORPOINTTV:
-                            result = hashmap_get( entry_ptr, key );
-                            break;
-                        default:
-                            throw_exception( c_string_to_lisp_symbol
-                                             ( L"assoc" ),
-                                             c_append( c_string_to_lisp_string
-                                                       ( L"Store entry is of unknown type: " ),
-                                                       c_type( entry_ptr ) ),
-                                             NIL );
-                    }
-
-// #ifdef DEBUG
-//                     debug_print( L"c_assoc `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"` returning: ", DEBUG_BIND );
-//                     debug_print_object( result, DEBUG_BIND );
-//                     debug_println( DEBUG_BIND );
-// #endif
-                }
-            }
-        } else if ( hashmapp( store ) || namespacep( store ) ) {
-            result = hashmap_get( store, key );
-        } else if ( !nilp( store ) ) {
-// #ifdef DEBUG        
-//             debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-//             debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
-//             debug_print( L"`\n", DEBUG_BIND );
-// #endif
-            result =
-                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
-                                 c_append
-                                 ( c_string_to_lisp_string
-                                   ( L"Store is of unknown type: " ),
-                                   c_type( store ) ), NIL );
-        }
-    }
-
-    return result;
+    return search_store( key, store, false );
 }
 
 /**
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 4043e66..18fc084 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -20,6 +20,9 @@
 #ifndef __intern_h
 #define __intern_h
 
+#include <stdbool.h>
+
+
 extern struct cons_pointer privileged_symbol_nil;
 
 extern struct cons_pointer oblist;
@@ -31,7 +34,7 @@ void free_hashmap( struct cons_pointer ptr );
 void dump_map( URL_FILE * output, struct cons_pointer pointer );
 
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
+                                 struct cons_pointer key, bool return_key );
 
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
@@ -46,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
                                   struct cons_pointer hash_fn,
                                   struct cons_pointer write_acl );
 
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store, bool return_key );
+
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
@@ -55,9 +61,6 @@ struct cons_pointer interned( struct cons_pointer key,
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
-struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
-
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
                                  struct cons_pointer val );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 98497f6..c2b0e70 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -365,8 +365,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( name_key,
-                                                   fn_cell->payload.function.
-                                                   meta ) ),
+                                                   fn_cell->payload.
+                                                   function.meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -420,7 +420,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.function.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -494,7 +497,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.special.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1052,11 +1058,15 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
         frame->arg[0] : get_default_stream( true, env );
 
     if ( readp( in_stream ) ) {
-        debug_print( L"lisp_read: setting input stream\n", DEBUG_IO );
+        debug_print( L"lisp_read: setting input stream\n",
+                     DEBUG_IO | DEBUG_REPL );
         debug_dump_object( in_stream, DEBUG_IO );
         input = pointer2cell( in_stream ).payload.stream.stream;
         inc_ref( in_stream );
     } else {
+        /* should not happen, but has done. */
+        debug_print( L"WARNING: invalid input stream; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
         input = file_to_url_file( stdin );
     }
 
@@ -1332,10 +1342,17 @@ struct cons_pointer
 throw_exception( struct cons_pointer location,
                  struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
-    debug_print( L"\nERROR: ", DEBUG_EVAL );
-    debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
+#ifdef DEBUG
+    debug_print( L"\nERROR: `", 511 );
+    debug_print_object( message, 511 );
+    debug_print( L"` at `", 511 );
+    debug_print_object( location, 511 );
+    debug_print( L"`\n", 511 );
+    debug_print_object( location, 511 );
+#endif
+
     struct cons_space_object *cell = &pointer2cell( message );
 
     if ( cell->tag.value == EXCEPTIONTV ) {
@@ -1378,8 +1395,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1399,7 +1415,11 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                                struct cons_pointer env ) {
     struct cons_pointer expr = NIL;
 
-    debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
+#ifdef DEBUG
+    debug_print( L"Entering new inner REPL\n\tenv is `", DEBUG_REPL );
+    debug_print_object( env, DEBUG_REPL );
+    debug_print( L"`\n", DEBUG_REPL );
+#endif
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
@@ -1414,7 +1434,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
             set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
         input = frame->arg[1];
     }
-    if ( readp( frame->arg[2] ) ) {
+    if ( writep( frame->arg[2] ) ) {
         new_env =
             set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
         output = frame->arg[2];
@@ -1424,8 +1444,16 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     inc_ref( output );
     inc_ref( prompt_name );
 
-    URL_FILE *os = pointer2cell( output ).payload.stream.stream;
-
+    /* output should NEVER BE nil; but during development it has happened.
+     * To allow debugging under such circumstances, we need an emergency 
+     * default. */
+    URL_FILE *os =
+        !writep( output ) ? file_to_url_file( stdout ) :
+        pointer2cell( output ).payload.stream.stream;
+    if ( !writep( output ) ) {
+        debug_print( L"WARNING: invalid output; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
+    }
 
     /* \todo this is subtly wrong. If we were evaluating
      *   (print (eval (read)))
@@ -1442,7 +1470,10 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
          * \todo the whole process of resolving symbol values needs to be revisited
          * when we get onto namespaces. */
         /* OK, there's something even more subtle here if the root namespace is a map.
-         * H'mmmm... */
+         * H'mmmm... 
+         * I think that now the oblist is a hashmap masquerading as a namespace,
+         * we should no longer have to do this. TODO: test, and if so, delete this
+         * statement. */
         if ( !eq( oblist, old_oblist ) ) {
             struct cons_pointer cursor = oblist;
 
@@ -1486,6 +1517,9 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
         dec_ref( expr );
     }
 
+    if ( nilp( output ) ) {
+        free( os );
+    }
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
@@ -1563,14 +1597,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 72a8bc09e049b99c0514189272897fba9d985a7b Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sun, 1 Mar 2026 20:37:16 +0000
Subject: [PATCH 06/19] Very minor fixes/

---
 lisp/documentation.lisp | 4 ++--
 src/init.c              | 2 +-
 src/io/print.c          | 9 +--------
 3 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 7f5867b..b303856 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -11,10 +11,10 @@
 (set! member? (lambda
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            ;; (print (list "In member? item is " item "; collection is " collection))
+            (print (list "In member? item is " item "; collection is " collection))
             ;; (println)
             (cond
-              ((= nil collection) nil)
+              ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
               (t (member? item (cdr collection))))))
 
diff --git a/src/init.c b/src/init.c
index 74b6d94..565065f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -94,7 +94,7 @@ void maybe_bind_init_symbols(  ) {
         privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
     }
     if ( nilp( privileged_keyword_payload ) ) {
-        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+        privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
 }
 
diff --git a/src/io/print.c b/src/io/print.c
index a8f2770..f5f80a5 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -348,16 +348,9 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     if ( writep( out_stream ) ) {
         output = pointer2cell( out_stream ).payload.stream.stream;
-        inc_ref( out_stream );
-    } else {
-        output = file_to_url_file( stderr );
-    }
 
-    println( output );
+        println( output );
 
-    if ( writep( out_stream ) ) {
-        dec_ref( out_stream );
-    } else {
         free( output );
     }
 

From 2536e76617f98f0452f013f1680975eec538e978 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Mon, 2 Mar 2026 11:10:29 +0000
Subject: [PATCH 07/19] Added 'depth' counter to stack frames. The idea is
 two-fold:

1. You can limit runaway recursion by binding a symbol *max_stack_depth* in the environment
2. You can limit the number of backtrace frames printed.

However, neither of these have been implemented yet.
---
 src/init.c                   |   3 +
 src/memory/consspaceobject.c |   6 ++
 src/memory/consspaceobject.h |   8 ++
 src/memory/stack.c           |   5 +-
 src/ops/intern.c             | 151 +++++++++++++++++++----------------
 src/ops/lispops.c            |  42 ++++++++--
 src/ops/lispops.h            |   4 +
 7 files changed, 140 insertions(+), 79 deletions(-)

diff --git a/src/init.c b/src/init.c
index 565065f..a2da5e9 100644
--- a/src/init.c
+++ b/src/init.c
@@ -96,6 +96,9 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_keyword_payload ) ) {
         privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
+    if ( nilp( privileged_keyword_cause)) {
+        privileged_keyword_cause = c_string_to_lisp_keyword(L"cause");
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3d8fe78..ffff610 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -39,6 +39,12 @@ struct cons_pointer privileged_keyword_location = NIL;
  */
 struct cons_pointer privileged_keyword_payload = NIL;
 
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`, q.v.
+ */
+struct cons_pointer privileged_keyword_cause = NIL;
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index 1357f34..b456097 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -68,6 +68,12 @@ extern struct cons_pointer privileged_keyword_location;
  */
 extern struct cons_pointer privileged_keyword_payload;
 
+/**
+ * Keywords used when constructing exceptions: `:cause`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_cause;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
@@ -456,6 +462,8 @@ struct stack_frame {
     struct cons_pointer function;
     /** the number of arguments provided. */
     int args;
+    /** the depth of the stack below this frame */
+    int depth;
 };
 
 /**
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 7f5d581..7a85f3d 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -98,6 +98,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
         for ( int i = 0; i < args_in_frame; i++ ) {
             frame->arg[i] = NIL;
         }
+
+        frame->depth = (nilp(previous)) ? 0 : (get_stack_frame(previous))->depth + 1;
     }
     debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC );
     debug_dump_object( result, DEBUG_ALLOC );
@@ -285,7 +287,8 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
 
     if ( frame != NULL ) {
-        url_fwprintf( output, L"Stack frame with %d arguments:\n",
+        url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
+                      frame->depth;
                       frame->args );
         dump_frame_context( output, frame_pointer, 4 );
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index ae9800a..f5f1e63 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -316,81 +316,92 @@ struct cons_pointer search_store( struct cons_pointer key,
                   return_key ? "key" : "value" );
 #endif
 
-    if ( symbolp( key ) || keywordp( key ) ) {
-        struct cons_space_object *store_cell = &pointer2cell( store );
+    switch ( get_tag_value( key) ) {
+        case SYMBOLTV:
+        case KEYTV:
+            struct cons_space_object *store_cell = &pointer2cell( store );
 
-        switch ( get_tag_value( store ) ) {
-            case CONSTV:
-                for ( struct cons_pointer cursor = store;
-                      nilp( result ) && ( consp( cursor )
-                                          || hashmapp( cursor ) );
-                      cursor = pointer2cell( cursor ).payload.cons.cdr ) {
-                    switch ( get_tag_value( cursor ) ) {
-                        case CONSTV:
-                            struct cons_pointer entry_ptr = c_car( cursor );
+            switch ( get_tag_value( store ) ) {
+                case CONSTV:
+                    for ( struct cons_pointer cursor = store;
+                        nilp( result ) && ( consp( cursor )
+                                            || hashmapp( cursor ) );
+                        cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                        switch ( get_tag_value( cursor ) ) {
+                            case CONSTV:
+                                struct cons_pointer entry_ptr = c_car( cursor );
 
-                            switch ( get_tag_value( entry_ptr ) ) {
-                                case CONSTV:
-                                    if ( equal( key, c_car( entry_ptr ) ) ) {
+                                switch ( get_tag_value( entry_ptr ) ) {
+                                    case CONSTV:
+                                        if ( equal( key, c_car( entry_ptr ) ) ) {
+                                            result =
+                                                return_key ? c_car( entry_ptr ) :
+                                                c_cdr( entry_ptr );
+                                        }
+                                        break;
+                                    case HASHTV:
+                                    case NAMESPACETV:
+                                        // TODO: I think this should be impossible, and we should maybe
+                                        // throw an exception.
                                         result =
-                                            return_key ? c_car( entry_ptr ) :
-                                            c_cdr( entry_ptr );
-                                    }
-                                    break;
-                                case HASHTV:
-                                case NAMESPACETV:
-                                    // TODO: I think this should be impossible, and we should maybe
-                                    // throw an exception.
-                                    result =
-                                        hashmap_get( entry_ptr, key,
-                                                     return_key );
-                                    break;
-                                default:
-                                    result =
-                                        throw_exception
-                                        ( c_string_to_lisp_symbol
-                                          ( L"search-store (entry)" ),
-                                          make_cons( c_string_to_lisp_string
-                                                     ( L"Unexpected store type: " ),
-                                                     c_type( c_car
-                                                             ( entry_ptr ) ) ),
-                                          NIL );
+                                            hashmap_get( entry_ptr, key,
+                                                        return_key );
+                                        break;
+                                    default:
+                                        result =
+                                            throw_exception
+                                            ( c_string_to_lisp_symbol
+                                            ( L"search-store (entry)" ),
+                                            make_cons( c_string_to_lisp_string
+                                                        ( L"Unexpected store type: " ),
+                                                        c_type( c_car
+                                                                ( entry_ptr ) ) ),
+                                            NIL );
 
-                            }
-                            break;
-                        case HASHTV:
-                        case NAMESPACETV:
-                            debug_print
-                                ( L"\n\tHashmap as top-level value in list",
-                                  DEBUG_BIND );
-                            result = hashmap_get( cursor, key, return_key );
-                            break;
-                        default:
-                            result =
-                                throw_exception( c_string_to_lisp_symbol
-                                                 ( L"search-store (cursor)" ),
-                                                 make_cons
-                                                 ( c_string_to_lisp_string
-                                                   ( L"Unexpected store type: " ),
-                                                   c_type( cursor ) ), NIL );
+                                }
+                                break;
+                            case HASHTV:
+                            case NAMESPACETV:
+                                debug_print
+                                    ( L"\n\tHashmap as top-level value in list",
+                                    DEBUG_BIND );
+                                result = hashmap_get( cursor, key, return_key );
+                                break;
+                            default:
+                                result =
+                                    throw_exception( c_string_to_lisp_symbol
+                                                    ( L"search-store (cursor)" ),
+                                                    make_cons
+                                                    ( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( cursor ) ), NIL );
+                        }
                     }
-                }
-                break;
-            case HASHTV:
-            case NAMESPACETV:
-                result = hashmap_get( store, key, return_key );
-                break;
-            default:
-                result =
-                    throw_exception( c_string_to_lisp_symbol
-                                     ( L"search-store (store)" ),
-                                     make_cons( c_string_to_lisp_string
-                                                ( L"Unexpected store type: " ),
-                                                c_type( store ) ), NIL );
-                break;
-        }
-    } else {
-        // failing with key type NIL here (?). Probably worth dumping the stack?
+                    break;
+                case HASHTV:
+                case NAMESPACETV:
+                    result = hashmap_get( store, key, return_key );
+                    break;
+                default:
+                    result =
+                        throw_exception( c_string_to_lisp_symbol
+                                        ( L"search-store (store)" ),
+                                        make_cons( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( store ) ), NIL );
+                    break;
+            }
+            break;
+    case EXCEPTIONTV:
+            result =
+            throw_exception( c_string_to_lisp_symbol( L"search-store (exception)" ),
+                             make_cons
+                             ( c_string_to_lisp_string
+                               ( L"Unexpected key type: " ), c_type( key ) ),
+                             NIL );
+
+            break;
+    default:
         result =
             throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
                              make_cons
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index c2b0e70..fe264e8 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1329,18 +1329,18 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
 }
 
 /**
- * Throw an exception.
+ * Throw an exception with a cause.
  * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
  * lisp function; but it is nevertheless to be preferred to make_exception. A
  * real `throw_exception`, which does, will be needed.
  * object pointing to it. Then this should become a normal lisp function
  * which expects a normally bound frame and environment, such that
- * frame->arg[0] is the message, and frame->arg[1] is the cons-space
+ * frame->arg[0] is the payload, frame->arg[1] is the cause, and frame->arg[2] is the cons-space
  * pointer to the frame in which the exception occurred.
  */
-struct cons_pointer
-throw_exception( struct cons_pointer location,
+struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
                  struct cons_pointer message,
+                 struct cons_pointer cause,
                  struct cons_pointer frame_pointer ) {
     struct cons_pointer result = NIL;
 
@@ -1350,9 +1350,13 @@ throw_exception( struct cons_pointer location,
     debug_print( L"` at `", 511 );
     debug_print_object( location, 511 );
     debug_print( L"`\n", 511 );
-    debug_print_object( location, 511 );
+    if (!nilp( cause)) {
+        debug_print( L"\tCaused by: ", 511)
+        ;
+        debug_print_object( cause, 511);
+        debug_print( L"`\n", 511 );
+    }
 #endif
-
     struct cons_space_object *cell = &pointer2cell( message );
 
     if ( cell->tag.value == EXCEPTIONTV ) {
@@ -1364,10 +1368,31 @@ throw_exception( struct cons_pointer location,
                                          location ),
                               make_cons( make_cons
                                          ( privileged_keyword_payload,
-                                           message ), NIL ) ), frame_pointer );
+                                           message ), 
+                                        (nilp( cause) ? NIL :
+                                    make_cons( make_cons( privileged_keyword_cause,
+                                    cause), NIL)) ) ), frame_pointer );
     }
 
     return result;
+
+}
+
+/**
+ * Throw an exception.
+ * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
+ * lisp function; but it is nevertheless to be preferred to make_exception. A
+ * real `throw_exception`, which does, will be needed.
+ * object pointing to it. Then this should become a normal lisp function
+ * which expects a normally bound frame and environment, such that
+ * frame->arg[0] is the payload, frame->arg[1] is the cause, and frame->arg[2] is the cons-space
+ * pointer to the frame in which the exception occurred.
+ */
+struct cons_pointer
+throw_exception( struct cons_pointer location,
+                 struct cons_pointer payload,
+                 struct cons_pointer frame_pointer ) {
+    return throw_exception_with_cause( location, payload, NIL, frame_pointer);
 }
 
 /**
@@ -1393,8 +1418,9 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
 
-    return exceptionp( message ) ? message : throw_exception( message,
+    return exceptionp( message ) ? message : throw_exception_with_cause( message,
                                                               frame->arg[1],
+                                                              frame->arg[2],
                                                               frame->previous );
 }
 
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index da2428a..630592f 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -190,6 +190,10 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env );
 
+struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
+                 struct cons_pointer message,
+                 struct cons_pointer cause,
+                 struct cons_pointer frame_pointer );
 /**
  * Throw an exception.
  * `throw_exception` is a misnomer, because it doesn't obey the calling

From d1ce893633502b12afa04b4253496b003f95487a Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 13 Mar 2026 23:42:57 +0000
Subject: [PATCH 08/19] This is broken, but the stack limit feature works. Some
 debugging needed.

---
 docs/State-of-play.md        | 11 +++++
 src/init.c                   | 11 +++--
 src/io/io.c                  |  4 +-
 src/memory/consspaceobject.h |  4 +-
 src/memory/dump.c            |  8 ++--
 src/memory/stack.c           | 66 ++++++++++++++++++++++--------
 src/memory/stack.h           |  4 ++
 src/ops/intern.c             | 75 ++++++++++++++++++----------------
 src/ops/lispops.c            | 79 ++++++++++++++++++------------------
 src/ops/lispops.h            |  7 ++--
 unit-tests/recursion.sh      |  4 +-
 unit-tests/try.sh            |  2 +-
 12 files changed, 164 insertions(+), 111 deletions(-)

diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 61cfa0c..1d8bbfd 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,16 @@
 # State of Play
 
+## 20260311
+
+I've still been having trouble with runaway recursion &mdash; in `member`, but
+due to a primitive bug I haven't identified &mdash; so this morning I've tried
+to implement a stack limit feature. This has been a real fail at this stage. 
+Many more tests are breaking.
+
+However, I think having a configurable stack limit would be a good thing, so 
+I'm not yet ready to abandon this feature. I need to work out why it's breaking
+things.
+
 ## 20260226
 
 The bug in `member` turned out to be because when a symbol is read by the reader, 
diff --git a/src/init.c b/src/init.c
index a2da5e9..baca2b7 100644
--- a/src/init.c
+++ b/src/init.c
@@ -96,8 +96,8 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_keyword_payload ) ) {
         privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
-    if ( nilp( privileged_keyword_cause)) {
-        privileged_keyword_cause = c_string_to_lisp_keyword(L"cause");
+    if ( nilp( privileged_keyword_cause ) ) {
+        privileged_keyword_cause = c_string_to_lisp_keyword( L"cause" );
     }
 }
 
@@ -217,6 +217,8 @@ void print_options( FILE *stream ) {
               L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
     fwprintf( stream, L"\t-h\tPrint this message and exit;\n" );
     fwprintf( stream, L"\t-p\tShow a prompt (default is no prompt);\n" );
+    fwprintf( stream,
+              L"\t-s LIMIT\n\t\tSet the maximum stack depth to this LIMIT (int)\n" );
 #ifdef DEBUG
     fwprintf( stream,
               L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" );
@@ -249,7 +251,7 @@ int main( int argc, char *argv[] ) {
         exit( 1 );
     }
 
-    while ( ( option = getopt( argc, argv, "phdv:i:" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "dhi:ps:v:" ) ) != -1 ) {
         switch ( option ) {
             case 'd':
                 dump_at_end = true;
@@ -265,6 +267,9 @@ int main( int argc, char *argv[] ) {
             case 'p':
                 show_prompt = true;
                 break;
+            case 's':
+                stack_limit = atoi( optarg );
+                break;
             case 'v':
                 verbosity = atoi( optarg );
                 break;
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index b456097..9653402 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -207,7 +207,7 @@ extern struct cons_pointer privileged_keyword_cause;
 #define READTV      1145128274
 
 /**
- * A real number, represented internally as an IEEE 754-2008 `binary64`.
+ * A real number, represented internally as an IEEE 754-2008 `binary128`.
  */
 #define REALTAG     "REAL"
 
@@ -239,7 +239,7 @@ extern struct cons_pointer privileged_keyword_cause;
 #define STRINGTV    1196577875
 
 /**
- * A symbol is just like a string except not self-evaluating.
+ * A symbol is just like a keyword except not self-evaluating.
  */
 #define SYMBOLTAG   "SYMB"
 
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 7a85f3d..cff1ece 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -26,6 +26,12 @@
 #include "memory/vectorspace.h"
 #include "ops/lispops.h"
 
+/**
+ * @brief If non-zero, maximum depth of stack.
+ * 
+ */
+uint32_t stack_limit = 0;
+
 /**
  * set a register in a stack frame. Alwaye use this to do so,
  * because that way we can be sure the inc_ref happens!
@@ -68,17 +74,19 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
 
 /**
  * Make an empty stack frame, and return it.
+ *
+ * This function does the actual meat of making the frame.
+ *
  * @param previous the current top-of-stack;
- * @param env the environment in which evaluation happens.
+ * @param depth the depth of the new frame.
  * @return the new frame, or NULL if memory is exhausted.
  */
-struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
+struct cons_pointer in_make_empty_frame( struct cons_pointer previous,
+                                         uint32_t depth ) {
     debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC );
     struct cons_pointer result =
         make_vso( STACKFRAMETV, sizeof( struct stack_frame ) );
 
-    debug_dump_object( result, DEBUG_ALLOC );
-
     if ( !nilp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
         /*
@@ -86,6 +94,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
          */
 
         frame->previous = previous;
+        frame->depth = depth;
 
         /*
          * clearing the frame with memset would probably be slightly quicker, but
@@ -99,7 +108,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
             frame->arg[i] = NIL;
         }
 
-        frame->depth = (nilp(previous)) ? 0 : (get_stack_frame(previous))->depth + 1;
+        debug_dump_object( result, DEBUG_ALLOC );
     }
     debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC );
     debug_dump_object( result, DEBUG_ALLOC );
@@ -107,6 +116,37 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     return result;
 }
 
+/**
+ * @brief Make an empty stack frame, and return it.
+ *
+ * This function does the error checking around actual construction.
+ *
+ * @param previous the current top-of-stack;
+ * @param env the environment in which evaluation happens.
+ * @return the new frame, or NULL if memory is exhausted.
+ */
+struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
+    struct cons_pointer result = NIL;
+    uint32_t depth =
+        ( nilp( previous ) ) ? 0 : ( get_stack_frame( previous ) )->depth + 1;
+
+    if ( stack_limit > 0 && stack_limit > depth ) {
+        result = in_make_empty_frame( previous, depth );
+    } else {
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( L"Stack limit exceeded." ), previous );
+    }
+
+    if ( nilp( result ) ) {
+        /* i.e. out of memory */
+        result =
+            make_exception( privileged_string_memory_exhausted, previous );
+    }
+
+    return result;
+}
+
 /**
  * Allocate a new stack frame with its previous pointer set to this value,
  * its arguments set up from these args, evaluated in this env.
@@ -121,11 +161,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
     debug_print( L"Entering make_stack_frame\n", DEBUG_STACK );
     struct cons_pointer result = make_empty_frame( previous );
 
-    if ( nilp( result ) ) {
-        /* i.e. out of memory */
-        result =
-            make_exception( privileged_string_memory_exhausted, previous );
-    } else {
+    if ( !exceptionp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
 
         while ( frame->args < args_in_frame && consp( args ) ) {
@@ -191,12 +227,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous,
 
     struct cons_pointer result = make_empty_frame( previous );
 
-    if ( nilp( result ) ) {
-        /* i.e. out of memory */
-        result =
-            make_exception( c_string_to_lisp_string( L"Memory exhausted." ),
-                            previous );
-    } else {
+    if ( !exceptionp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
 
         while ( frame->args < args_in_frame && !nilp( args ) ) {
@@ -288,8 +319,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
 
     if ( frame != NULL ) {
         url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
-                      frame->depth;
-                      frame->args );
+                      frame->depth, frame->args );
         dump_frame_context( output, frame_pointer, 4 );
 
         for ( int arg = 0; arg < frame->args; arg++ ) {
diff --git a/src/memory/stack.h b/src/memory/stack.h
index f132c69..111df48 100644
--- a/src/memory/stack.h
+++ b/src/memory/stack.h
@@ -21,6 +21,8 @@
 #ifndef __psse_stack_h
 #define __psse_stack_h
 
+#include <stdint.h>
+
 #include "consspaceobject.h"
 #include "conspage.h"
 
@@ -35,6 +37,8 @@
  */
 #define stackframep(vso)(((struct vector_space_object *)vso)->header.tag.value == STACKFRAMETV)
 
+extern uint32_t stack_limit;
+
 void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value );
 
 struct stack_frame *get_stack_frame( struct cons_pointer pointer );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index f5f1e63..bba5ee5 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -316,7 +316,7 @@ struct cons_pointer search_store( struct cons_pointer key,
                   return_key ? "key" : "value" );
 #endif
 
-    switch ( get_tag_value( key) ) {
+    switch ( get_tag_value( key ) ) {
         case SYMBOLTV:
         case KEYTV:
             struct cons_space_object *store_cell = &pointer2cell( store );
@@ -324,19 +324,20 @@ struct cons_pointer search_store( struct cons_pointer key,
             switch ( get_tag_value( store ) ) {
                 case CONSTV:
                     for ( struct cons_pointer cursor = store;
-                        nilp( result ) && ( consp( cursor )
-                                            || hashmapp( cursor ) );
-                        cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                          nilp( result ) && ( consp( cursor )
+                                              || hashmapp( cursor ) );
+                          cursor = pointer2cell( cursor ).payload.cons.cdr ) {
                         switch ( get_tag_value( cursor ) ) {
                             case CONSTV:
-                                struct cons_pointer entry_ptr = c_car( cursor );
+                                struct cons_pointer entry_ptr =
+                                    c_car( cursor );
 
                                 switch ( get_tag_value( entry_ptr ) ) {
                                     case CONSTV:
                                         if ( equal( key, c_car( entry_ptr ) ) ) {
                                             result =
-                                                return_key ? c_car( entry_ptr ) :
-                                                c_cdr( entry_ptr );
+                                                return_key ? c_car( entry_ptr )
+                                                : c_cdr( entry_ptr );
                                         }
                                         break;
                                     case HASHTV:
@@ -345,18 +346,18 @@ struct cons_pointer search_store( struct cons_pointer key,
                                         // throw an exception.
                                         result =
                                             hashmap_get( entry_ptr, key,
-                                                        return_key );
+                                                         return_key );
                                         break;
                                     default:
                                         result =
                                             throw_exception
                                             ( c_string_to_lisp_symbol
-                                            ( L"search-store (entry)" ),
-                                            make_cons( c_string_to_lisp_string
-                                                        ( L"Unexpected store type: " ),
-                                                        c_type( c_car
-                                                                ( entry_ptr ) ) ),
-                                            NIL );
+                                              ( L"search-store (entry)" ),
+                                              make_cons
+                                              ( c_string_to_lisp_string
+                                                ( L"Unexpected store type: " ),
+                                                c_type( c_car( entry_ptr ) ) ),
+                                              NIL );
 
                                 }
                                 break;
@@ -364,17 +365,19 @@ struct cons_pointer search_store( struct cons_pointer key,
                             case NAMESPACETV:
                                 debug_print
                                     ( L"\n\tHashmap as top-level value in list",
-                                    DEBUG_BIND );
-                                result = hashmap_get( cursor, key, return_key );
+                                      DEBUG_BIND );
+                                result =
+                                    hashmap_get( cursor, key, return_key );
                                 break;
                             default:
                                 result =
                                     throw_exception( c_string_to_lisp_symbol
-                                                    ( L"search-store (cursor)" ),
-                                                    make_cons
-                                                    ( c_string_to_lisp_string
-                                                    ( L"Unexpected store type: " ),
-                                                    c_type( cursor ) ), NIL );
+                                                     ( L"search-store (cursor)" ),
+                                                     make_cons
+                                                     ( c_string_to_lisp_string
+                                                       ( L"Unexpected store type: " ),
+                                                       c_type( cursor ) ),
+                                                     NIL );
                         }
                     }
                     break;
@@ -385,29 +388,29 @@ struct cons_pointer search_store( struct cons_pointer key,
                 default:
                     result =
                         throw_exception( c_string_to_lisp_symbol
-                                        ( L"search-store (store)" ),
-                                        make_cons( c_string_to_lisp_string
+                                         ( L"search-store (store)" ),
+                                         make_cons( c_string_to_lisp_string
                                                     ( L"Unexpected store type: " ),
                                                     c_type( store ) ), NIL );
                     break;
             }
             break;
-    case EXCEPTIONTV:
+        case EXCEPTIONTV:
             result =
-            throw_exception( c_string_to_lisp_symbol( L"search-store (exception)" ),
-                             make_cons
-                             ( c_string_to_lisp_string
-                               ( L"Unexpected key type: " ), c_type( key ) ),
-                             NIL );
+                throw_exception( c_string_to_lisp_symbol
+                                 ( L"search-store (exception)" ),
+                                 make_cons( c_string_to_lisp_string
+                                            ( L"Unexpected key type: " ),
+                                            c_type( key ) ), NIL );
 
             break;
-    default:
-        result =
-            throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
-                             make_cons
-                             ( c_string_to_lisp_string
-                               ( L"Unexpected key type: " ), c_type( key ) ),
-                             NIL );
+        default:
+            result =
+                throw_exception( c_string_to_lisp_symbol
+                                 ( L"search-store (key)" ),
+                                 make_cons( c_string_to_lisp_string
+                                            ( L"Unexpected key type: " ),
+                                            c_type( key ) ), NIL );
     }
 
     debug_print( L"search-store: returning `", DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index fe264e8..57b2f8e 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -92,18 +92,21 @@ struct cons_pointer eval_form( struct stack_frame *parent,
                 struct cons_pointer next_pointer =
                     make_empty_frame( parent_pointer );
                 // inc_ref( next_pointer );
+                if ( exceptionp( next_pointer ) ) {
+                    result = next_pointer;
+                } else {
+                    struct stack_frame *next = get_stack_frame( next_pointer );
+                    set_reg( next, 0, form );
+                    next->args = 1;
 
-                struct stack_frame *next = get_stack_frame( next_pointer );
-                set_reg( next, 0, form );
-                next->args = 1;
+                    result = lisp_eval( next, next_pointer, env );
 
-                result = lisp_eval( next, next_pointer, env );
-
-                if ( !exceptionp( result ) ) {
-                    /* if we're returning an exception, we should NOT free the
-                     * stack frame. Corollary is, when we free an exception, we
-                     * should free all the frames it's holding on to. */
-                    dec_ref( next_pointer );
+                    if ( !exceptionp( result ) ) {
+                        /* if we're returning an exception, we should NOT free the
+                         * stack frame. Corollary is, when we free an exception, we
+                         * should free all the frames it's holding on to. */
+                        dec_ref( next_pointer );
+                    }
                 }
             }
             break;
@@ -365,8 +368,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( name_key,
-                                                   fn_cell->payload.
-                                                   function.meta ) ),
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -420,10 +423,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -497,10 +497,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1339,9 +1336,10 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * pointer to the frame in which the exception occurred.
  */
 struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
-                 struct cons_pointer message,
-                 struct cons_pointer cause,
-                 struct cons_pointer frame_pointer ) {
+                                                struct cons_pointer message,
+                                                struct cons_pointer cause,
+                                                struct cons_pointer
+                                                frame_pointer ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
@@ -1350,10 +1348,9 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
     debug_print( L"` at `", 511 );
     debug_print_object( location, 511 );
     debug_print( L"`\n", 511 );
-    if (!nilp( cause)) {
-        debug_print( L"\tCaused by: ", 511)
-        ;
-        debug_print_object( cause, 511);
+    if ( !nilp( cause ) ) {
+        debug_print( L"\tCaused by: ", 511 );
+        debug_print_object( cause, 511 );
         debug_print( L"`\n", 511 );
     }
 #endif
@@ -1368,10 +1365,12 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
                                          location ),
                               make_cons( make_cons
                                          ( privileged_keyword_payload,
-                                           message ), 
-                                        (nilp( cause) ? NIL :
-                                    make_cons( make_cons( privileged_keyword_cause,
-                                    cause), NIL)) ) ), frame_pointer );
+                                           message ),
+                                         ( nilp( cause ) ? NIL :
+                                           make_cons( make_cons
+                                                      ( privileged_keyword_cause,
+                                                        cause ), NIL ) ) ) ),
+                            frame_pointer );
     }
 
     return result;
@@ -1392,7 +1391,7 @@ struct cons_pointer
 throw_exception( struct cons_pointer location,
                  struct cons_pointer payload,
                  struct cons_pointer frame_pointer ) {
-    return throw_exception_with_cause( location, payload, NIL, frame_pointer);
+    return throw_exception_with_cause( location, payload, NIL, frame_pointer );
 }
 
 /**
@@ -1418,10 +1417,9 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
 
-    return exceptionp( message ) ? message : throw_exception_with_cause( message,
-                                                              frame->arg[1],
-                                                              frame->arg[2],
-                                                              frame->previous );
+    return exceptionp( message ) ? message :
+        throw_exception_with_cause( message, frame->arg[1], frame->arg[2],
+                                    frame->previous );
 }
 
 /**
@@ -1623,13 +1621,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 630592f..66f46c8 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -191,9 +191,10 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
                                struct cons_pointer env );
 
 struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
-                 struct cons_pointer message,
-                 struct cons_pointer cause,
-                 struct cons_pointer frame_pointer );
+                                                struct cons_pointer message,
+                                                struct cons_pointer cause,
+                                                struct cons_pointer
+                                                frame_pointer );
 /**
  * Throw an exception.
  * `throw_exception` is a misnomer, because it doesn't obey the calling
diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh
index 6b5be2d..e3aa586 100755
--- a/unit-tests/recursion.sh
+++ b/unit-tests/recursion.sh
@@ -5,8 +5,8 @@ output=`target/psse 2>/dev/null <<EOF
 (progn
   (set! fact
     (lambda (n)
-    (cond ((= n 1) 1)
-      (t (* n (fact (- n 1)))))))
+      (cond ((= n 1) 1)
+        (t (* n (fact (- n 1)))))))
   nil)
 (fact 10)
 EOF`
diff --git a/unit-tests/try.sh b/unit-tests/try.sh
index 43e35ad..b87ccee 100755
--- a/unit-tests/try.sh
+++ b/unit-tests/try.sh
@@ -40,7 +40,7 @@ else
 fi
 
 echo -n "$0: the exception is bound to the symbol \`*exception*\` in the catch environment... "
-expected='Exception: "Cannot divide: not a number"'
+expected='Exception: ((:location . /) (:payload . "Cannot divide: not a number"))'
 actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse 2>&1 | grep Exception`
 
 if [ "${expected}" = "${actual}" ]

From 7f3460152325f6185642edad13df9dd0968b727a Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 14 Mar 2026 16:58:55 +0000
Subject: [PATCH 09/19] Well, that was easy! Stack limit now working.

---
 Makefile                |  2 +-
 docs/State-of-play.md   | 11 +++++++++++
 lisp/documentation.lisp |  2 +-
 src/memory/stack.c      |  2 +-
 4 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/Makefile b/Makefile
index 7c55be3..5691f29 100644
--- a/Makefile
+++ b/Makefile
@@ -44,7 +44,7 @@ test: $(TESTS) Makefile $(TARGET)
 
 .PHONY: clean
 clean:
-	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
+	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core.*
 
 repl:
 	$(TARGET) -p 2> psse.log
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 1d8bbfd..c619b55 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,16 @@
 # State of Play
 
+## 20260314
+
+When I put a debugger on it, the stack limit bug proved shallow. 
+
+I'm tempted to further exercise my debugging skills by having another go at 
+the bignum arithmetic problems.
+
+However, I've been rethinking the roadmap of the project, and written a long
+[blog post about it](https://www.journeyman.cc/blog/posts-output/2026-03-13-The-worlds-slowest-ever-rapid-prototype/). 
+This isn't a finalised decision yet, but it is something I'm thinking about.
+
 ## 20260311
 
 I've still been having trouble with runaway recursion &mdash; in `member`, but
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index b303856..271700d 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -12,7 +12,7 @@
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (print (list "In member? item is " item "; collection is " collection))
-            ;; (println)
+            (println)
             (cond
               ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
diff --git a/src/memory/stack.c b/src/memory/stack.c
index cff1ece..70c07f9 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -130,7 +130,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     uint32_t depth =
         ( nilp( previous ) ) ? 0 : ( get_stack_frame( previous ) )->depth + 1;
 
-    if ( stack_limit > 0 && stack_limit > depth ) {
+    if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
         result =

From d42ece5711f29beb5af7a667bb93d40924495d8f Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 14 Mar 2026 21:20:23 +0000
Subject: [PATCH 10/19] Tactical commit while working on the bignum bug, AGAIN.

---
 src/arith/integer.c | 72 ++++++++++++++++++---------------------------
 src/debug.h         |  7 +++++
 src/init.c          |  3 +-
 src/ops/equal.c     | 22 +++++++-------
 4 files changed, 49 insertions(+), 55 deletions(-)

diff --git a/src/arith/integer.c b/src/arith/integer.c
index a3174ac..3688ff5 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -210,7 +210,7 @@ __int128_t int128_to_integer( __int128_t val,
 
     if ( integerp( less_significant ) ) {
         struct cons_space_object *lsc = &pointer2cell( less_significant );
-        inc_ref( new );
+        // inc_ref( new );
         lsc->payload.integer.more = new;
     }
 
@@ -226,57 +226,43 @@ struct cons_pointer add_integers( struct cons_pointer a,
     struct cons_pointer result = NIL;
     struct cons_pointer cursor = NIL;
 
-    debug_print( L"add_integers: a = ", DEBUG_ARITH );
-    debug_print_object( a, DEBUG_ARITH );
-    debug_print( L"; b = ", DEBUG_ARITH );
-    debug_print_object( b, DEBUG_ARITH );
-    debug_println( DEBUG_ARITH );
-
     __int128_t carry = 0;
     bool is_first_cell = true;
 
-    if ( integerp( a ) && integerp( b ) ) {
-        debug_print( L"add_integers: \n", DEBUG_ARITH );
-        debug_dump_object( a, DEBUG_ARITH );
-        debug_print( L" plus \n", DEBUG_ARITH );
-        debug_dump_object( b, DEBUG_ARITH );
-        debug_println( DEBUG_ARITH );
+    while ( integerp( a ) || integerp( b ) || carry != 0 ) {
+        __int128_t av = cell_value( a, '+', is_first_cell );
+        __int128_t bv = cell_value( b, '+', is_first_cell );
+        __int128_t rv = ( av + bv ) + carry;
 
-        while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
-            __int128_t av = cell_value( a, '+', is_first_cell );
-            __int128_t bv = cell_value( b, '+', is_first_cell );
-            __int128_t rv = ( av + bv ) + carry;
+        debug_print( L"add_integers: av = ", DEBUG_ARITH );
+        debug_print_128bit( av, DEBUG_ARITH );
+        debug_print( L"; bv = ", DEBUG_ARITH );
+        debug_print_128bit( bv, DEBUG_ARITH );
+        debug_print( L"; carry = ", DEBUG_ARITH );
+        debug_print_128bit( carry, DEBUG_ARITH );
+        debug_print( L"; rv = ", DEBUG_ARITH );
+        debug_print_128bit( rv, DEBUG_ARITH );
+        debug_print( L"\n", DEBUG_ARITH );
 
-            debug_print( L"add_integers: av = ", DEBUG_ARITH );
-            debug_print_128bit( av, DEBUG_ARITH );
-            debug_print( L"; bv = ", DEBUG_ARITH );
-            debug_print_128bit( bv, DEBUG_ARITH );
-            debug_print( L"; carry = ", DEBUG_ARITH );
-            debug_print_128bit( carry, DEBUG_ARITH );
-            debug_print( L"; rv = ", DEBUG_ARITH );
-            debug_print_128bit( rv, DEBUG_ARITH );
-            debug_print( L"\n", DEBUG_ARITH );
+        if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
+            result =
+                acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
+            break;
+        } else {
+            struct cons_pointer new = make_integer( 0, NIL );
+            carry = int128_to_integer( rv, cursor, new );
+            cursor = new;
 
-            if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) {
-                result =
-                    acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
-                break;
-            } else {
-                struct cons_pointer new = make_integer( 0, NIL );
-                carry = int128_to_integer( rv, cursor, new );
-                cursor = new;
-
-                if ( nilp( result ) ) {
-                    result = cursor;
-                }
-
-                a = pointer2cell( a ).payload.integer.more;
-                b = pointer2cell( b ).payload.integer.more;
-                is_first_cell = false;
+            if ( nilp( result ) ) {
+                result = cursor;
             }
+
+            a = pointer2cell( a ).payload.integer.more;
+            b = pointer2cell( b ).payload.integer.more;
+            is_first_cell = false;
         }
     }
-
+    
     debug_print( L"add_integers returning: ", DEBUG_ARITH );
     debug_print_object( result, DEBUG_ARITH );
     debug_println( DEBUG_ARITH );
diff --git a/src/debug.h b/src/debug.h
index 2e59932..6c7c8cb 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -79,6 +79,13 @@
  */
 #define DEBUG_STACK 256
 
+/**
+ * @brief Print messages about equality tests.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
+ #define DEBUG_EQUAL 512
+
 extern int verbosity;
 
 void debug_print_exception( struct cons_pointer ex_ptr );
diff --git a/src/init.c b/src/init.c
index baca2b7..d88e8aa 100644
--- a/src/init.c
+++ b/src/init.c
@@ -231,7 +231,8 @@ void print_options( FILE *stream ) {
     fwprintf( stream, L"\t\t32\tINPUT/OUTPUT;\n" );
     fwprintf( stream, L"\t\t64\tLAMBDA;\n" );
     fwprintf( stream, L"\t\t128\tREPL;\n" );
-    fwprintf( stream, L"\t\t256\tSTACK.\n" );
+    fwprintf( stream, L"\t\t256\tSTACK;\n" );
+    fwprintf( stream, L"\t\t512\tEQUAL.\n" );
 #endif
 }
 
diff --git a/src/ops/equal.c b/src/ops/equal.c
index b2d0fa2..296aea6 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -74,7 +74,7 @@ bool equal_ld_ld( long double a, long double b ) {
 
     bool result = ( fabsl( a - b ) < tolerance );
 
-    debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
+    debug_printf( DEBUG_EQUAL, L"\nequal_ld_ld returning %d\n", result );
 
     return result;
 }
@@ -332,10 +332,10 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
  * identical structure, else false.
  */
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal: ", DEBUG_ARITH );
-    debug_print_object( a, DEBUG_ARITH );
-    debug_print( L" = ", DEBUG_ARITH );
-    debug_print_object( b, DEBUG_ARITH );
+    debug_print( L"\nequal: ", DEBUG_EQUAL );
+    debug_print_object( a, DEBUG_EQUAL );
+    debug_print( L" = ", DEBUG_EQUAL );
+    debug_print_object( b, DEBUG_EQUAL );
 
     bool result = false;
 
@@ -389,11 +389,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     }
 
 #ifdef DEBUG
-                    debug_print( L"Comparing '", DEBUG_ARITH );
-                    debug_print( a_buff, DEBUG_ARITH );
-                    debug_print( L"' to '", DEBUG_ARITH );
-                    debug_print( b_buff, DEBUG_ARITH );
-                    debug_print( L"'\n", DEBUG_ARITH );
+                    debug_print( L"Comparing '", DEBUG_EQUAL );
+                    debug_print( a_buff, DEBUG_EQUAL );
+                    debug_print( L"' to '", DEBUG_EQUAL );
+                    debug_print( b_buff, DEBUG_EQUAL );
+                    debug_print( L"'\n", DEBUG_EQUAL );
 #endif
 
                     /* OK, now we have wchar string buffers loaded from the objects. We 
@@ -427,7 +427,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
-    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
+    debug_printf( DEBUG_EQUAL, L"\nequal returning %d\n", result );
 
     return result;
 }

From de50a30be2bf56e2a15715b6bced46e06d30c6e4 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Mon, 16 Mar 2026 15:26:12 +0000
Subject: [PATCH 11/19] Getting closer to tracking down the member bug, but
 cannot use debugger on laptop screen.

---
 Makefile                     |  3 +++
 docs/State-of-play.md        |  9 ++++++++
 lisp/documentation.lisp      |  4 +---
 lisp/member.lisp             |  2 +-
 src/init.c                   | 43 ++++++++++++++++--------------------
 src/memory/consspaceobject.c | 20 +++++++++++++++++
 src/memory/consspaceobject.h | 18 +++++++++++++++
 src/ops/lispops.c            | 31 +++++++++-----------------
 unit-tests/let.sh            |  8 +++----
 unit-tests/progn.sh          |  4 ++--
 unit-tests/recursion.sh      |  2 +-
 11 files changed, 89 insertions(+), 55 deletions(-)

diff --git a/Makefile b/Makefile
index 5691f29..27780a5 100644
--- a/Makefile
+++ b/Makefile
@@ -46,6 +46,9 @@ test: $(TESTS) Makefile $(TARGET)
 clean:
 	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core.*
 
+coredumps:
+	ulimit -c unlimited
+
 repl:
 	$(TARGET) -p 2> psse.log
 
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index c619b55..6ad9c69 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,14 @@
 # State of Play
 
+## 20260316
+
+OK, where we're at: 
+* The garbage collector is doing *even worse* than it was on 4th 
+February, when I did the last serious look at it. 
+* The bignum bugs are not fixed.
+* You can (optionally) limit runaway stack crashes with a new command line option.
+* If you enable the stack limiter feature, `(member? 5 '(1 2 3 4))` returns `nil`, as it should, and does not throw a stack limit exception, but if you do not enable it, `(member? 5 '(1 2 3 4))` causes a segfault. WTAF?
+
 ## 20260314
 
 When I put a debugger on it, the stack limit bug proved shallow. 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 271700d..056856e 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -10,9 +10,7 @@
 
 (set! member? (lambda
             (item collection)
-            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            (print (list "In member? item is " item "; collection is " collection))
-            (println)
+            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
diff --git a/lisp/member.lisp b/lisp/member.lisp
index dfb12af..b67a7e3 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -5,7 +5,7 @@
 
 (set! member? (lambda
             (item collection)
-            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((nil? collection) nil)
               ((= item (car collection)) t)
diff --git a/src/init.c b/src/init.c
index d88e8aa..6e6b106 100644
--- a/src/init.c
+++ b/src/init.c
@@ -47,11 +47,12 @@
  */
 struct cons_pointer check_exception( struct cons_pointer pointer,
                                      char *location_descriptor ) {
-    struct cons_pointer result = NIL;
-
-    struct cons_space_object *object = &pointer2cell( pointer );
+    struct cons_pointer result = pointer;
 
     if ( exceptionp( pointer ) ) {
+        struct cons_space_object * object = &pointer2cell( pointer);
+        result = NIL;
+        
         fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
         URL_FILE *ustderr = file_to_url_file( stderr );
         fwide( stderr, 1 );
@@ -59,27 +60,21 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
         free( ustderr );
 
         dec_ref( pointer );
-    } else {
-        result = pointer;
     }
 
     return result;
 }
 
-struct cons_pointer init_documentation_symbol = NIL;
-struct cons_pointer init_name_symbol = NIL;
-struct cons_pointer init_primitive_symbol = NIL;
-
 void maybe_bind_init_symbols(  ) {
-    if ( nilp( init_documentation_symbol ) ) {
-        init_documentation_symbol =
+    if ( nilp( privileged_keyword_documentation ) ) {
+        privileged_keyword_documentation =
             c_string_to_lisp_keyword( L"documentation" );
     }
-    if ( nilp( init_name_symbol ) ) {
-        init_name_symbol = c_string_to_lisp_keyword( L"name" );
+    if ( nilp( privileged_keyword_name ) ) {
+        privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
     }
-    if ( nilp( init_primitive_symbol ) ) {
-        init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
+    if ( nilp( privileged_keyword_primitive ) ) {
+        privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" );
     }
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
@@ -102,9 +97,9 @@ void maybe_bind_init_symbols(  ) {
 }
 
 void free_init_symbols(  ) {
-    dec_ref( init_documentation_symbol );
-    dec_ref( init_name_symbol );
-    dec_ref( init_primitive_symbol );
+    dec_ref( privileged_keyword_documentation );
+    dec_ref( privileged_keyword_name );
+    dec_ref( privileged_keyword_primitive );
 }
 
 /**
@@ -124,10 +119,10 @@ struct cons_pointer bind_function( wchar_t *name,
     struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
-        make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n ),
+        make_cons( make_cons( privileged_keyword_primitive, TRUE ),
+                   make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( init_documentation_symbol, d ),
+                                         ( privileged_keyword_documentation, d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
@@ -153,10 +148,10 @@ struct cons_pointer bind_special( wchar_t *name,
     struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
-        make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n ),
+        make_cons( make_cons( privileged_keyword_primitive, TRUE ),
+                   make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( init_documentation_symbol, d ),
+                                         ( privileged_keyword_documentation, d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index ffff610..2c0ab6a 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -45,6 +45,26 @@ struct cons_pointer privileged_keyword_payload = NIL;
  */
 struct cons_pointer privileged_keyword_cause = NIL;
 
+/**
+ * @brief keywords used in documentation: `:documentation`. Instantiated in 
+ * `init.c`, q. v.
+ * 
+ */
+struct cons_pointer privileged_keyword_documentation = NIL;
+
+/**
+ * @brief keywords used in documentation: `:name`. Instantiated in 
+ * `init.c`, q. v.
+ */
+struct cons_pointer privileged_keyword_name = NIL;
+
+/**
+ * @brief keywords used in documentation: `:primitive`. Instantiated in 
+ * `init.c`, q. v.
+ */
+struct cons_pointer privileged_keyword_primitive = NIL;
+
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index 9653402..25f68e3 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -74,6 +74,24 @@ extern struct cons_pointer privileged_keyword_payload;
  */
 extern struct cons_pointer privileged_keyword_cause;
 
+/**
+ * @brief keywords used in documentation: `:documentation`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_documentation;
+
+/**
+ * @brief keywords used in documentation: `:name`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_name;
+
+/**
+ * @brief keywords used in documentation: `:primitive`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_primitive;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 57b2f8e..393cc7b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -91,7 +91,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
             {
                 struct cons_pointer next_pointer =
                     make_empty_frame( parent_pointer );
-                // inc_ref( next_pointer );
+
                 if ( exceptionp( next_pointer ) ) {
                     result = next_pointer;
                 } else {
@@ -275,7 +275,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
 
             names = c_cdr( names );
         }
-//        inc_ref( new_env );
 
         /* \todo if there's more than `args_in_frame` arguments, bind those too. */
     } else if ( symbolp( names ) ) {
@@ -296,7 +295,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
         }
 
         new_env = set( names, vals, new_env );
-//        inc_ref( new_env );
     }
 
     while ( !nilp( body ) ) {
@@ -311,9 +309,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
 
         /* if a result is not the terminal result in the lambda, it's a
          * side effect, and needs to be GCed */
-        if ( !nilp( result ) ) {
-            dec_ref( result );
-        }
+        dec_ref( result );
 
         result = eval_form( frame, frame_pointer, sexpr, new_env );
 
@@ -322,6 +318,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
         }
     }
 
+    // TODO: I think we do need to dec_ref everything on new_env back to env    
     // dec_ref( new_env );
 
     debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA );
@@ -346,8 +343,6 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
 
         struct cons_pointer payload =
             pointer2cell( result ).payload.exception.payload;
-        /* TODO: should name_key also be a privileged keyword? */
-        struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
 
         switch ( get_tag_value( payload ) ) {
             case NILTV:
@@ -358,7 +353,7 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                                         payload ) ) ) {
                         pointer2cell( result ).payload.exception.payload =
                             set( privileged_keyword_location,
-                                 c_assoc( name_key,
+                                 c_assoc( privileged_keyword_name,
                                           fn_cell->payload.function.meta ),
                                  payload );
                     }
@@ -367,15 +362,13 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
             default:
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
-                                          c_assoc( name_key,
+                                          c_assoc( privileged_keyword_name,
                                                    fn_cell->payload.function.
                                                    meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
         }
-
-        dec_ref( name_key );
     }
 
     return result;
@@ -415,7 +408,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -446,7 +439,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -475,7 +468,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -492,7 +485,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    // inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -580,7 +573,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
                                          message, frame_pointer );
                 } else {
                     result = c_assoc( canonical, env );
-                    inc_ref( result );
+//                    inc_ref( result );
                 }
             }
             break;
@@ -1196,7 +1189,7 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     while ( consp( expressions ) ) {
         struct cons_pointer r = result;
-        inc_ref( r );
+
         result = eval_form( frame, frame_pointer, c_car( expressions ), env );
         dec_ref( r );
 
@@ -1227,7 +1220,6 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
         struct cons_pointer r = result;
-        inc_ref( r );
 
         result = eval_form( frame, frame_pointer, frame->arg[i], env );
 
@@ -1672,7 +1664,6 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
     for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) {
         struct cons_pointer expr =
             make_cons( frame->arg[0], make_cons( c_car( c ), NIL ) );
-        inc_ref( expr );
 
         debug_printf( DEBUG_EVAL, L"Mapcar %d, evaluating ", i );
         debug_print_object( expr, DEBUG_EVAL );
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index 037a96a..0a63221 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -2,9 +2,9 @@
 
 result=0
 
-echo -n "$0: let with two bindings, one form in body..."
 expected='11'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
+echo -n "$0: let with two bindings, one form in body... "
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -14,9 +14,9 @@ else
     result=`echo "${result} + 1" | bc`
 fi
 
-echo -n "$0: let with two bindings, two forms in body..."
 expected='1'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
+echo -n "$0: let with two bindings, two forms in body..."
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
index ea6cf7b..f785155 100755
--- a/unit-tests/progn.sh
+++ b/unit-tests/progn.sh
@@ -4,7 +4,7 @@ result=0
 
 echo -n "$0: progn with one form... "
 expected='5'
-actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -16,7 +16,7 @@ fi
 
 echo -n "$0: progn with two forms... "
 expected='"foo"'
-actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh
index e3aa586..30a6394 100755
--- a/unit-tests/recursion.sh
+++ b/unit-tests/recursion.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='nil 3,628,800'
-output=`target/psse 2>/dev/null <<EOF
+output=`target/psse <<EOF
 (progn
   (set! fact
     (lambda (n)

From 109d400f00bd87af72f6f6ff7f8ced14ecea7a50 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Mon, 16 Mar 2026 15:28:09 +0000
Subject: [PATCH 12/19] Added the unit test for member!

---
 unit-tests/memberp.sh | 107 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100644 unit-tests/memberp.sh

diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
new file mode 100644
index 0000000..ff15ea4
--- /dev/null
+++ b/unit-tests/memberp.sh
@@ -0,0 +1,107 @@
+#!/bin/bash
+
+result=0
+
+expected='t'
+output=`target/psse <<EOF
+(progn
+  (set! nil? (lambda (o) (= (type o) "NIL ")))
+  (set! member? 
+    (lambda
+        (item collection)
+        (cond
+          ((nil? collection) nil)
+          ((= item (car collection)) t)
+          (t (member? item (cdr collection))))))
+  (member? 1 '(1 2 3 4)))
+EOF`
+actual=`echo $output | tail -1`
+
+echo -n "$?: (member? 1 '(1 2 3 4))... "
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+expected='t'
+output=`target/psse <<EOF
+(progn
+  (set! nil? (lambda (o) (= (type o) "NIL ")))
+  (set! member? 
+    (lambda
+      (item collection)
+      (cond
+        ((nil? collection) nil)
+        ((= item (car collection)) t)
+        (t (member? item (cdr collection))))))
+  (member? 4 '(1 2 3 4)))
+EOF`
+actual=`echo $output | tail -1`
+
+echo -n "$?: (member? 4 '(1 2 3 4))... "
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+expected='nil'
+output=`target/psse <<EOF
+(progn
+  (set! nil? (lambda (o) (= (type o) "NIL ")))
+  (set! member? 
+    (lambda
+      (item collection)
+      (cond
+        ((nil? collection) nil)
+        ((= item (car collection)) t)
+        (t (member? item (cdr collection))))))
+  (member? 5 '(1 2 3 4)))
+EOF`
+actual=`echo $output | tail -1`
+
+echo -n "$?: (member? 5 '(1 2 3 4))... "
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+expected='nil'
+output=`target/psse -s100<<EOF
+(progn
+  (set! nil? (lambda (o) (= (type o) "NIL ")))
+  (set! member? 
+    (lambda
+      (item collection)
+      (print (list "in member?: " 'item item 'collection collection))
+      (cond
+        ((nil? collection) nil)
+        ((= item (car collection)) t)
+        (t (member? item (cdr collection))))))
+  (member? 5 '(1 2 3 4)))
+EOF`
+actual=`echo $output | tail -1`
+
+echo -n "$?: (member? 5 '(1 2 3 4)) with stack limit... "
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit $result

From 54a99b6796067facbb5c600fbfdb86d28f7b2bdd Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 18 Mar 2026 11:53:48 +0000
Subject: [PATCH 13/19] Working on the `member?` bug. No fix, but some
 improvements in debug message format.

The bug is actually either in `cond` or in `cdr`, but I'm finding it extremely hard
to trace.
---
 src/memory/stack.c    | 15 +++++++++------
 src/ops/lispops.c     |  8 ++++++--
 unit-tests/memberp.sh | 18 +++++++++---------
 3 files changed, 24 insertions(+), 17 deletions(-)

diff --git a/src/memory/stack.c b/src/memory/stack.c
index 70c07f9..8908fc7 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -37,7 +37,7 @@ uint32_t stack_limit = 0;
  * because that way we can be sure the inc_ref happens!
  */
 void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) {
-    debug_printf( DEBUG_STACK, L"Setting register %d to ", reg );
+    debug_printf( DEBUG_STACK, L"\tSetting register %d to ", reg );
     debug_print_object( value, DEBUG_STACK );
     debug_println( DEBUG_STACK );
     dec_ref( frame->arg[reg] ); /* if there was anything in that slot
@@ -63,10 +63,10 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
 
     if ( vectorpointp( pointer ) && stackframep( vso ) ) {
         result = ( struct stack_frame * ) &( vso->payload );
-        debug_printf( DEBUG_STACK,
-                      L"get_stack_frame: all good, returning %p\n", result );
+        // debug_printf( DEBUG_STACK,
+        //               L"\nget_stack_frame: all good, returning %p\n", result );
     } else {
-        debug_print( L"get_stack_frame: fail, returning NULL\n", DEBUG_STACK );
+        debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
     }
 
     return result;
@@ -133,6 +133,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
+        debug_printf( DEBUG_STACK, 
+            L"WARNING: Exceeded stack limit of %d\n", stack_limit);
         result =
             make_exception( c_string_to_lisp_string
                             ( L"Stack limit exceeded." ), previous );
@@ -182,9 +184,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 result = val;
                 break;
             } else {
-                debug_printf( DEBUG_STACK, L"Setting argument %d to ",
+                debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
                               frame->args );
                 debug_print_object( cell.payload.cons.car, DEBUG_STACK );
+                debug_print(L"\n", DEBUG_STACK);
                 set_reg( frame, frame->args, val );
             }
 
@@ -325,7 +328,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
         for ( int arg = 0; arg < frame->args; arg++ ) {
             struct cons_space_object cell = pointer2cell( frame->arg[arg] );
 
-            url_fwprintf( output, L"Arg %d:\t%4.4s\tcount: %10u\tvalue: ",
+            url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ",
                           arg, cell.tag.bytes, cell.count );
 
             print( output, frame->arg[arg] );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 393cc7b..914301d 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1261,11 +1261,15 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
                                     env ) );
 
 #ifdef DEBUG
-            debug_print( L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL );
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
+            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L" succeeded; returning: ", DEBUG_EVAL );
             debug_print_object( result, DEBUG_EVAL );
             debug_println( DEBUG_EVAL );
         } else {
-            debug_print( L"\n\t\tclause failed.\n", DEBUG_EVAL );
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
+            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L" failed.\n", DEBUG_EVAL );
 #endif
         }
     } else {
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index ff15ea4..ef442f7 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -3,7 +3,7 @@
 result=0
 
 expected='t'
-output=`target/psse <<EOF
+output=`target/psse $1 <<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
   (set! member? 
@@ -17,7 +17,7 @@ output=`target/psse <<EOF
 EOF`
 actual=`echo $output | tail -1`
 
-echo -n "$?: (member? 1 '(1 2 3 4))... "
+echo -n "$0 $1: (member? 1 '(1 2 3 4))... "
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -28,7 +28,7 @@ else
 fi
 
 expected='t'
-output=`target/psse <<EOF
+output=`target/psse $1 <<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
   (set! member? 
@@ -42,7 +42,7 @@ output=`target/psse <<EOF
 EOF`
 actual=`echo $output | tail -1`
 
-echo -n "$?: (member? 4 '(1 2 3 4))... "
+echo -n "$0: (member? 4 '(1 2 3 4))... "
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -54,7 +54,7 @@ fi
 
 
 expected='nil'
-output=`target/psse <<EOF
+output=`target/psse $1 <<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
   (set! member? 
@@ -68,7 +68,7 @@ output=`target/psse <<EOF
 EOF`
 actual=`echo $output | tail -1`
 
-echo -n "$?: (member? 5 '(1 2 3 4))... "
+echo -n "$0: (member? 5 '(1 2 3 4))... "
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -79,13 +79,13 @@ else
 fi
 
 expected='nil'
-output=`target/psse -s100<<EOF
+output=`target/psse $1 -s100<<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
   (set! member? 
     (lambda
       (item collection)
-      (print (list "in member?: " 'item item 'collection collection))
+      ;; (print (list "in member?: " 'item item 'collection collection))
       (cond
         ((nil? collection) nil)
         ((= item (car collection)) t)
@@ -94,7 +94,7 @@ output=`target/psse -s100<<EOF
 EOF`
 actual=`echo $output | tail -1`
 
-echo -n "$?: (member? 5 '(1 2 3 4)) with stack limit... "
+echo -n "$0: (member? 5 '(1 2 3 4)) with stack limit... "
 
 if [ "${expected}" = "${actual}" ]
 then

From 69b199fecd45fd6463cb2fd0607126aa68405fee Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 18 Mar 2026 12:22:12 +0000
Subject: [PATCH 14/19] Found and fixed a bug I did not previously know about
 in `println`.

---
 src/init.c            | 2 +-
 src/io/print.c        | 2 --
 src/memory/stack.c    | 4 ++--
 unit-tests/memberp.sh | 1 +
 4 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/init.c b/src/init.c
index 6e6b106..b0042fb 100644
--- a/src/init.c
+++ b/src/init.c
@@ -454,7 +454,7 @@ int main( int argc, char *argv[] ) {
                    &lisp_print );
     bind_function( L"println",
                    L"`(println stream)`: Print a new line character to `stream`, if specified, else to `*out*`.",
-                   &lisp_print );
+                   &lisp_println );
     bind_function( L"put!", L"", lisp_hashmap_put );
     bind_function( L"put-all!",
                    L"`(put-all! dest source)`: If `dest` is a namespace and is writable, copies all key-value pairs from `source` into `dest`.",
diff --git a/src/io/print.c b/src/io/print.c
index f5f80a5..d9d2998 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -350,8 +350,6 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
         output = pointer2cell( out_stream ).payload.stream.stream;
 
         println( output );
-
-        free( output );
     }
 
     return NIL;
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 8908fc7..6cc68a0 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -97,8 +97,8 @@ struct cons_pointer in_make_empty_frame( struct cons_pointer previous,
         frame->depth = depth;
 
         /*
-         * clearing the frame with memset would probably be slightly quicker, but
-         * this is clear.
+         * The frame has already been cleared with memset in make_vso, but our
+         * NIL is not the same as C's NULL.
          */
         frame->more = NIL;
         frame->function = NIL;
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index ef442f7..a20a8b7 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -60,6 +60,7 @@ output=`target/psse $1 <<EOF
   (set! member? 
     (lambda
       (item collection)
+      (progn (print (list "In member; collection is:" collection)) (println))
       (cond
         ((nil? collection) nil)
         ((= item (car collection)) t)

From 7d0ce67373e280c1933e68c80e80f50cce175736 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 18 Mar 2026 13:27:19 +0000
Subject: [PATCH 15/19] Fixed a segfault when the system can initialise no more
 pages.

Still not fixed the `member?` bug.
---
 lisp/member.lisp      | 28 ++++++++++++++++------------
 src/memory/conspage.c | 12 +++++++-----
 unit-tests/memberp.sh |  4 ++--
 3 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/lisp/member.lisp b/lisp/member.lisp
index b67a7e3..1e0df38 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -1,14 +1,18 @@
-(set! nil? (lambda 
-          (o) 
-          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
-          (= o nil)))
+(set! nil? (lambda (o) (= (type o) "NIL ")))
 
-(set! member? (lambda
-            (item collection)
-            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            (cond
-              ((nil? collection) nil)
-              ((= item (car collection)) t)
-              (t (member? item (cdr collection))))))
+(set! CDR (lambda (o) 
+  (print (list "in CDR; o is: " o) *log*) 
+  (let ((r . (cdr o))) 
+    (print (list "; returning: " r) *log*) 
+    (println *log*) 
+    (println *log*) 
+    r)))
 
-;; (member? (type member?) '("LMDA" "NLMD"))
+(set! member? 
+  (lambda
+    (item collection)
+    (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
+    (cond
+      ((nil? collection) nil)
+      ((= item (car collection)) t)
+      (t (member? item (CDR collection))))))
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 3d96647..9c6ea20 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -65,7 +65,11 @@ struct cons_page *conspages[NCONSPAGES];
  * that exception would have to have been pre-built.
  */
 void make_cons_page(  ) {
-    struct cons_page *result = malloc( sizeof( struct cons_page ) );
+    struct cons_page *result = NULL;
+
+    if ( initialised_cons_pages < NCONSPAGES) {
+        result = malloc( sizeof( struct cons_page ) );
+    }
 
     if ( result != NULL ) {
         conspages[initialised_cons_pages] = result;
@@ -116,12 +120,10 @@ void make_cons_page(  ) {
 
         initialised_cons_pages++;
     } else {
-        debug_printf( DEBUG_ALLOC,
-                      L"FATAL: Failed to allocate memory for cons page %d\n",
-                      initialised_cons_pages );
+        fwide( stderr, 1 );
+        fwprintf( stderr, L"FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages );
         exit( 1 );
     }
-
 }
 
 /**
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index a20a8b7..f3a50af 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -53,7 +53,7 @@ else
 fi
 
 
-expected='nil'
+expected='nil'(CDR )
 output=`target/psse $1 <<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
@@ -86,7 +86,7 @@ output=`target/psse $1 -s100<<EOF
   (set! member? 
     (lambda
       (item collection)
-      ;; (print (list "in member?: " 'item item 'collection collection))
+      ;; (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
       (cond
         ((nil? collection) nil)
         ((= item (car collection)) t)

From dc5cac0bd8663630efa1f8e2fb6f943b38861c13 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 18 Mar 2026 20:44:18 +0000
Subject: [PATCH 16/19] Work on the 'member?' bug - (issue #8) -- which turns
 out to be assoc/interned.

Progress has been made, but this is not fixed.
---
 src/ops/intern.c      | 36 +++++++++++++++++++++++++++++++++---
 src/ops/intern.h      |  3 +++
 src/ops/lispops.c     | 19 ++++++++++++++-----
 unit-tests/memberp.sh |  4 ++--
 4 files changed, 52 insertions(+), 10 deletions(-)

diff --git a/src/ops/intern.c b/src/ops/intern.c
index bba5ee5..6221b2a 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -191,7 +191,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
             for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
                   pair = c_car( assoc ) ) {
                 /* TODO: this is really hammering the memory management system, because
-                 * it will make a new lone for every key/value pair added. Fix. */
+                 * it will make a new clone for every key/value pair added. Fix. */
                 if ( consp( pair ) ) {
                     mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
                 } else if ( hashmapp( pair ) ) {
@@ -338,6 +338,7 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             result =
                                                 return_key ? c_car( entry_ptr )
                                                 : c_cdr( entry_ptr );
+                                            break;
                                         }
                                         break;
                                     case HASHTV:
@@ -426,7 +427,7 @@ struct cons_pointer interned( struct cons_pointer key,
 }
 
 /**
- * @brief Implementation of `interned?` in C: predicate wrapped around interned.
+ * @brief Implementation of `interned?` in C.
  * 
  * @param key the key to search for.
  * @param store the store to search in.
@@ -434,7 +435,36 @@ struct cons_pointer interned( struct cons_pointer key,
  */
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer store ) {
-    return nilp( interned( key, store ) ) ? NIL : TRUE;
+    struct cons_pointer result = NIL;
+
+    if ( consp( store ) ) {
+        for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair );
+                pair = c_car( store ) ) {
+            if ( consp( pair ) ) {
+                if ( equal( c_car( pair), key)) {
+                    // yes, this should be `eq`, but if symbols are correctly 
+                    // interned this will work efficiently, and if not it will
+                    // still work.
+                    result = TRUE; 
+                }
+            } else if ( hashmapp( pair ) ) {
+                result=internedp( key, pair); 
+            } 
+            
+            store = c_cdr( store );
+        }
+    } else if ( hashmapp( store ) ) {
+        struct vector_space_object *map = pointer_to_vso( store );
+
+        for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
+            for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
+                  !nilp( c ); c = c_cdr( c ) ) {
+                result = internedp( key, c);
+            }
+        }
+    }
+
+    return result;
 }
 
 /**
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 18fc084..e54ae7b 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -75,4 +75,7 @@ struct cons_pointer deep_bind( struct cons_pointer key,
 struct cons_pointer intern( struct cons_pointer key,
                             struct cons_pointer environment );
 
+struct cons_pointer internedp( struct cons_pointer key,
+                               struct cons_pointer store );                            
+
 #endif
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 914301d..98c518f 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -919,17 +919,26 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
 struct cons_pointer c_keys( struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
-    if ( hashmapp( store ) ) {
-        result = hashmap_keys( store );
-    } else if ( consp( store ) ) {
-        for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) {
-            result = make_cons( c_car( c ), result );
+    if ( consp( store ) ) {
+        for ( struct cons_pointer pair = c_car( store ); !nilp( pair );
+                pair = c_car( store ) ) {
+            if ( consp( pair ) ) {
+                result = make_cons( c_car( pair), result);
+            } else if ( hashmapp( pair ) ) {
+                result=c_append( hashmap_keys( pair), result);
+            } 
+            
+            store = c_cdr( store );
         }
+    } else if ( hashmapp( store ) ) {
+        result = hashmap_keys( store );
     }
 
     return result;
 }
 
+
+
 struct cons_pointer lisp_keys( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env ) {
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index f3a50af..e1795fc 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -53,14 +53,14 @@ else
 fi
 
 
-expected='nil'(CDR )
+expected='nil'
 output=`target/psse $1 <<EOF
 (progn
   (set! nil? (lambda (o) (= (type o) "NIL ")))
   (set! member? 
     (lambda
       (item collection)
-      (progn (print (list "In member; collection is:" collection)) (println))
+      ;; (progn (print (list "In member; collection is:" collection)) (println))
       (cond
         ((nil? collection) nil)
         ((= item (car collection)) t)

From a20c956288806ad86cae67f066dc31d2d3e84b01 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 18 Mar 2026 21:35:34 +0000
Subject: [PATCH 17/19] 'Fixed' issue #8; but done so by introducing a `goto`.
 Not entirely happy about this.

---
 lisp/member.lisp      |  4 ++--
 src/arith/integer.c   |  5 ++---
 src/debug.h           |  2 +-
 src/init.c            | 13 ++++++++-----
 src/io/io.c           |  4 ++--
 src/memory/conspage.c |  6 ++++--
 src/memory/dump.c     |  8 ++++----
 src/memory/stack.c    |  9 +++++----
 src/ops/intern.c      | 22 +++++++++++-----------
 src/ops/intern.h      |  2 +-
 src/ops/lispops.c     | 41 +++++++++++++++++++++++------------------
 11 files changed, 63 insertions(+), 53 deletions(-)

diff --git a/lisp/member.lisp b/lisp/member.lisp
index 1e0df38..b1225cd 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -11,8 +11,8 @@
 (set! member? 
   (lambda
     (item collection)
-    (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
+    ;; (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
     (cond
       ((nil? collection) nil)
       ((= item (car collection)) t)
-      (t (member? item (CDR collection))))))
+      (t (member? item (cdr collection))))))
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 3688ff5..682efd0 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -245,8 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
         debug_print( L"\n", DEBUG_ARITH );
 
         if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
-            result =
-                acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
+            result = acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
             break;
         } else {
             struct cons_pointer new = make_integer( 0, NIL );
@@ -262,7 +261,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
             is_first_cell = false;
         }
     }
-    
+
     debug_print( L"add_integers returning: ", DEBUG_ARITH );
     debug_print_object( result, DEBUG_ARITH );
     debug_println( DEBUG_ARITH );
diff --git a/src/debug.h b/src/debug.h
index 6c7c8cb..d08df7e 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -84,7 +84,7 @@
  * 
  * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
  */
- #define DEBUG_EQUAL 512
+#define DEBUG_EQUAL 512
 
 extern int verbosity;
 
diff --git a/src/init.c b/src/init.c
index b0042fb..48e4efa 100644
--- a/src/init.c
+++ b/src/init.c
@@ -50,9 +50,9 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
     struct cons_pointer result = pointer;
 
     if ( exceptionp( pointer ) ) {
-        struct cons_space_object * object = &pointer2cell( pointer);
+        struct cons_space_object *object = &pointer2cell( pointer );
         result = NIL;
-        
+
         fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
         URL_FILE *ustderr = file_to_url_file( stderr );
         fwide( stderr, 1 );
@@ -74,7 +74,8 @@ void maybe_bind_init_symbols(  ) {
         privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
     }
     if ( nilp( privileged_keyword_primitive ) ) {
-        privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" );
+        privileged_keyword_primitive =
+            c_string_to_lisp_keyword( L"primitive" );
     }
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
@@ -122,7 +123,8 @@ struct cons_pointer bind_function( wchar_t *name,
         make_cons( make_cons( privileged_keyword_primitive, TRUE ),
                    make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( privileged_keyword_documentation, d ),
+                                         ( privileged_keyword_documentation,
+                                           d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
@@ -151,7 +153,8 @@ struct cons_pointer bind_special( wchar_t *name,
         make_cons( make_cons( privileged_keyword_primitive, TRUE ),
                    make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( privileged_keyword_documentation, d ),
+                                         ( privileged_keyword_documentation,
+                                           d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 9c6ea20..31ab050 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -67,7 +67,7 @@ struct cons_page *conspages[NCONSPAGES];
 void make_cons_page(  ) {
     struct cons_page *result = NULL;
 
-    if ( initialised_cons_pages < NCONSPAGES) {
+    if ( initialised_cons_pages < NCONSPAGES ) {
         result = malloc( sizeof( struct cons_page ) );
     }
 
@@ -121,7 +121,9 @@ void make_cons_page(  ) {
         initialised_cons_pages++;
     } else {
         fwide( stderr, 1 );
-        fwprintf( stderr, L"FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages );
+        fwprintf( stderr,
+                  L"FATAL: Failed to allocate memory for cons page %d\n",
+                  initialised_cons_pages );
         exit( 1 );
     }
 }
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 6cc68a0..0188e6b 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -66,7 +66,8 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
         // debug_printf( DEBUG_STACK,
         //               L"\nget_stack_frame: all good, returning %p\n", result );
     } else {
-        debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
+        debug_print( L"\nget_stack_frame: fail, returning NULL\n",
+                     DEBUG_STACK );
     }
 
     return result;
@@ -133,8 +134,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
-        debug_printf( DEBUG_STACK, 
-            L"WARNING: Exceeded stack limit of %d\n", stack_limit);
+        debug_printf( DEBUG_STACK,
+                      L"WARNING: Exceeded stack limit of %d\n", stack_limit );
         result =
             make_exception( c_string_to_lisp_string
                             ( L"Stack limit exceeded." ), previous );
@@ -187,7 +188,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
                               frame->args );
                 debug_print_object( cell.payload.cons.car, DEBUG_STACK );
-                debug_print(L"\n", DEBUG_STACK);
+                debug_print( L"\n", DEBUG_STACK );
                 set_reg( frame, frame->args, val );
             }
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 6221b2a..989686b 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -338,13 +338,11 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             result =
                                                 return_key ? c_car( entry_ptr )
                                                 : c_cdr( entry_ptr );
-                                            break;
+                                            goto found;
                                         }
                                         break;
                                     case HASHTV:
                                     case NAMESPACETV:
-                                        // TODO: I think this should be impossible, and we should maybe
-                                        // throw an exception.
                                         result =
                                             hashmap_get( entry_ptr, key,
                                                          return_key );
@@ -414,6 +412,8 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             c_type( key ) ), NIL );
     }
 
+  found:
+
     debug_print( L"search-store: returning `", DEBUG_BIND );
     debug_print_object( result, DEBUG_BIND );
     debug_print( L"`\n", DEBUG_BIND );
@@ -438,19 +438,19 @@ struct cons_pointer internedp( struct cons_pointer key,
     struct cons_pointer result = NIL;
 
     if ( consp( store ) ) {
-        for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair );
-                pair = c_car( store ) ) {
+        for ( struct cons_pointer pair = c_car( store );
+              eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
             if ( consp( pair ) ) {
-                if ( equal( c_car( pair), key)) {
+                if ( equal( c_car( pair ), key ) ) {
                     // yes, this should be `eq`, but if symbols are correctly 
                     // interned this will work efficiently, and if not it will
                     // still work.
-                    result = TRUE; 
+                    result = TRUE;
                 }
             } else if ( hashmapp( pair ) ) {
-                result=internedp( key, pair); 
-            } 
-            
+                result = internedp( key, pair );
+            }
+
             store = c_cdr( store );
         }
     } else if ( hashmapp( store ) ) {
@@ -459,7 +459,7 @@ struct cons_pointer internedp( struct cons_pointer key,
         for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
             for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
                   !nilp( c ); c = c_cdr( c ) ) {
-                result = internedp( key, c);
+                result = internedp( key, c );
             }
         }
     }
diff --git a/src/ops/intern.h b/src/ops/intern.h
index e54ae7b..0b8f657 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -76,6 +76,6 @@ struct cons_pointer intern( struct cons_pointer key,
                             struct cons_pointer environment );
 
 struct cons_pointer internedp( struct cons_pointer key,
-                               struct cons_pointer store );                            
+                               struct cons_pointer store );
 
 #endif
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 98c518f..3c0c55b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( privileged_keyword_name,
-                                                   fn_cell->payload.function.
-                                                   meta ) ),
+                                                   fn_cell->payload.
+                                                   function.meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -416,7 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.function.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -490,7 +493,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.special.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -921,13 +927,13 @@ struct cons_pointer c_keys( struct cons_pointer store ) {
 
     if ( consp( store ) ) {
         for ( struct cons_pointer pair = c_car( store ); !nilp( pair );
-                pair = c_car( store ) ) {
+              pair = c_car( store ) ) {
             if ( consp( pair ) ) {
-                result = make_cons( c_car( pair), result);
+                result = make_cons( c_car( pair ), result );
             } else if ( hashmapp( pair ) ) {
-                result=c_append( hashmap_keys( pair), result);
-            } 
-            
+                result = c_append( hashmap_keys( pair ), result );
+            }
+
             store = c_cdr( store );
         }
     } else if ( hashmapp( store ) ) {
@@ -1270,14 +1276,14 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
                                     env ) );
 
 #ifdef DEBUG
-            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
-            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL );
+            debug_print_object( clause, DEBUG_EVAL );
             debug_print( L" succeeded; returning: ", DEBUG_EVAL );
             debug_print_object( result, DEBUG_EVAL );
             debug_println( DEBUG_EVAL );
         } else {
-            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
-            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL );
+            debug_print_object( clause, DEBUG_EVAL );
             debug_print( L" failed.\n", DEBUG_EVAL );
 #endif
         }
@@ -1626,14 +1632,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 788cb48b37a462ce1760b90d61ef696707c97401 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Thu, 19 Mar 2026 13:38:50 +0000
Subject: [PATCH 18/19] Ready for release 0.0.6 (still lots of bugs).

---
 Makefile                                      |   2 +-
 docs/Home.md                                  |  70 ++++-
 docs/Roadmap.md                               |  41 ++-
 docs/State-of-play.md                         |  14 +
 ...The-worlds-slowest-ever-rapid-prototype.md | 240 ++++++++++++++++++
 src/init.c                                    |   4 +-
 src/io/io.c                                   |   4 +-
 src/memory/dump.c                             |   8 +-
 src/ops/lispops.c                             |  23 +-
 9 files changed, 371 insertions(+), 35 deletions(-)
 create mode 100644 docs/The-worlds-slowest-ever-rapid-prototype.md

diff --git a/Makefile b/Makefile
index 27780a5..bc2952b 100644
--- a/Makefile
+++ b/Makefile
@@ -50,7 +50,7 @@ coredumps:
 	ulimit -c unlimited
 
 repl:
-	$(TARGET) -p 2> psse.log
+	$(TARGET) -ps1000 2> tmp/psse.log
 
 
 -include $(DEPS)
diff --git a/docs/Home.md b/docs/Home.md
index f9019a6..b4dfc0e 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -38,25 +38,59 @@ This project is necessarily experimental and exploratory. I write code, it revea
 
 ## Building
 
-The substrate of this system is written in plain old fashioned C and built with a Makefile. I regret this decision; I think either Zig or Rust would have been better places to start; but neither of them were sufficiently well developed to support what I wanted to do when I did start.
+The substrate of this version is written in plain old fashioned C and built with a Makefile. I regret this decision; I think either Zig or Rust would have been better places to start; but neither of them were sufficiently well developed to support what I wanted to do when I did start.
 
 To build, you need a C compiler; I use GCC, others may work. You need a make utility; I use GNU Make. You need [libcurl](https://curl.se/libcurl/).
 
 With these dependencies in place, clone the repository from [here](https://git.journeyman.cc/simon/post-scarcity/), and run `make` in the resulting project directory. If all goes well you will find and executable, `psse`, in the target directory.
 
+This has been developed on Debian but probably builds on any 64 bit UN*X; however I do **not** guarantee this.
+
+### Make targets
+
+#### default
+
+The default `make` target will produce an executable as `target/psse`.
+
+#### clean
+
+`make clean` will remove all compilation detritus; it will also remove temporary files.
+
+#### doc
+
+`make doc` will generate documentation in the `doc` directory. Depends on `doxygen` being present on your system.
+
+#### format
+
+`make format` will standardise the formay of C code. Depends on the GNU `indent` program being present on your system.
+
+#### REPL
+
+`make repl` will start a read-eval-print loop. `*log*` is directed to `tmp/psse.log`.
+
+#### test
+
+`make test` will run all unit tests.
+
 ## In use
 
 What works just now is a not very good, not very efficient Lisp interpreter which does not conform to any existing Lisp standard. You can start a REPL, and you can write and evaluate functions. You can't yet save or load your functions. It's interesting mainly because of its architecture, and where it's intended to go, rather than where it is now.
 
+### Documentation
+
+There is [documentation](https://www.journeyman.cc/post-scarcity/doc/html/).
+
 ### Invoking
 
-When invoking the system, the following invocation arguments may be passed:
+The binary is canonically named `psse`. When invoking the system, the following invocation arguments may be passed:
 ```
         -d      Dump memory to standard out at end of run (copious!);
         -h      Print this message and exit;
         -p      Show a prompt (default is no prompt);
+        -s LIMIT
+                Set a limit to the depth the stack can extend to;
         -v LEVEL
-                Set verbosity to the specified level (0...512)
+                Set verbosity to the specified level (0...1024)
                 Where bits are interpreted as follows:
                 1       ALLOC;
                 2       ARITH;
@@ -66,7 +100,8 @@ When invoking the system, the following invocation arguments may be passed:
                 32      INPUT/OUTPUT;
                 64      LAMBDA;
                 128     REPL;
-                256     STACK.
+                256     STACK;
+                512     EQUAL.
 ```
 
 Note that any verbosity level produces a great deal of output, and although standardising the output to make it more legible is something I'm continually working on, it's still hard to read the output. It is printed to stderr, so can be redirected to a file for later analysis, which is the best plan.
@@ -77,7 +112,10 @@ The following functions are provided as of release 0.0.6:
 
 | Symbol | Type | Documentation |
 | ------ | ---- | ------------- |
-| * | FUNC | `(* args...)` Multiplies these `args`, all of which should be numbers, and return the product. |
+| `*` | FUNC | `(* args...)` Multiplies these `args`, all of which should be numbers, and return the product. |
+| `*in*` | READ | The standard input stream. |
+| `*log*` | WRIT | The standard logging stream (stderr). |
+| `*out*` | WRIT | The standard output stream. |
 | + | FUNC | `(+ args...)`: If `args` are all numbers, returns the sum of those numbers. |
 | - | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | / | FUNC | `(/ a b)`: Divides `a` by `b` and returns the result. Expects both arguments to be numbers. |
@@ -112,7 +150,7 @@ The following functions are provided as of release 0.0.6:
 | multiply | FUNC | `(multiply args...)` Multiply these `args`, all of which should be numbers, and return the product. |
 | negative? | FUNC | `(negative? n)`: Return `t` if `n` is a negative number, else `nil`. |
 | nlambda | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
-| not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. |
+| not | FUNC | `(not arg)`: Return `t` only if `arg` is `nil`, else `nil`. |
 | nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
 | oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. |
 | open | FUNC | `(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading. |
@@ -127,14 +165,26 @@ The following functions are provided as of release 0.0.6:
 | read-char | FUNC | `(read-char stream)`: Return the next character. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment. |
 | repl | FUNC | `(repl prompt input output)`: Starts a new read-eval-print-loop. All arguments are optional. If `prompt` is present, it will be used as the prompt. If `input` is present and is a readable stream, takes input from that stream. If `output` is present and is a writable stream, prints output to that stream. |
 | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
-| set | FUNC | null |
+| set | FUNC | `(set symbol value namespace)`: Binds the value `symbol` in the specified  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace. |
 | set! | SPFM | `(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace. |
 | slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. |
 | source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
-| throw | FUNC | null |
+| throw | FUNC | `(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).|
 | time | FUNC | `(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch. |
-| try | SPFM | null |
+| try | SPFM | `(try forms... (catch symbol forms...))`: Doesn't work yet! |
 | type | FUNC | `(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change. |
-| λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable &lambda; funtion. |
+| λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable &lambda; function. |
+
+## Known bugs 
+
+The following bugs are known in 0.0.6:
+
+1. bignum arithmetic does not work (returns wrong answers, does not throw exception);
+2. subtraction of ratios is broken (returns wrong answers, does not throw exception);
+3. equality of hashmaps is broken (returns wrong answers, does not throw exception);
+4. The garbage collector doesn't work at all well.
+
+There are certainly very many unknown bugs.
+
 
diff --git a/docs/Roadmap.md b/docs/Roadmap.md
index 7cd654b..fb83875 100644
--- a/docs/Roadmap.md
+++ b/docs/Roadmap.md
@@ -15,6 +15,41 @@ However, while I will fix bugs where I can, it's good enough for other people to
 
 ## Next major milestones
 
+### New substrate language?
+
+I really don't feel competent to write the substrate in C, and I don't think 
+that what exists of the substrate is of sufficient quality. It's too big and
+too complex. I think what the system needs is a smaller substrate written in
+a more modern language. 
+
+I propose to evaluate both [Zig](https://ziglang.org/) and 
+[Rust](https://rust-lang.org/), and see whether I can feel more productive in
+either of those. 
+
+### Smaller substrate
+
+However, I also think the substrate ought to be smaller. I
+do not think the substrate should include things like bignum or ratio 
+arithmetic, for example. I'm not convinced that it should include things like
+hashmaps. If these things are to be written in Lisp, though, it means that 
+there have to be Lisp functions which manipulate memory a long way below the
+'[don't know, don't care](Post-scarcity-software.md#store-name-and-value)' 
+dictum; this means that these functions have to be system private. But they
+can be, because access control lists on arbitrary objects have always been
+part of this architecture.
+
+### The 0.1.0 branch
+
+I'm therefore proposing, immediately, to upversion the `develop` branch to
+0.1.0, and restart pretty much from scratch. For now, the C code will remain in
+the development tree, and I may fix bugs which annoy me (and possibly other
+people), but I doubt there now will be a 0.0.7 release, unless I decide that
+the new substrate languages are a bust. 
+
+So release 0.1.0, which I'll target for 1<sup>st</sup> January 2027, will 
+essentially be a Lisp interpreter running on the new substrate and memory
+architecture, without any significant new features.
+
 ### Simulated hypercube
 
 There is really no point to this whole project while it remains a single thread running on a single processor. Until I can pass off computation to peer neighbours, I can't begin to understand what the right strategies are for when to do so.
@@ -27,11 +62,11 @@ For most other things, my hunch is that you pass args which are not self-evaluat
 
 But before that can happen, we need a router on each node which can monitor concurrent traffic on six bidirectional links. I think at least initially what gets written across those links is just S-expressions.
 
-I think a working simulated hypercube is the key milestone for version 0.0.7.
+I think a working simulated hypercube is the key milestone for version 0.1.1.
 
 ### Sysout, sysin, and system persistance
 
-Doctrine is that the post scarcity computing environment doesn't have a file system, but nevertheless we need some way of making an image of a working system so that, after a catastrophic crash or a power outage, it can be brought back up to a known good state. This also really needs to be in 0.0.7. 
+Doctrine is that the post scarcity computing environment doesn't have a file system, but nevertheless we need some way of making an image of a working system so that, after a catastrophic crash or a power outage, it can be brought back up to a known good state. This also really needs to be in 0.1.1. 
 
 ### Better command line experience
 
@@ -39,7 +74,7 @@ The current command line experience is embarrassingly poor. Recallable input his
 
 ### Users, groups and ACLs
 
-Allowing multiple users to work together within the same post scarcity computing environment while retaining security and privacy is a major goal. So working out ways for users to sign on and be authenticated, and to configure their own environment, and to set up their own access control lists on objects they create, needs to be another nearish term goal. Probably 0.0.8.
+Allowing multiple users to work together within the same post scarcity computing environment while retaining security and privacy is a major goal. So working out ways for users to sign on and be authenticated, and to configure their own environment, and to set up their own access control lists on objects they create, needs to be another nearish term goal. Probably 0.1.2.
 
 ### Homogeneities, regularities, slots, migration, permeability
 
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 6ad9c69..55d9bab 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,19 @@
 # State of Play
 
+## 20260319
+
+Right, the `member?` bug [is fixed](https://git.journeyman.cc/simon/post-scarcity/issues/11).
+There are, of course, lots more bugs. But I nevertheless propose to release
+0.0.6 **now**, because there will always be more bugs, quite a lot works, and
+I'm thinking about completely rearchitecting the memory system and, at the same
+time, trying once more to move away from C.
+
+The reasons are given in [this essay](The-worlds-slowest-ever-rapid-prototype.md).
+
+This, of course, completely invalidates the [roadmap](Roadmap.md) that I wrote 
+less than a month ago, but that's because I really have been thinking seriously
+about the future of this project. 
+
 ## 20260316
 
 OK, where we're at: 
diff --git a/docs/The-worlds-slowest-ever-rapid-prototype.md b/docs/The-worlds-slowest-ever-rapid-prototype.md
new file mode 100644
index 0000000..00d42ac
--- /dev/null
+++ b/docs/The-worlds-slowest-ever-rapid-prototype.md
@@ -0,0 +1,240 @@
+# Vector space, Pages, Mark-but-don't-sweep, and the world's slowest ever rapid prototype
+
+By: Simon Brooke :: 13 March 2026
+
+I started work on the Post-scarcity Software Environment on the second of January, 2017; which is to say, more than nine years ago. It was never intended to be a rapid prototype; it was intended, largely, to be a giant thought experiment. But now enough of it does work that I can see fundamental design mistakes, and I'm thinking about whether it's time to treat it as a rapid prototype: to take what has been learned from this code, and instead of trying to fix those mistakes, to start again from scratch.
+
+So what are the mistakes?
+
+## Allocating only cons-sized objects in pages
+
+### What currently happens
+
+The current post-scarcity prototype allocates objects that are the size of a cons cell in 'cons pages'. A cons page is an object that floats in vector space, which is to say the heap, which has a header to identify it, followed by an array of slots each of which is the size of a cons cell. When a cons page is initialised, each slot is initialised as a FREE object, and these are linked together onto the front of the global free list.
+
+A cons pointer comprises a page part and an offset part. The exact size of these two parts is implementation dependent, but in the present implementation they're both uint32_t, which essentially means you can address four billion pages each of four billion slots; consequently, the size of the pointer is 64 bits, which means that the size of the payload of a cons cell is 128 bits. But a cons cell also needs a header to do housekeeping in, which is
+
+struct cons_space_object {
+    union {
+        /** the tag (type) of this cell,
+         * considered as bytes */
+        char bytes[TAGLENGTH];
+        /** the tag considered as a number */
+        uint32_t value;
+    } tag;
+    /** the count of the number of references to this cell */
+    uint32_t count;
+    /** cons pointer to the access control list of this cell */
+    struct cons_pointer access;
+//...
+
+which is to say, 32 bits tag, 32 bits reference count, 64 bits access control list pointer, total 16 bytes. So the whole cell is 32 bytes.
+
+We currently have nineteen different types of object which can fit into the size of the payload of a cons cell (plus FREE, which is sort of a non-object, but must exist), namely
+
+
+|​	| Tag (byte string) 	| Tag (numeric)	| Interpretation |
+| ---- | ---- | ---- | ---- |
+| 1	| CONS	| 1397641027	| An ordinary cons cell. | 
+| 2	| EXEP	| 1346721861	| An exception.| 
+| 3	| FREE	| 1162170950	| An unallocated cell on the free list — should never be encountered by a Lisp function. | 
+| 4	| FUNC	| 1129207110	| An ordinary Lisp function — one whose arguments are pre-evaluated. | 
+| 5	| INTR	| 1381256777	| An integer number (bignums are integers). | 
+| 6	| KEYW	| 1465468235	| A keyword — an interned, self-evaluating string. | 
+| 7	| LMDA	| 1094995276	| A lambda cell. Lambdas are the interpretable (source) versions of functions.| 
+| 8	| LOOP	| 1347374924	| A loop exit is a special kind of exception which has exactly the same payload as an exception.| 
+| 9	| NIL	| 541870414	| The special cons cell at address {0,0} whose car and cdr both point to itself.| 
+| 10	| NLMD	| 1145916494	| An nlambda cell. NLambdas are the interpretable (source) versions of special forms.| 
+| 11	| RTIO	| 1330205778	| A rational number, stored as pointers to two integers representing dividend and divisor respectively| 
+| 12	| READ	| 1145128274	| An open read stream.| 
+| 13	| REAL	| 1279346002	| A real number, represented internally as an IEEE 754-2008 binary128.| 
+| 14	| SPFM	| 1296453715	| A special form — one whose arguments are not pre-evaluated but passed as provided.| 
+| 15	| STRG	| 1196577875	| A string of characters, organised as a linked list.| 
+| 16	| SYMB	| 1112365395	| A symbol is just like a keyword except not self-evaluating.| 
+| 17	| TIME	| 1162692948	| A time stamp, representing milliseconds since the big bang.| 
+| 18	| TRUE	| 1163219540	| The special cons cell at address {0,1} which is canonically different from NIL.| 
+| 19	| VECP	| 1346585942	| A pointer to an object in vector space.| 
+| 20	| WRIT	| 1414091351	| An open write stream.| 
+
+Obviously it is absurdly wasteful to allocate 32 bits to a tag for twenty different types of object, but
+
+1. The type system should be extensible; and
+2. While debugging, it is useful to have human-readable mnemonics as tags.
+
+But the point is, all these types of thing can be allocated into an identical footprint, which means that a cell can be popped off the free list and populated as any one of these; so that memory churn of objects of these types happens only in cons pages, not in the heap.
+Why this is a good thing
+
+Cons cells very often have quite transient life-cycles. They're allocated, and, in the majority of cases, deallocated, in the process of computation; of a single function call. Only a small minority of cons cells become parts of the values of interned symbols, and consequently retained in the long term. In other words, there is a lot of churn of cons cells. If you allocate and deallocate lots of small objects in the heap, the heap rapidly fragments, and then it becomes increasingly difficult to allocate new, larger objects.
+
+But by organising them in pages with an internal free list, we can manage that churn in managed space, and only bother the heap allocator when all the cells in all the pages that we currently have allocated are themselves allocated.
+
+Other objects which live in cons space, such as numbers, are also likely to experience considerable churn. Although I needed to solve the churn problem for cons cells, the fact that the same solution automatically generalises to all other cons space objects is a good thing.
+### Why this needs to be different in future anyway
+
+A two part cons pointer implies a single integrated address space, but in fact in a massively parallel machine we won't have that. In the final machine, the cons pointer would have to comprise three parts: a node part, a page part, and an offset part. And, indeed, in the next iteration of the project it ought to, because in the next iteration I do want to start experimenting with the hypercube topology. So actually, these parts are probably node: 32 bits; page; 8 bits; offset: 24 bits. So that you could have (in a fully populated machine) a hypercube of four billion nodes, each of which can locally address probably 256 pages each of sixteen million cells; and given that a cell is (currently) eight bytes, that's a total potential address space of 4,722,366,482,869,645,213,696 bytes, which is 4.7x1022, which is rather a lot.
+
+You also need an additional cell type, CACH, a cache cell, a specialisation of CONS, whose first pointer points to the (foreign) cell which is cached, and whose second pointer points to the local (i.e. in this node's cons space) copy. When a non-local cell is first requested by EVAL,
+
+1. the communications thread on the node requests it from the ('foreign') node which curates it;
+2. the foreign node increments the reference counter on its copy;
+3. the foreign node sends a representation of the content of the cell hoppity-hop across the grid to the requesting node;
+4. the requesting node pops a cell off its local free list, writes into it the content it has received, increments its reference counter to one, pops a second cell off its free list, writes CACH into the tag, the address of the foreign cell into the first pointer, the address of the newly created copy into the second, and returns this second cell.
+
+When the reference counter on a CACH cell is decremented to zero,
+
+1. the communications thread on the requesting node notifies the curating node that the reference can be decremented;
+2. the curating node decrements the reference and signals back that this has been done;
+3. the requesting node clears both cells and pushes them back onto its free list.
+
+### Why we should generalise this idea: stack frames
+
+We currently allocate stack frames in vector space, which is to say on the heap. The payload of a stack frame is currently 96 bytes (eleven cons pointers plus two 32 bit integers):
+
+```C
+/*
+ * number of arguments stored in a stack frame
+ */
+#define args_in_frame 8
+
+/**
+ * A stack frame. Yes, I know it isn't a cons-space object, but it's defined
+ * here to avoid circularity. \todo refactor.
+ */
+    struct stack_frame {
+        /** the previous frame. */
+        struct cons_pointer previous;
+        /** first 8 arument bindings. */
+        struct cons_pointer arg[args_in_frame];
+        /** list of any further argument bindings. */
+        struct cons_pointer more;
+        /** the function to be called. */
+        struct cons_pointer function;
+        /** the number of arguments provided. */
+        int args;
+        /** the depth of the stack below this frame */
+        int depth;
+    };
+```
+
+But because it's a Lisp object in vector space it also needs a vector space object header, so that we can identify it and manage it:
+
+```c
+/**
+ * the header which forms the start of every vector space object.
+ */
+    struct vector_space_header {
+    /** the tag (type) of this vector-space object. */
+    union {
+        /** the tag considered as bytes. */
+        char bytes[TAGLENGTH];
+        /** the tag considered as a number */
+        uint32_t value;
+    } tag;
+    /** back pointer to the vector pointer which uniquely points to this vso */
+    struct cons_pointer vecp;
+    /** the size of my payload, in bytes */
+    uint64_t size;
+    };
+```
+
+which is a further twenty bytes, so one hundred and sixteen bytes in total. We're allocating one of these objects every time we evaluate a function; we're deallocating one every time we leave a function. The present prototype will happily run up a stack of several tens of thousands of frames, and collapse it back down again, in a single recursive computation.
+
+That's a lot of churn.
+
+If we allocated stack frames in pages, in the same way that we allocate cons cells, that churn would never hit the heap allocator: we would not fragment the heap.
+Generalising the generalisation
+
+So we have one set of objects which are each 32 bytes, and one set which are each 116; and just as there are lots of things which are not cons cells which can be fitted into the payload footprint of a cons cell, so I suspect we may find, when we move on to implementing things like regularities, that there many things which are not stack frames which fit into the payload footprint of a stack frame, more or less.
+
+But the size of a stack frame is closely coupled to the number of registers of the actual hardware of the processor on the node; and though if I ever get round to building an actual prototype that's probably ARM64, I like the idea that there should at least in theory be a custom processor for nodes that runs Lisp on the metal, as the Symbolics Ivory did.
+
+So while a cons cell payload probably really is 128 bits for all time, a stack frame payload is more mutable. Eight argument registers and one 'more' register seems about right to me, but...
+
+However, if we say we will have a number of standard sizes of paged objects; that every paged object shall have the same sized header; that all objects on any given page shall be the same size; and that all pages shall fit into the same footprint (that is to say, a page with larger objects must needs have proportionally fewer of them), then we can say that the standard payload sizes, in bytes, shall be powers of two, and that we don't allocate a page for a standard size until we have a request to allocate an object of that size.
+
+So our standard sizes have payloads of 1, 2, 4, 8, 16, 32, 64, 128, 256, 512...
+
+I've highlighted 16 because that will accommodate all our existing cons space objects; 32 because that will accommodate my current implementation of hash tables and namespaces,128 because that will accommodate stack frames... But actually, we would do a much more efficient implementation of hash tables if we allocated an object big enough to have a separate pointer for each bucket, so we probably already have a need for three distinct standard sizes of object, and, as I say, I see benefit of having a generalised scheme.
+
+In the current prototype I'm allocating pages to fit only 1024 cons cells each, because I wanted to be able to test running a free list across multiple pages. My current idea of the final size of a cons page is that it should accommodate 16 million (224) cells, which is 134 million (227) bytes. So on the generalised scheme, we would be able in principle to allocate a single object of up to ~134 megabytes in a page that would fit sixteen million cells, and we would only need to introduce any fragmentation into the heap if we needed to allocate single objects larger than this.
+
+That seems a very big win.
+## Mark but don't sweep
+
+The post scarcity architecture was designed around the idea of a reference counting garbage collector, and I have a very clear idea of how you can make tracking references, and collecting garbage, work across a hypercube
+
+[^1]: I'm not certain I'm using the word hypercube strictly correctly; the topology I'm contemplating is more than three dimensions but fewer than four. However, the architecture would scale to fractal dimensions greater than four, although I think it would get progressively harder to physically build such machines as the dimensions increase.
+
+ in which pretty much every node is caching copies of objects which actually 'belong to', or are curated by, other nodes — provided that you can make reference counting work at all, which so far I'm struggling to do (but I think this is because I'm stupid, not because it's impossible).
+
+I don't yet have a clear account of how you could make a non-reference counting garbage collector work across a distributed network.
+
+However, I can see how, in having pages of equal sized objects, you can make garbage collection very much faster and can probably do it without even interrupting the evaluation thread.
+
+Conventional mark and sweep garbage collectors — including generational garbage collectors — implement the following algorithm:
+
+1. Halt execution of program evaluation;
+2. Trace every single pointer on every single object in the generation being collected, and mark the object each points to;
+3. Then go through every object in that generation, and those which have not been marked, schedule for overwriting;
+4. Then move objects which have been marked downwards in memory to fill the voids left by objects which have not been marked (this is the sweeping phase);
+5. Then correct all the pointers to all the objects which have been moved;
+6. If that didn't recover enough memory, repeat for the previous generation, recursively;
+7. Finally restart execution.
+
+This is a really complicated operation and takes considerable time. It's this which is the main cause of the annoying pauses in programs which use automatic memory management. Of course, in a reference counting system, when you remove the last link to the top node of a large data structure, there is a cascade of decrements below it, but these can take place in a separate thread and do not have to interrupt program execution.
+
+However, a large part of the cost of the mark-and-sweep algorithm is the sweep phase (and as I say, even generational systems have a sweep phase). The reason you need to sweep is to avoid fragmentation of the heap. If you allocate objects in equal sized pages each of equal sized objects, you can never fragment the heap, so (there is a problem here, but I'm going to ignore it for a moment and then come back to it), you never(ish) need to sweep.
+
+You instead, when a page becomes full,
+
+1. Don't halt program execution, but temporarily mark this page as locked (allocation can continue on other pages);
+2. In a separate thread, trace all the links in this page and pages newer than this page to objects in this page, and mark those objects
+      1. Obviously, if while this is happening the execution thread makes a new link to something on the locked page, then that something needs to be marked;
+3. Clear all the objects which have not been marked, and push them back onto the free list of the page;
+4. If all the objects on this page are now on the free list, deallocate this page. Otherwise, remove the locked marker on this page (allocation can resume on this page).
+
+Program execution never needs to halt. If the node hardware architecture has two cores, an execution core and a communications core, then garbage collection can run on the communications core, and execution doesn't even have to slow. If it proves in practice that this slows communications too much, then perhaps a third core is needed, or perhaps you shift garbage collection back to a separate thread on the evaluation core.
+The problem
+
+So, I said there was a problem. Obviously, a page which is empty (every object in it is FREE) can safely be deallocated, and another page, perhaps for objects of a different size, can later be allocated in the same real estate. The problem is that, in the worst case, you might end up with two (or more) pages for a given size of object each of which was less than half full, but neither of which was empty. I don't currently see how you can merge the two pages into one without doing a mark-and-sweep, and without interrupting execution.
+
+Also, if another node is holding a pointer to an object on one of the two half-empty pages, then the housekeeping to maintain track of which nodes hold pointers to what, and where that has been moved to, becomes very awkward.
+
+So it may be that a hypercube running mark-but-don't-sweep would eventually suffer from coronary artery disease, which would mean this architecture would be a bust. But it might also be that in practice this wouldn't happen; that newer pages — which is inevitably where churn would occur — would automatically empty and be deallocated in the normal course of computation. I don't know; it's quite likely but I certainly don't have a proof of it.
+
+## The substrate language
+
+### Emerging from the stone age
+
+I started work on the post scarcity software environment, as I say, nine years ago. At that time Rust could not do unions, and I was not aware of Zig at all. I needed — or at least, I thought I needed (and still do think I need) a language in which to write the substrate from which Lisp could be bootstrapped: a language in which the memory management layer would be written.
+
+I needed a language in which I could write as close to the metal as possible. I chose C, and because I'm allergic to the Byzantine complexity of C++, I chose plain old vanilla C. I've written large programs in C before, but it is not a language I'm comfortable with. When things break horribly in C — as they do — I really struggle. The thing which has really held development of this system back is that I tried to write bignum arithmetic in C, and I have utterly failed to get it working. And then spent literally years beating myself up about it.
+
+I've also failed to get my garbage collector working to my satisfaction; I don't think I'm incrementing and decrementing counters where I should be, and I feel that far too much garbage is not being collected. But it sort of works. Well enough for now.
+
+The solutions to these problems would probably be absurdly obvious to someone who is actually a good software engineer, rather than just cos-playing one, but they have proved beyond me.
+
+I've been unwilling to change the substrate language, because I've done an awful lot of work in the memory architecture in C and up to now I've been pretty satisfied with that work; and because Rust still doesn't look very appealing to me; and because I really have not yet fully evaluated Zig.
+
+However...
+
+If I am going to do a big rewrite of the bottom layer of the memory allocation system, then it would make sense to write it in a more modern language.
+A bootstrap made of bootstraps
+
+But more! One of the things I'm thinking looking at what I've built so far is that I've tried to do too much in the substrate. Bignums could have been implemented — much more easily, and probably not much less efficiently — in the Lisp layer. So could rationals (and complex numbers, and all sorts of other fancy number systems). So could hash tables and namespaces and regularities and homogeneities and all the other fancy data structures that I want to build.
+
+To do that, I would need a Lisp which had functions to do low level manipulation of memory structures, which is something I don't want 'user level' programmers to be able to do. But I already have a Lisp with access control lists on every data item, including functions. So it will be trivial to implement a :system privilege layer, and to have functions written at that :system privilege layer that most users would not be entitled to invoke.
+Conclusion, for now
+
+Of course, it's now the end of winter, and big software projects are, for me, these days, winter occupations; in summer there is too much to do outside.
+
+But I think my plan now is to
+
+1. get version 0.0.6 just a little bit more polished so that other people can — if they're mad enough — play with it; and then call the 0.0.X series done;
+2. start again with a new 0.1.X series, with a much shallower substrate written probably in Zig, with generalised paged memory objects;
+3. write the access control list system, something of a use authentication system, something of a privilege layer system;
+4. write Lisp functions which can directly manipulate memory objects, and, within the paged memory objects framework, define completely new types of memory objects;
+5. write the north, south, east, west, up, down internode communication channels, so that I can start patching together a virtual hypercube;
+6. write a launcher (in some language) which can launch n3 instances of the same Lisp image as processes on a single conventional UN*X machine, stitch their channels together so that they can communicate, and allow clients to connect (probably over SSH) so that users can open REPL sessions.
+
+If I ever get that completed, the next goal is probably a compiler, and the goal after that build a real physical hypercube of edge 2, probably using ARM or RISC-V processors.
\ No newline at end of file
diff --git a/src/init.c b/src/init.c
index 48e4efa..b0d18da 100644
--- a/src/init.c
+++ b/src/init.c
@@ -487,7 +487,9 @@ int main( int argc, char *argv[] ) {
     bind_function( L"subtract",
                    L"`(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers.",
                    &lisp_subtract );
-    bind_function( L"throw", L"", &lisp_exception );
+    bind_function( L"throw",
+                   L"`(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).",
+                   &lisp_exception );
     bind_function( L"time",
                    L"`(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch.",
                    &lisp_time );
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 3c0c55b..a9dd7ea 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( privileged_keyword_name,
-                                                   fn_cell->payload.
-                                                   function.meta ) ),
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -416,10 +416,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -493,10 +490,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1632,13 +1626,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From e5e0de957c0572e47a386f9e0eea0aaa08199d8d Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Thu, 19 Mar 2026 13:49:56 +0000
Subject: [PATCH 19/19] Release 0.0.6!

---
 docs/Home.md  | 2 +-
 src/init.c    | 4 +++-
 src/version.h | 2 +-
 3 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/docs/Home.md b/docs/Home.md
index b4dfc0e..be2fad6 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -172,7 +172,7 @@ The following functions are provided as of release 0.0.6:
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | throw | FUNC | `(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).|
 | time | FUNC | `(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch. |
-| try | SPFM | `(try forms... (catch symbol forms...))`: Doesn't work yet! |
+| try | SPFM | `(try forms... (catch catch-forms...))`: Evaluate `forms` sequentially, and return the value of the last. If an exception is thrown in any, evaluate `catch-forms` sequentially in an environment in which `*exception*` is bound to that exception, and return the value of the last of these. |
 | type | FUNC | `(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change. |
 | λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable &lambda; function. |
 
diff --git a/src/init.c b/src/init.c
index b0d18da..0bfec24 100644
--- a/src/init.c
+++ b/src/init.c
@@ -537,7 +537,9 @@ int main( int argc, char *argv[] ) {
     bind_special( L"set!",
                   L"`(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace.",
                   &lisp_set_shriek );
-    bind_special( L"try", L"", &lisp_try );
+    bind_special( L"try",
+                  L"`(try forms... (catch catch-forms...))`: Evaluate `forms` sequentially, and return the value of the last. If an exception is thrown in any, evaluate `catch-forms` sequentially in an environment in which `*exception*` is bound to that exception, and return the value of the last of these.",
+                  &lisp_try );
     debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP );
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
 
diff --git a/src/version.h b/src/version.h
index 462f9be..5638bc6 100644
--- a/src/version.h
+++ b/src/version.h
@@ -8,4 +8,4 @@
  *  Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#define VERSION "0.0.6-SNAPSHOT"
+#define VERSION "0.0.6"