simon/post-scarcity
1
0
Fork 0
Code Issues 3 Pull requests Projects Releases Packages Wiki Activity Actions

Careful debugging of the memory leak problem. At this stage,

Browse source 
stack frames for interpreted (but not primitive) functions appear not to be being
reclaimed, and the oblist doesn't seem to be being fully reclaimed.
This commit is contained in:
Simon Brooke 2026-02-20 19:39:19 +00:00
parent 8629e33f92
commit 70376c6529
14 changed files with 156 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/arith/integer.c
View file

@ -138,7 +138,7 @@ struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
if ( !small_int_cache_initialised ) {
for ( int64_t i = 0; i < SMALL_INT_LIMIT; i++ ) {
small_int_cache[i] = make_integer( i, NIL );
pointer2cell( small_int_cache[i] ).count = UINT32_MAX; // lock it in so it can't be GC'd
pointer2cell( small_int_cache[i] ).count = MAXREFERENCE; // lock it in so it can't be GC'd
}
small_int_cache_initialised = true;
debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );

15
src/init.c
View file

@ -185,6 +185,7 @@ 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" );
#ifdef DEBUG
fwprintf( stream,
L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" );
fwprintf( stream, L"\t\tWhere bits are interpreted as follows:\n" );
@ -197,6 +198,7 @@ void print_options( FILE *stream ) {
fwprintf( stream, L"\t\t64\tLAMBDA;\n" );
fwprintf( stream, L"\t\t128\tREPL;\n" );
fwprintf( stream, L"\t\t256\tSTACK.\n" );
#endif
}
/**
@ -384,14 +386,19 @@ int main( int argc, char *argv[] ) {
repl( show_prompt );
debug_dump_object( oblist, DEBUG_BOOTSTRAP );
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
while ( (pointer2cell(oblist)).count > 0) {
fprintf( stderr, "Dangling refs on oblist: %d\n", (pointer2cell(oblist)).count );
dec_ref( oblist );
}
free_init_symbols( );
if ( dump_at_end ) {
dump_pages( file_to_url_file( stdout ) );
}
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
free_init_symbols( );
summarise_allocation( );
curl_global_cleanup( );
return ( 0 );

3
src/io/print.c
View file

@ -116,6 +116,9 @@ void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
case HASHTV:
print_map( output, pointer );
break;
case STACKFRAMETV:
dump_stack_trace( output, pointer);
break;
// \todo: others.
default:
fwprintf( stderr, L"Unrecognised vector-space type '%d'\n",

9
src/memory/conspage.c
View file

@ -126,9 +126,12 @@ void dump_pages( URL_FILE *output ) {
url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
for ( int j = 0; j < CONSPAGESIZE; j++ ) {
dump_object( output, ( struct cons_pointer ) {
i, j
} );
struct cons_pointer pointer = ( struct cons_pointer ) { i, j};
if (!freep( pointer)) {
dump_object( output, ( struct cons_pointer ) {
i, j
} );
}
}
}
}

18
src/memory/consspaceobject.c
View file

@ -64,6 +64,14 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
if ( cell->count < MAXREFERENCE ) {
cell->count++;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
} else {
debug_println( DEBUG_ALLOC);
}
#endif
}
return pointer;
@ -82,6 +90,14 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
if ( cell->count > 0 && cell->count != UINT32_MAX ) {
cell->count--;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, L"\nDecremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
if ( strncmp( (char *)cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
} else {
debug_println( DEBUG_ALLOC);
}
#endif
if ( cell->count == 0 ) {
free_cell( pointer );
@ -320,7 +336,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
} else {
// \todo should throw an exception!
debug_printf( DEBUG_ALLOC,
L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
L"Warning: only %4.4s can be prepended to %4.4s\n",
tag, tag );
}

5
src/memory/consspaceobject.h
View file

@ -312,6 +312,11 @@
*/
#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV))
/**
* true if `conspoint` points to an unassigned cell, else false
*/
#define freep(conspoint) (check_tag(conspoint,FREETV))
/**
* true if `conspoint` points to a function cell, else false
*/

6
src/memory/vectorspace.c
View file

@ -13,6 +13,8 @@
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
/*
* wide characters
*/
@ -22,6 +24,7 @@
#include "memory/conspage.h"
#include "memory/consspaceobject.h"
#include "debug.h"
#include "io/io.h"
#include "memory/hashmap.h"
#include "memory/stack.h"
#include "memory/vectorspace.h"
@ -123,7 +126,8 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
void free_vso( struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n",
debug_printf( DEBUG_ALLOC, L"About to free vector-space object of type %s at 0x%lx\n",
(char *) cell.payload.vectorp.tag.bytes,
cell.payload.vectorp.address );
struct vector_space_object *vso = cell.payload.vectorp.address;

10
src/ops/equal.c
View file

@ -214,9 +214,9 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
case RATIOTV:
switch ( cell_b->tag.value ) {
case INTEGERTV:
/* as all ratios are simplified by make_ratio, any
/* as ratios are simplified by make_ratio, any
* ratio that would simplify to an integer is an
* integer, */
* integer, TODO: no longer always true. */
result = false;
break;
case REALTV:
@ -278,6 +278,12 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
/* TODO: it is not OK to do this on the stack since list-like
* structures can be of indefinite extent. It *must* be done by
* iteration (and even that is problematic) */
#ifdef DEBUG
debug_print( L"Comparing '", DEBUG_ARITH);
debug_print_object( a, DEBUG_ARITH);
debug_print( L"' to '", DEBUG_ARITH);
debug_print_object( b, DEBUG_ARITH);
#endif
result =
cell_a->payload.string.hash == cell_b->payload.string.hash
&& cell_a->payload.string.character ==

24
src/ops/intern.c
View file

@ -18,6 +18,7 @@
*/
#include <stdbool.h>
#include <string.h>
/*
* wide characters
*/
@ -309,7 +310,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
debug_print( L"`", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND );
debug_print( L"` is a ", DEBUG_BIND );
debug_print_object( c_type( key ), DEBUG_BIND );
debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
}
@ -361,7 +362,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = hashmap_get( store, key );
} else if ( !nilp( store ) ) {
debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
debug_print_object( c_type( store ), DEBUG_BIND );
debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
debug_print( L"`\n", DEBUG_BIND );
result =
throw_exception( c_append
@ -398,8 +399,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
// hashmap to a bigger number of buckets, and return that.
map->payload.hashmap.buckets[bucket_no] =
inc_ref( make_cons( make_cons( key, val ),
map->payload.hashmap.buckets[bucket_no] ) );
make_cons( make_cons( key, val ),
map->payload.hashmap.buckets[bucket_no] );
}
return mapp;
@ -413,6 +414,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
struct cons_pointer store ) {
struct cons_pointer result = NIL;
#ifdef DEBUG
debug_print( L"set: binding `", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND );
debug_print( L"` to `", DEBUG_BIND );
@ -421,8 +423,15 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
debug_dump_object( store, DEBUG_BIND );
debug_println( DEBUG_BIND );
debug_printf( DEBUG_BIND, L"set: store is %s\n`",
lisp_string_to_c_string( c_type( store ) ) );
debug_printf( DEBUG_BIND, L"set: store is %4.4s",
pointer2cell(store).tag.bytes );
if (strncmp(pointer2cell(store).tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
debug_printf( DEBUG_BIND, L" -> %4.4s\n",
pointer2cell(store).payload.vectorp.tag.bytes );
} else {
debug_println( DEBUG_BIND);
}
#endif
if ( nilp( value ) ) {
result = store;
} else if ( nilp( store ) || consp( store ) ) {
@ -440,8 +449,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
}
/**
* @brief Binds this key to this value in the global oblist.
* @brief Binds this `key` to this `value` in the global oblist, and returns the `key`.
*/
struct cons_pointer
deep_bind( struct cons_pointer key, struct cons_pointer value ) {

10
src/ops/lispops.c
View file

@ -92,7 +92,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
{
struct cons_pointer next_pointer =
make_empty_frame( parent_pointer );
inc_ref( next_pointer );
// inc_ref( next_pointer );
struct stack_frame *next = get_stack_frame( next_pointer );
set_reg( next, 0, form );
@ -362,7 +362,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 );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -391,7 +391,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 );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -424,7 +424,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 );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -1269,7 +1269,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer input = get_default_stream( true, env );
struct cons_pointer output = get_default_stream( false, env );
// struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
struct cons_pointer old_oblist = oblist;
struct cons_pointer new_env = env;
@ -1342,6 +1341,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
if ( exceptionp( expr )
&& url_feof( pointer2cell( input ).payload.stream.stream ) ) {
/* suppress printing end of stream exception */
dec_ref( expr);
break;
}