Written the constructor for exceptions; in the process, added a

metadata slot as a first class slot of exceptions.

.gitignore

@@ -55,3 +55,4 @@ post-scarcity.kdev4
 \.zig-cache/
 sq/
 tmp/
+utils_src/a.out

src/c/environment/environment.c

@@ -58,7 +58,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
             result =
                 make_exception( c_string_to_lisp_string
                                 ( L"Unexpected cell while allocating `nil`." ),
-                                nil, n );
+                                nil, nil, n );
             debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
         }
     }
@@ -79,7 +79,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
             result =
                 make_exception( c_string_to_lisp_string
                                 ( L"Unexpected cell while allocating `t`." ),
-                                nil, n );
+                                nil, nil, n );
             debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
         }
     }

src/c/memory/memory.c

@@ -49,7 +49,7 @@ struct pso_pointer initialise_memory( uint32_t node ) {
     if ( memory_initialised ) {
         result =
             make_exception( c_string_to_lisp_string
-                            ( L"Attenpt to reinitialise memory." ), nil, nil );
+                            ( L"Attenpt to reinitialise memory." ), nil, nil, nil );
     } else {
         for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) {
             freelists[i] = nil;

src/c/memory/tags.c

@@ -13,15 +13,35 @@
 #include <stdint.h>
 #include <string.h>
 
+#include "memory/node.h"
 #include "memory/pointer.h"
 #include "memory/pso2.h"
 
+#include "ops/string_ops.h"
+
 uint32_t get_tag_value( struct pso_pointer p ) {
     struct pso2 *object = pointer_to_object( p );
 
     return object->header.tag.value & 0xffffff;
 }
 
+/**
+ * @brief Return the tag of the object indicated by this pointer as a Lisp
+ * string.
+ *
+ * @param p must be a struct pso_pointer, indicating the appropriate object.
+ */
+struct pso_pointer get_tag_string( struct pso_pointer p) {
+    struct pso_pointer result = nil;
+    struct pso2 *object = pointer_to_object( p );
+
+    for ( int i = 2 - 1; i >= 0; i-- ) {
+        result = make_string( (wchar_t)(object->header.tag.bytes.mnemonic[i]), result );
+    }
+
+    return result;
+}
+
 /**
  * @brief check that the tag of the object indicated by this poiner has this
  * value.

src/c/memory/tags.h

@@ -84,6 +84,8 @@
 // #define get_tag_value(p)((pointer_to_object(p)->header.tag.value) & 0xffffff)
 uint32_t get_tag_value( struct pso_pointer p );
 
+struct pso_pointer get_tag_string( struct pso_pointer p);
+
 /**
  * @brief check that the tag of the object indicated by this poiner has this
  * value.
@@ -103,11 +105,12 @@ bool check_type( struct pso_pointer p, char *s );
 #define exceptionp(p) (check_tag(p, EXCEPTIONTV))
 #define freep(p)    (check_tag(p, FREETV))
 #define functionp(p) (check_tag(p, FUNCTIONTV))
+#define hashtabp(p) (check_tag(p, HASHTV))
 #define integerp(p) (check_tag(p, INTEGERTV))
 #define keywordp(p) (check_tag(p, KEYTV))
 #define lambdap(p)  (check_tag(p,LAMBDATV))
 #define loopp(p)    (check_tag(p,LOOPTV))
-#define namespacep(p)(check_tag(p,NAMESPACETV))
+#define namespacep(p) (check_tag(p,NAMESPACETV))
 // the version of nilp in ops/truth.c is better than this, because it does not
 // require a fetch, and will see nils curated by other nodes as nil.
 // #define nilp(p)     (check_tag(p,NILTV))

src/c/ops/eval_apply.c

@@ -86,7 +86,9 @@ struct pso_pointer eval(
                 make_exception( c_cons
                                 ( c_string_to_lisp_string
                                   ( L"Can't yet evaluate things of this type: " ),
-                                  result ), frame_pointer, nil );
+                                  result ), frame_pointer,
+								  c_cons( c_cons( c_string_to_lisp_keyword(L"tag"),
+										  get_tag_string(result)), nil), nil );
     }
 
     if ( exceptionp( result ) ) {
@@ -95,9 +97,8 @@ struct pso_pointer eval(
                                                                 EXCEPTIONTV );
 
         if ( nilp( x->payload.exception.stack ) ) {
-            inc_ref( result );
             result =
-                make_exception( x->payload.exception.message, frame_pointer,
+                make_exception( x->payload.exception.message, frame_pointer, nil,
                                 result );
         }
     }

src/c/ops/reverse.c

@@ -64,9 +64,9 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) {
                 break;
             default:
                 result =
-                    make_exception( c_string_to_lisp_string
-                                    ( L"Invalid object in sequence" ), nil,
-                                    nil );
+                    make_exception( c_cons( c_string_to_lisp_string
+                                    ( L"Invalid object in sequence" ), cursor), nil,
+                                    nil , nil);
                 goto exit;
                 break;
         }

src/c/ops/string_ops.c

@@ -182,3 +182,5 @@ struct pso_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
 
     return result;
 }
+
+

src/c/payloads/cons.c

@@ -82,9 +82,11 @@ struct pso_pointer c_cdr( struct pso_pointer p ) {
             break;
         default:
             result =
-                make_exception( c_cons
-                                ( c_string_to_lisp_string
-                                  ( L"Invalid type for cdr" ), p ), nil, nil );
+                make_exception(
+                		c_cons(
+                		c_string_to_lisp_string( L"Invalid type for cdr" ),
+								  get_tag_string( p) ),
+								  nil, nil, nil );
             break;
     }
 

src/c/payloads/exception.c

@@ -11,16 +11,45 @@
 #include "memory/node.h"
 #include "memory/pointer.h"
 #include "memory/pso.h"
+#include "memory/pso3.h"
 #include "memory/pso4.h"
 #include "memory/tags.h"
 
 #include "payloads/exception.h"
 
+#include "ops/truth.h"
+
+/**
+ * @brief allocate an exception object, and, if successful, return a pointer
+ * to it.
+ *
+ * Throwing an exception while generating an exception is meaningless. If
+ * allocation fails utterly (i.e. out of heap, out of page space) this will
+ * have to return `nil`, which might give rise to hard to trace bugs. But
+ * otherwise it will return a pointer to a new exception.
+ *
+ * @param message expected to be a string, but anything printable is accepted.
+ * @param frame the stack frame in which the exception was `thrown`, if any.
+ * @param meta metadata for this exception. Must be an assoc list, hashtable,
+ * 		or `nil`
+ * @param cause the exception that caused this exception to be `thrown`.
+ */
 struct pso_pointer make_exception( struct pso_pointer message,
-                                   struct pso_pointer frame_pointer,
+                                   struct pso_pointer frame,
+								   struct pso_pointer meta,
                                    struct pso_pointer cause ) {
-    // TODO: not yet implemented
-    return nil;
+    struct pso_pointer result = allocate(EXCEPTIONTAG, 3);
+
+    if (!nilp(result) && !exceptionp(result)) {
+    	struct pso3* object = (struct pso3*)pointer_to_object( result);
+
+    	object->payload.exception.message = message;
+    	object->payload.exception.stack = stackp(frame) ? frame : nil;
+    	object->payload.exception.meta = (consp(meta) || hashtabp(meta)) ? meta : nil;
+    	object->payload.exception.cause = exceptionp(cause) ? cause : nil;
+    }
+
+    return result;
 }
 
 /**
@@ -34,8 +63,12 @@ struct pso_pointer destroy_exception( struct pso_pointer fp,
     if ( stackp( fp ) ) {
         struct pso4 *frame = pointer_to_pso4( fp );
         struct pso_pointer p = frame->payload.stack_frame.arg[0];
+    	struct pso3* object = (struct pso3*)pointer_to_object( p);
 
-        // TODO: decrement every pointer indicated by an exception.
+        dec_ref( object->payload.exception.message);
+        dec_ref( object->payload.exception.stack);
+        dec_ref( object->payload.exception.meta);
+        dec_ref( object->payload.exception.cause);
     }
 
     return nil;

src/c/payloads/exception.h

@@ -20,12 +20,15 @@ struct exception_payload {
     struct pso_pointer message;
     /** @brief the stack frame at which the exception was thrown. */
     struct pso_pointer stack;
+    /** a store (assoc list or hashtable (or `nil` of metadata */
+    struct pso_pointer meta;
     /** @brief the cause; expected to be another exception, or (usually) `nil`. */
     struct pso_pointer cause;
 };
 
 struct pso_pointer make_exception( struct pso_pointer message,
                                    struct pso_pointer frame_pointer,
+								   struct pso_pointer meta,
                                    struct pso_pointer cause );
 
 struct pso_pointer destroy_exception( struct pso_pointer fp,