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

Successfully added mutexes protecting freelist access. No behaviour change.

Browse source
This commit is contained in:
Simon Brooke 2026-04-20 13:59:47 +01:00
parent c59825d7fe
commit f05d1af9d6
14 changed files with 132 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/c/io/io.c
View file

@ -167,7 +167,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
env );
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
@ -182,7 +182,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lisp_stdout =
lock_object( make_write_stream
( file_to_url_file( stdout ),
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_string
( L"::system:standard-output" ) ),
@ -195,7 +195,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lisp_stderr =
lock_object( make_write_stream
( file_to_url_file( stderr ),
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_string
( L"::system:standard-output" ) ),
@ -422,7 +422,7 @@ struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key,
long int value ) {
// todo: issue #21: must have stack frame passed in.
return
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta );
}
@ -435,7 +435,7 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key,
mbstowcs( buffer, value, strlen( value ) + 1 );
return
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta );
}

71
src/c/memory/memory.c
View file

@ -7,18 +7,23 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <pthread.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "debug.h"
#include "memory/memory.h"
#include "memory/node.h"
#include "memory/page.h"
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso2.h"
#include "memory/tags.h"
#include "ops/truth.h"
#include "payloads/exception.h"
#include "ops/bind.h"
@ -29,6 +34,11 @@
*/
struct pso_pointer freelists[MAX_SIZE_CLASS];
/**
* Mutices to lock the freelists during access.
*/
pthread_mutex_t freelists_mutices[MAX_SIZE_CLASS];
/**
* @brief Flag to prevent re-initialisation.
*/
@ -63,3 +73,64 @@ struct pso_pointer initialise_memory( uint32_t node ) {
return t;
}
/**
* @brief Pop an object off the freelist for the specified `size_class`.
*/
struct pso_pointer pop_freelist( uint8_t size_class) {
// `t`, because if `allocate_page` fails it will be set to `nil`.
struct pso_pointer result = t;
if ( size_class <= MAX_SIZE_CLASS ) {
if ( nilp( freelists[size_class] ) ) {
result = allocate_page( size_class );
}
if ( nilp( result ) ) {
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 ) ) {
pthread_mutex_lock( &freelists_mutices[size_class]);
result = freelists[size_class];
struct pso2 *object = pointer_to_object( result );
freelists[size_class] = object->payload.free.next;
pthread_mutex_unlock(&freelists_mutices[size_class]);
/* 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 ) {
// TODO: return an exception instead? Or warn, set it, and continue?
}
/* the objext ought to have a reference count ot zero, because it's
* on the freelist, but again we should sanity check. */
if ( object->header.count != 0 ) {
fwprintf( stderr,
L"WARNING: Request to allocate object of size class %d, which is not implemented",
size_class);
}
}
} // TODO: else throw exception
return result;
}
void push_freelist( struct pso_pointer p) {
struct pso2 *obj = pointer_to_object( p );
uint8_t size_class = ( obj->header.tag.bytes.size_class );
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
TAGLENGTH );
pthread_mutex_lock( &freelists_mutices[size_class]);
if ( size_class <= MAX_SIZE_CLASS ) {
obj->payload.free.next = freelists[size_class];
freelists[size_class] = p;
}
pthread_mutex_unlock(&freelists_mutices[size_class]);
}

5
src/c/memory/memory.h
View file

@ -9,6 +9,7 @@
#ifndef __psse_memory_memory_h
#define __psse_memory_memory_h
#include <pthread.h>
#include "memory/pointer.h"
@ -25,6 +26,10 @@
struct pso_pointer initialise_memory( );
struct pso_pointer pop_freelist( uint8_t size_class);
void push_freelist( struct pso_pointer p);
extern struct pso_pointer out_of_memory_exception;
extern struct pso_pointer freelists[];
extern pthread_mutex_t freelists_mutices[];
#endif

4
src/c/memory/page.c
View file

