src/c/debug.c

@@ -123,6 +123,7 @@ void debug_printf( int level, int indent, wchar_t *format, ... ) {
 #ifdef DEBUG
     if ( level & verbosity ) {
         fwide( stderr, 1 );
+        fputws( L"\n", stderr );
         for ( int i = 0; i < indent; i++ ) {
             fputws( L" ", stderr );
         }

src/c/environment/environment.c

@@ -25,8 +25,6 @@
 #include "payloads/exception.h"
 #include "payloads/psse_string.h"
 
-#include "ops/truth.h"
-
 /**
  * @brief Flag to prevent re-initialisation.
  */
@@ -35,14 +33,14 @@ bool environment_initialised = false;
 /**
  * @brief Initialise a minimal environment, so that Lisp can be bootstrapped.
  * 
- * @param node the index of the node we are initialising.
+ * @param node theindex of the node we are initialising.
  * @return struct pso_pointer t on success, else an exception.
  */
 
 struct pso_pointer initialise_environment( uint32_t node ) {
     struct pso_pointer result = initialise_memory( node );
 
-    if ( truep( result ) ) {
+    if ( !exceptionp( result ) ) {
         debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0);
         struct pso_pointer n = allocate( NILTAG, 2 );
 
@@ -52,7 +50,6 @@ struct pso_pointer initialise_environment( uint32_t node ) {
             object->payload.cons.cdr = nil;
 
             nil = n;
-            lock_object( nil);
             debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
         } else {
             result =
@@ -66,14 +63,12 @@ struct pso_pointer initialise_environment( uint32_t node ) {
         debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0);
         struct pso_pointer n = allocate( TRUETAG, 2 );
 
-        // offset is in words, and size of a pso2 is four words
+        if ( ( n.page == 0 ) && ( n.offset == 1 ) ) {
-        if ( ( n.page == 0 ) && ( n.offset == 4 ) ) {
             struct pso2 *object = pointer_to_object( n );
             object->payload.string.character = L't';
             object->payload.cons.cdr = t;
 
             t = n;
-            lock_object(t);
             debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
         } else {
             result =
@@ -88,7 +83,6 @@ struct pso_pointer initialise_environment( uint32_t node ) {
         result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
 
         environment_initialised = true;
-        debug_print( L"\nEnvironment initialised successfully.\n", DEBUG_BOOTSTRAP, 0);
     }
 
     return result;

src/c/memory/node.c

@@ -41,10 +41,9 @@ struct pso_pointer nil = ( struct pso_pointer ) { 0, 0, 0 };
 
 /**
  * @brief the canonical `t` (true) pointer.
- * Offset 4, because `t` should be the second pso2 allocated, the offset is
+ *
- * given in words, and the size of a pso2 should be four words.
  */
-struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 };
+struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 1 };
 
 
 /**

src/c/memory/page.c

@@ -36,8 +36,6 @@
 
 #include "payloads/free.h"
 
-#include "ops/truth.h"
-
 /**
  * @brief The pages which have so far been initialised.
  * 
@@ -53,181 +51,9 @@ union page *pages[NPAGES];
  */
 uint32_t npages_allocated = 0;
 
-/**
- * Initialise arrays for objects of different size classes, in this case class 2.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso2_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    // we do this backwards (i--) so that object {0, 0, 0} will be first on the
-    // freelist when the first page is initiated, so we can grab that one for 
-    // `nil` and the next on for `t`.
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso2 *object =
-    	            ( struct pso2 * ) &page_addr->pso2s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-/**
- * Initialise arrays for objects of different size classes, in this case class 3.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso3_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso3 *object =
-    	            ( struct pso3 * ) &page_addr->pso3s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-/**
- * Initialise arrays for objects of different size classes, in this case class 4.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso4_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso4 *object =
-    	            ( struct pso4 * ) &page_addr->pso4s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-/**
- * Initialise arrays for objects of different size classes, in this case class 5.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso5_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso5 *object =
-    	            ( struct pso5 * ) &page_addr->pso5s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-/**
- * Initialise arrays for objects of different size classes, in this case class 6.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso6_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso6 *object =
-    	            ( struct pso6 * ) &page_addr->pso6s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-/**
- * Initialise arrays for objects of different size classes, in this case class 7.
- * This is boilerplate code and there must be some way of doing it better, but I don't
- * know it. Macro?
- */
-struct pso_pointer initialise_pso7_array(union page *page_addr, uint16_t page_index,
-                                    uint8_t size_class,
-                                    struct pso_pointer freelist ) {
-    struct pso_pointer result = freelist;
-    int obj_size = pow( 2, size_class );
-    int obj_bytes = obj_size * sizeof( uint64_t );
-    int objs_in_page = PAGE_BYTES / obj_bytes;
-
-    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    	struct pso7 *object =
-    	            ( struct pso7 * ) &page_addr->pso7s[i];
-        object->header.tag.bytes.size_class = size_class;
-        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
-                 TAGLENGTH );
-        object->payload.free.next = result;
-
-        result =
-            make_pointer( node_index, page_index,
-                          ( uint16_t ) ( i * obj_size ) );
-    }
-
-    return result;
-}
-
 /**
  * @brief private to allocate_page; do not use.
- *
+ * 
  * @param page_addr address of the newly allocated page to be initialised;
  * @param page_index its location in the pages[] array;
  * @param size_class the size class of objects in this page;
@@ -237,27 +63,34 @@ struct pso_pointer initialise_pso7_array(union page *page_addr, uint16_t page_in
 struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
                                     uint8_t size_class,
                                     struct pso_pointer freelist ) {
-	struct pso_pointer result = nil;
+    struct pso_pointer result = freelist;
     int obj_size = pow( 2, size_class );
     int obj_bytes = obj_size * sizeof( uint64_t );
     int objs_in_page = PAGE_BYTES / obj_bytes;
 
-    debug_printf(DEBUG_ALLOC, 0,
+    debug_printf(DEBUG_ALLOC, 0, 
-        L"Initialising page %d for objects of size class %d...",
+        L"Initialising page %d for objects of size class %d...", 
         page_index, size_class);
 
-    switch (size_class) {
+    // we do this backwards (i--) so that object {0, 0, 0} will be first on the
-    case 2: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+    // freelist when the first page is initiated, so we can grab that one for 
-    case 3: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+    // `nil` and the next on for `t`.
-    case 4: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+    for ( int i = objs_in_page - 1; i >= 0; i-- ) {
-    case 5: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+        // it should be safe to cast any pso object to a pso2
-    case 6: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+        struct pso2 *object =
-    case 7: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
+            ( struct pso2 * ) ( page_addr + ( i * obj_bytes ) );
-    default:
+
-    	result = nil;
+        object->header.tag.bytes.size_class = size_class;
+        strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
+                 TAGLENGTH );
+        object->payload.free.next = result;
+
+        result =
+            make_pointer( node_index, page_index,
+                          ( uint16_t ) ( i * obj_size ) );
     }
 
-    debug_print( nilp(result)? L"fail.\n" : L"success.\n", DEBUG_ALLOC, 0);
+    debug_print( L"page allocated.\n", DEBUG_ALLOC, 0);
 
     return result;
 }
@@ -287,19 +120,22 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
                 memset( pg, 0, sizeof( union page ) );
                 pages[npages_allocated] = pg;
                 debug_printf( DEBUG_ALLOC, 0,
-                              L"\nAllocated page %d for objects of size class %x.\n",
+                              L"Allocated page %d for objects of size class %x.\n",
                               npages_allocated, size_class );
 
                 freelists[size_class] =
                     initialise_page( ( union page * ) pg, npages_allocated,
                                      size_class, freelists[size_class] );
 
-//                result = freelists[size_class];
-
                 debug_printf( DEBUG_ALLOC, 0,
-                              L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n",
+                              L"Initialised page %d; freelist for size class %x updated.\n",
-                              npages_allocated, size_class,
+                              npages_allocated, size_class );
-							  freelists[size_class].page, freelists[size_class].offset);
+
+                if ( npages_allocated == 0 ) {
+                    // first page allocated; initialise nil and t
+                    nil = lock_object( allocate( NILTAG, 2 ) );
+                    t = lock_object( allocate( TRUETAG, 2 ) );
+                }
 
                 npages_allocated++;
             } else {

src/c/memory/pso.c

@@ -15,7 +15,6 @@
  */
 
 #include <stdbool.h>
-#include <stdlib.h>
 #include <string.h>
 
 #include "debug.h"
@@ -39,8 +38,7 @@
   * @return struct pso_pointer a pointer to the newly allocated object
   */
 struct pso_pointer allocate( char *tag, uint8_t size_class ) {
-	// `t`, because if `allocate_page` fails it will be set to `nil`.
+    struct pso_pointer result = nil;
-    struct pso_pointer result = t;
 
 #ifdef DEBUG
     debug_printf( DEBUG_ALLOC, 0, L"Allocating object of size class %d with tag `%s`... ", size_class, tag);
@@ -51,14 +49,7 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
             result = allocate_page( size_class );
         }
 
-        if (nilp(result)) {
+        if ( !exceptionp( result ) && not( freelists[size_class] ) ) {
-        	fputws( L"FATAL: Page space exhausted\n", stderr );
-        	exit(1); // TODO: we don't want to do this! Somehow, we need to
-        	// recover a workable environment, ideally by throwing a pre-made
-        	// exception.
-        }
-
-        if ( !exceptionp( result ) && !nilp(result)) {
             result = freelists[size_class];
             struct pso2 *object = pointer_to_object( result );
             freelists[size_class] = object->payload.free.next;
@@ -66,8 +57,6 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
             strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
                      TAGLENGTH );
 
-            debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, result.offset);
-
             /* the object ought already to have the right size class in its tag
              * because it was popped off the freelist for that size class. */
             if ( object->header.tag.bytes.size_class != size_class ) {
@@ -78,6 +67,7 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
             if ( object->header.count != 0 ) {
                 // TODO: return an exception instead? Or warn, set it, and continue?
             }
+
         }
     }                           // TODO: else throw exception
 
@@ -137,11 +127,11 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
 struct pso_pointer dec_ref( struct pso_pointer pointer ) {
     struct pso2 *object = pointer_to_object( pointer );
 
-    if ( !nilp(pointer) && object->header.count > 0 && object->header.count != MAXREFERENCE ) {
+    if ( object->header.count > 0 && object->header.count != MAXREFERENCE ) {
         object->header.count--;
 #ifdef DEBUG
         debug_printf( DEBUG_ALLOC, 0,
-                      L"\nDecremented object of type %3.3s at page %d, offset %d to count %d",
+                      L"\nDecremented object of type %4.4s at page %d, offset %d to count %d",
                       ( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
                       pointer.page, pointer.offset, object->header.count );
         if ( vectorpointp( pointer ) ) {

src/c/ops/string_ops.c

@@ -73,7 +73,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
                                            char *tag ) {
     struct pso_pointer pointer = nil;
 
-    if ( check_type( tail, tag ) || nilp(tail) ) {
+    if ( check_type( tail, tag ) || check_tag( tail, NILTV ) ) {
         pointer = allocate( tag, CONS_SIZE_CLASS );
         struct pso2 *cell = pointer_to_object( pointer );
 
@@ -85,10 +85,9 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
         debug_println( DEBUG_ALLOC );
     } else {
         // \todo should throw an exception!
-    	struct pso2* tobj = pointer_to_object( tail);
         debug_printf( DEBUG_ALLOC, 0,
-                      L"Warning: %3.3s cannot be prepended to %3.3s\n",
+                      L"Warning: only %4.4s can be prepended to %4.4s\n",
-                      tag, tobj->header.tag.bytes.mnemonic );
+                      tag, tag );
     }
 
     return pointer;
@@ -127,7 +126,7 @@ struct pso_pointer make_keyword( wint_t c, struct pso_pointer tail ) {
  * @param tail the symbol which is being built.
  */
 struct pso_pointer make_symbol( wint_t c, struct pso_pointer tail ) {
-    return make_string_like_thing( c, tail, SYMBOLTAG );
+    return make_string_like_thing( c, tail, STRINGTAG );
 }
 
 

src/c/ops/truth.c

@@ -49,15 +49,12 @@ bool not( struct pso_pointer p ) {
  * each is considered equivalent. So we don't check the node when considering
  * whether `nil` really is `nil`, or `t` really is `t`.
  * 
- * Note that the offset is 4 because `t` should be the second pso2 allocated,
- * the offset is given in words, and the size of a pso2 should be four words
- *
  * @param p a pointer
  * @return true if `p` points to `t`.
  * @return false otherwise.
  */
 bool truep( struct pso_pointer p ) {
-    return ( p.page == 0 && p.offset == 4 );
+    return ( p.page == 0 && p.offset == 1 );
 }
 
 /**

src/c/payloads/psse_string.h

@@ -33,6 +33,8 @@ struct string_payload {
     struct pso_pointer cdr;
 };
 
+struct pso_pointer make_string( wint_t c, struct pso_pointer tail );
+
 struct pso_pointer destroy_string( struct pso_pointer fp,
                                    struct pso_pointer env );
 

src/c/payloads/stack.c

@@ -78,17 +78,19 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
                                         struct pso_pointer env ) {
     if ( stackp( fp ) ) {
         struct pso4 *frame = pointer_to_pso4( fp );
+        struct pso4 *casualty =
+            pointer_to_pso4( frame->payload.stack_frame.arg[0] );
 
-        dec_ref( frame->payload.stack_frame.previous );
+        dec_ref( casualty->payload.stack_frame.previous );
-        dec_ref( frame->payload.stack_frame.function );
+        dec_ref( casualty->payload.stack_frame.function );
-        dec_ref( frame->payload.stack_frame.more );
+        dec_ref( casualty->payload.stack_frame.more );
 
         for ( int i = 0; i < args_in_frame; i++ ) {
-            dec_ref( frame->payload.stack_frame.arg[i] );
+            dec_ref( casualty->payload.stack_frame.arg[i] );
         }
 
-        frame->payload.stack_frame.args = 0;
+        casualty->payload.stack_frame.args = 0;
-        frame->payload.stack_frame.depth = 0;
+        casualty->payload.stack_frame.depth = 0;
     }
 
     return nil;