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

@@ -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(  ) {

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

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

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

src/ops/intern.c

@@ -316,7 +316,9 @@ struct cons_pointer search_store( struct cons_pointer key,
                   return_key ? "key" : "value" );
 #endif
 
-    if ( symbolp( key ) || keywordp( key ) ) {
+    switch ( get_tag_value( key) ) {
+        case SYMBOLTV:
+        case KEYTV:
             struct cons_space_object *store_cell = &pointer2cell( store );
 
             switch ( get_tag_value( store ) ) {
@@ -389,8 +391,17 @@ struct cons_pointer search_store( struct cons_pointer key,
                                                     c_type( store ) ), NIL );
                     break;
             }
-    } else {
-        // failing with key type NIL here (?). Probably worth dumping the stack?
+            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

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

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