@ -319,11 +319,11 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
L"\nAllocated page %d for objects of size class %x.\n",
npages_allocated, size_class );
pthread_mutex_lock( &freelists_mutices[size_class]);
freelists[size_class] =
initialise_page( ( union page * ) pg, npages_allocated,
size_class, freelists[size_class] );
// result = freelists[size_class];
pthread_mutex_unlock( &freelists_mutices[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",

81
src/c/memory/pso.c
View file

@ -19,6 +19,7 @@
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <wchar.h>
#include "debug.h"
@ -36,14 +37,23 @@
/**
* @brief Allocate an object of this size_class with this tag.
*
* All objects that are allocated (after completion of init)) should be linked
* onto the `locals` slot on a stack frame. This guarantees
* 1. that they get `inc_ref`ed; and that,
* 2. if nothing else hangs onto them they will be reclaimed when that stack
* frame is reclaimed.
* for some objects (e.g. those cons cells on the locals list) this isn't
* possible due to infinite recursion, but those special cases need to be
* audited carefully
*
* @param stack_pointer C (NOT Lisp!) pointer to an active stack frame (or
* NULL, but only during initialisation).
* @param tag The tag. Only the first three bytes will be used;
* @param size_class The size class for the object to be allocated;
* @return struct pso_pointer a pointer to the newly allocated object
*/
struct pso_pointer allocate( char *tag, uint8_t size_class ) {
struct pso_pointer allocate( /* struct pso4 * stack_pointer,*/ char *tag, uint8_t size_class ) {
// todo: issue #21: must have stack frame passed in.
// `t`, because if `allocate_page` fails it will be set to `nil`.
struct pso_pointer result = t;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
@ -51,41 +61,26 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
size_class, tag );
#endif
if ( size_class <= MAX_SIZE_CLASS ) {
if ( nilp( freelists[size_class] ) ) {
result = allocate_page( size_class );
}
struct pso_pointer result = pop_freelist(size_class);
if ( nilp( result ) ) {
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 (!nilp( result)) {
strncpy( ( char * ) ( pointer_to_object(result)->header.tag.bytes.mnemonic ), tag,
TAGLENGTH );
if ( !exceptionp( result ) && !nilp( result ) ) {
result = freelists[size_class];
struct pso2 *object = pointer_to_object( result );
freelists[size_class] = object->payload.free.next;
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 ) {
// TODO: return an exception instead? Or warn, set it, and continue?
}
/* the objext ought to have a reference count ot zero, because it's
* on the freelist, but again we should sanity check. */
if ( object->header.count != 0 ) {
// TODO: return an exception instead? Or warn, set it, and continue?
}
}
} // TODO: else throw exception
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ",
result.page, result.offset );
// if ( stack_pointer != NULL &&
// (stack_pointer->header.tag.value & 0xffffff) == STACKTV) {
// struct pso_pointer locals = make_cons(result,
// stack_pointer->payload.stack_frame.locals);
// stack_pointer->payload.stack_frame.locals = locals;
//
// } else {
// fputws( L"WARNING: No stack frame passed to `allocate`.\n", stderr);
// }
} else {
// TODO: throw exception
}
#ifdef DEBUG
debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC,
@ -208,19 +203,7 @@ struct pso_pointer free_object( struct pso_pointer p ) {
obj->payload.words[i] = 0;
}
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
TAGLENGTH );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
L"Freeing object of size class %d at {%d, %d, %d}",
size_class, p.node, p.page, p.offset );
#endif
/* TODO: obtain mutex on freelist */
obj->payload.free.next = freelists[size_class];
freelists[size_class] = p;
push_freelist(p);
return result;
}

4
src/c/ops/bind.c
View file

@ -35,12 +35,12 @@ struct pso_pointer lisp_bind(
struct pso_pointer value = fetch_arg( frame, 1 );
struct pso_pointer store = fetch_arg( frame, 2 );
return c_cons( c_cons( key, value ), store );
return make_cons( make_cons( key, value ), store );
}
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store ) {
// todo: issue #21: must have stack frame passed in.
return c_cons( c_cons( key, value ), store );
return make_cons( make_cons( key, value ), store );
}

