More memory debugging, but what it shows is that deallocation is not happening.

src/c/debug.c

@@ -118,15 +118,15 @@ void debug_println( int level ) {
  */
 void debug_printf( int level, int indent, char32_t *format, ... ) {
 #ifdef DEBUG
-//    if ( level & verbosity ) {
+    if ( level & verbosity ) {
-//        fwide( stderr, 1 );
+        fwide( stderr, 1 );
-//        for ( int i = 0; i < indent; i++ ) {
+        for ( int i = 0; i < indent; i++ ) {
-//            fputws( L" ", stderr );
+            fputws( L" ", stderr );
-//        }
+        }
-//        va_list( args );
+        va_list( args );
-//        va_start( args, format );
+        va_start( args, format );
-//        vfwprintf( stderr, format, args );
+        vfwprintf( stderr, format, args );
-//    }
+    }
 #endif
 }
 

src/c/io/io.h

@@ -10,18 +10,17 @@
 
 #ifndef __psse_io_io_h
 #define __psse_io_io_h
+
+#include <stdbool.h>
 #include <curl/curl.h>
 
 /*
  * wide characters
  */
-#include <uchar.h>
-#include <wchar.h>
 #include <wctype.h>
 
+#include "io/fopen.h"
 #include "memory/pointer.h"
-#include "memory/pso2.h"
-#include "memory/pso4.h"
 
 extern CURLSH *io_share;
 

src/c/memory/page.c

@@ -286,7 +286,7 @@ struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
             result = nil;
     }
 
-    debug_print( c_nilp( result ) ? L"fail.\n" : L"success.\n", DEBUG_ALLOC,
+    debug_print( (c_nilp( result ) && (page_index != 0)) ? L"fail.\n" : L"success.\n", DEBUG_ALLOC,
                  0 );
 
     return result;

src/c/memory/pso.c

@@ -19,7 +19,9 @@
 #include <stdint.h>
 #include <stdlib.h>
 #include <string.h>
+#include <uchar.h>
 #include <wchar.h>
+#include <wctype.h>
 
 #include "debug.h"
 
@@ -35,6 +37,26 @@
 
 #include "ops/truth.h"
 
+#ifdef DEBUG
+int allocation_table_allocated = 0;
+int allocation_table_freed = 1;
+
+long int allocation_table[MAX_SIZE_CLASS +1][2];
+
+void print_allocation_table() {
+	fputws( L"| Size class   | Allocated    | Deallocated  | Remaining    |\n", stderr);
+	fputws( L"| ============ | ============ | ============ | ============ |\n", stderr );
+	
+	for ( int s = 2; s<= MAX_SIZE_CLASS; s++) {
+		long int a = allocation_table[s][allocation_table_allocated];
+		long int d = allocation_table[s][allocation_table_freed];
+		long int r = a - d;
+		fwprintf( stderr, L"| %12d | %12ld | %12ld | %12ld |\n", s, a, d, r);
+	}
+	fputws( L"| ============ | ============ | ============ | ============ |\n", stderr );
+}
+#endif
+
 /**
  * @brief a means of creating a cons cell without using a stack frame, to
  * prevent runaway recursion.
@@ -107,6 +129,9 @@ struct pso_pointer allocate( struct pso_pointer frame_pointer, char *tag,
                                                           locals );
             frame->payload.stack_frame.locals = locals;
         }
+#ifdef DEBUG		
+		allocation_table[size_class][allocation_table_allocated]++;
+#endif
     } else {
         //    TODO: throw exception
     }
@@ -145,8 +170,9 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
         object->header.count++;
 #ifdef DEBUG
         debug_printf( DEBUG_ALLOC, 0,
-                      L"\nIncremented object of type %3.3s at page %u, offset %u to count %u",
+                      L"\nIncremented object of type %3.3s, size class %d, at page %u, offset %u to count %u",
-                      ( ( char * ) &object->header.tag.bytes.mnemonic[0] ),
+                      ( ( char * ) &(object->header.tag.bytes.mnemonic[0] )), 
+					  (int)object->header.tag.bytes.size_class,
                       pointer.page, pointer.offset, object->header.count );
         if ( vectorpointp( pointer ) ) {
             debug_printf( DEBUG_ALLOC, 0,
@@ -178,8 +204,9 @@ struct pso_pointer dec_ref( struct pso_pointer pointer ) {
         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 %3.3s, size class %d, at page %d, offset %d to count %d",
                       ( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
+					  (int)object->header.tag.bytes.size_class,
 					  pointer.page, pointer.offset, object->header.count );
         if ( vectorpointp( pointer ) ) {
             debug_printf( DEBUG_ALLOC, 0,
@@ -219,20 +246,30 @@ struct pso_pointer lock_object( struct pso_pointer pointer ) {
  * @brief decrement all pointers pointed to by the object at this pointer;
  * 		clear its memory, and return it to the freelist.
  */
-struct pso_pointer free_object( struct pso_pointer p ) {
+struct pso_pointer free_object( struct pso_pointer pointer ) {
     struct pso_pointer result = nil;
-    struct pso2 *obj = pointer_to_object( p );
+    struct pso2 *object = pointer_to_object( pointer );
-    uint32_t array_size = ( uint32_t ) payload_size( obj );
+    uint32_t array_size = ( uint32_t ) payload_size( object );
-    uint8_t size_class = ( obj->header.tag.bytes.size_class );
+    uint8_t size_class = ( object->header.tag.bytes.size_class );
 
-    result = destroy( p );
+    result = destroy( pointer );
 
     /* will C just let me cheerfully walk off the end of the array I've declared? */
     for ( int i = 0; i < array_size; i++ ) {
-        obj->payload.words[i] = 0;
+        object->payload.words[i] = 0;
     }
 
-    push_freelist( p );
+    push_freelist( pointer );
 
+#ifdef DEBUG		
+	debug_printf( DEBUG_ALLOC, 0, 
+		L"Freeing object of type %3.3s, size class %d, at page %d, offset %d.\n",
+				( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
+							  (int)object->header.tag.bytes.size_class,
+							  pointer.page, pointer.offset, object->header.count 
+	);
+	
+	allocation_table[size_class][allocation_table_freed]++;
+#endif
     return result;
 }

src/c/memory/pso.h

@@ -27,4 +27,7 @@ struct pso_pointer lock_object( struct pso_pointer pointer );
 
 struct pso_pointer free_object( struct pso_pointer p );
 
+#ifdef DEBUG
+void print_allocation_table();
+#endif
 #endif

src/c/psse.c

@@ -149,6 +149,11 @@ int main( int argc, char *argv[] ) {
     repl( bootstrap_stack );
 
     dec_ref( bootstrap_stack );
+	dec_ref( oblist);
+#ifdef DEBUG
+	print_allocation_table();
+#endif
+
 
     exit( 0 );
 }