4
src/c/ops/eval_apply.c
View file

@ -84,11 +84,11 @@ struct pso_pointer eval(
// break;
default:
result =
make_exception( c_cons
make_exception( make_cons
( c_string_to_lisp_string
( L"Can't yet evaluate things of this type: " ),
result ), frame_pointer,
c_cons( c_cons
make_cons( make_cons
( c_string_to_lisp_keyword( L"tag" ),
get_tag_string( result ) ), nil ),
nil );

2
src/c/ops/list_ops.c
View file

@ -66,7 +66,7 @@ struct pso_pointer cons(
struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif
return c_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) );
return make_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) );
}
#endif

2
src/c/ops/repl.c
View file

@ -52,7 +52,7 @@ void c_repl( bool show_prompt ) {
signal( SIGINT, int_handler );
debug_print( L"Entered repl\n", DEBUG_REPL, 0 );
struct pso_pointer env = consp( oblist ) ? oblist : c_cons( oblist, nil );
struct pso_pointer env = consp( oblist ) ? oblist : make_cons( oblist, nil );
struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
struct pso_pointer output_stream = c_assoc( lisp_io_out, env );

4
src/c/ops/reverse.c
View file

@ -44,7 +44,7 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) {
struct pso2 *object = pointer_to_object( cursor );
switch ( get_tag_value( cursor ) ) {
case CONSTV:
result = c_cons( c_car( cursor ), result );
result = make_cons( c_car( cursor ), result );
break;
case KEYTV:
// TODO: should you be able to reverse keywords and symbols?
@ -65,7 +65,7 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) {
break;
default:
result =
make_exception( c_cons( c_string_to_lisp_string
make_exception( make_cons( c_string_to_lisp_string
( L"Invalid object in sequence" ),
cursor ), nil, nil, nil );
goto exit;

4
src/c/payloads/cons.c
View file

@ -30,7 +30,7 @@
* @param cdr the pointer which should form the cdr of this cons cell.
* @return struct pso_pointer a pointer to the newly allocated cons cell.
*/
struct pso_pointer c_cons(struct pso_pointer car, struct pso_pointer cdr) {
struct pso_pointer make_cons(struct pso_pointer car, struct pso_pointer cdr) {
// todo: issue #21: must have stack frame passed in.
struct pso_pointer result = allocate( CONSTAG, 2 );
@ -84,7 +84,7 @@ struct pso_pointer c_cdr(struct pso_pointer p) {
break;
default:
result =
make_exception( c_cons
make_exception( make_cons
( c_string_to_lisp_string
( L"Invalid type for cdr" ),
get_tag_string( p ) ), nil, nil, nil );

2
src/c/payloads/cons.h
View file

@ -31,7 +31,7 @@ struct pso_pointer c_car( struct pso_pointer cons );
struct pso_pointer c_cdr( struct pso_pointer cons );
// todo: issue #21: must have stack frame passed in.
struct pso_pointer c_cons( struct pso_pointer car, struct pso_pointer cdr );
struct pso_pointer make_cons( struct pso_pointer car, struct pso_pointer cdr );
struct pso_pointer destroy_cons( struct pso_pointer fp,
struct pso_pointer env );

2
src/c/payloads/stack.c
View file

@ -72,7 +72,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
for ( ; cursor < arg_count; cursor++ ) {
more_args =
c_cons( va_arg( args, struct pso_pointer ), more_args );
make_cons( va_arg( args, struct pso_pointer ), more_args );
}
frame->payload.stack_frame.more = c_reverse( more_args );

4
src/c/payloads/stack.h
View file

@ -31,6 +31,10 @@ struct stack_frame_payload {
struct pso_pointer more;
/** the function to be called. */
struct pso_pointer function;
/** the execute-time environment */
struct pso_pointer env;
/** a list of objects created in the context of this frame */
struct pso_pointer locals;
/** the number of arguments provided. */
uint32_t args;
/** the depth of the stack below this frame */