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

Work on ensuring new objects are clean, but not sure it's successful.

Browse source 
Also, start on setting up the read ACL on new objects.
This commit is contained in:
Simon Brooke 2026-05-07 06:47:58 +01:00
parent 6b89779bab
commit d1bfb029b8
12 changed files with 141 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/c/environment/environment.c
View file

@ -103,13 +103,13 @@ struct pso_pointer initialise_environment( uint32_t node ) {
debug_print( L"\nEnvironment initialised successfully.\n",
DEBUG_BOOTSTRAP, 0 );
initialise_privileged_keywords( frame_pointer );
result =
initialise_privileged_keywords( make_frame_with_env
( 0, frame_pointer, result ) );
result =
inc_ref( initialise_function_bindings
( push_local
( frame_pointer,
make_frame_with_env( 0, frame_pointer, result ) ) ) );
( make_frame_with_env( 0, frame_pointer, result ) ) );
dec_ref( frame_pointer );
}

24
src/c/environment/function_bindings.c
View file

@ -331,22 +331,22 @@ initialise_function_bindings( struct pso_pointer frame_pointer ) {
for ( int i = 0; function_initialisers[i].executable != NULL; i++ ) {
struct pso_pointer b = c_car( bind_function( frame_pointer,
function_initialisers[i].
name,
function_initialisers[i].
documentation,
function_initialisers[i].
executable ) );
function_initialisers
[i].name,
function_initialisers
[i].documentation,
function_initialisers
[i].executable ) );
result = make_cons( frame_pointer, b, result );
}
for ( int i = 0; special_initialisers[i].executable != NULL; i++ ) {
struct pso_pointer b = c_car( bind_special( frame_pointer,
special_initialisers[i].
name,
special_initialisers[i].
documentation,
special_initialisers[i].
executable ) );
special_initialisers
[i].name,
special_initialisers
[i].documentation,
special_initialisers
[i].executable ) );
result = make_cons( frame_pointer, b, result );
}

26
src/c/environment/privileged_keywords.c
View file

@ -19,6 +19,7 @@
#include "memory/pso.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
#include "ops/string_ops.h"
@ -59,12 +60,27 @@ struct pso_pointer privileged_keyword_system;
*/
struct pso_pointer privileged_keyword_user;
/**
* The symbol whose binding in the eval-time environment sets the read ACL
* for new objects made.
*/
struct pso_pointer privileged_symbol_friends;
#define load_and_lock(var,val)(var = lock_object(c_string_to_lisp_keyword(frame_pointer, val)))
/**
* This seems like a really abusive use of C macros. It *should* work but will
* be extremely brittle. For use in this function and nowhere else!
* I'm grateful to https://pzemtsov.github.io/2014/05/05/do-macro.html for the
* hack.
*/
#define load_and_lock(var,val)do {var = lock_object(c_string_to_lisp_keyword(frame_pointer, val));\
r=make_cons(frame_pointer, make_cons(frame_pointer, var, nil), r);\
} while (0)
struct pso_pointer initialise_privileged_keywords( struct pso_pointer
frame_pointer ) {
struct pso_pointer r = fetch_env( frame_pointer );
load_and_lock( privileged_keyword_bootstrap, PK_BOOTSTRAP );
load_and_lock( privileged_keyword_documentation, PK_DOCUMENTATION );
load_and_lock( privileged_keyword_layer, PK_LAYER );
@ -72,4 +88,12 @@ struct pso_pointer initialise_privileged_keywords( struct pso_pointer
load_and_lock( privileged_keyword_name, PK_NAME );
load_and_lock( privileged_keyword_system, PK_SYSTEM );
load_and_lock( privileged_keyword_user, PK_USER );
privileged_symbol_friends =
lock_object( c_string_to_lisp_symbol( frame_pointer, PS_FRIENDS ) );
r = make_cons( frame_pointer,
make_cons( frame_pointer, privileged_symbol_friends, nil ),
r );
return r;
}

4
src/c/environment/privileged_keywords.h
View file

@ -21,6 +21,8 @@
#define PK_SYSTEM L"system"
#define PK_USER L"user"
#define PS_FRIENDS L"*friends*"
extern struct pso_pointer privileged_keyword_bootstrap;
extern struct pso_pointer privileged_keyword_documentation;
extern struct pso_pointer privileged_keyword_layer;
@ -29,5 +31,7 @@ extern struct pso_pointer privileged_keyword_name;
extern struct pso_pointer privileged_keyword_system;
extern struct pso_pointer privileged_keyword_user;
extern struct pso_pointer privileged_symbol_friends;
struct pso_pointer initialise_privileged_keywords( struct pso_pointer env );
#endif /* SRC_C_ENVIRONMENT_PRIVILEGED_KEYWORDS_H_ */

11
src/c/io/print.c
View file

@ -285,11 +285,14 @@ struct pso_pointer c_write( struct pso_pointer frame_pointer,
struct pso_pointer object,
struct pso_pointer stream, bool escape,
bool nl_before, bool nl_after ) {
struct pso_pointer next_pointer =
push_local( frame_pointer,
make_frame( 5, frame_pointer, object, stream,
struct pso_pointer next_pointer = push_local( frame_pointer,
make_frame( 5, frame_pointer,
object, stream,
escape ? t : nil,
nl_before ? t : nil, nl_after ? t : nil ) );
nl_before ? t :
nil,
nl_after ? t :
nil ) );
struct pso_pointer result =
push_local( frame_pointer, write( next_pointer ) );

36
src/c/io/read.c
View file

@ -136,7 +136,8 @@ struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
if ( characterp( character ) ) {
wchar_t wc = pointer_to_object(character)->payload.character.character;
wchar_t wc =
pointer_to_object( character )->payload.character.character;
if ( !iswspace( wc ) && wc != L',' ) {
result = character;
}
@ -146,8 +147,13 @@ struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) {
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
wint_t wc = url_fgetwc( input );
while ( iswspace(wc) || wc==L',') { wc = url_fgetwc( input); }
result = (wc == WEOF) ? make_eof_exception(frame_pointer) : make_character(frame_pointer, wc);
while ( iswspace( wc ) || wc == L',' ) {
wc = url_fgetwc( input );
}
result =
( wc ==
WEOF ) ? make_eof_exception( frame_pointer ) :
make_character( frame_pointer, wc );
}
return result;
@ -161,7 +167,8 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
if ( !c_nilp( character ) && characterp( character ) &&
pointer_to_object(character)->payload.character.character == SYNTAX_LPAR) {
pointer_to_object( character )->payload.character.character ==
SYNTAX_LPAR ) {
// it's OK if an LPAR is passed in, but we don't want it now.
character = nil;
}
@ -170,16 +177,26 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
}
while ( c_nilp( character ) || ( characterp( character ) &&
pointer_to_object(character)->payload.character.character != SYNTAX_RPAR)) {
character = skip_whitespace( make_frame(3, frame_pointer, stream, readtable, character));
struct pso_pointer r = read( make_frame(3, frame_pointer, stream, readtable, character));
pointer_to_object( character )->
payload.character.character !=
SYNTAX_RPAR ) ) {
character =
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
struct pso_pointer r =
read( make_frame
( 3, frame_pointer, stream, readtable, character ) );
if ( exceptionp( r ) ) {
result = r;
break;
} else {
result = make_cons( frame_pointer, r, result );
character = skip_whitespace( make_frame(3, frame_pointer, stream, readtable, character));
character =
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
}
}
@ -317,7 +334,8 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
/* skip all characters from semi-colon to the end of the line */
break;
case SYNTAX_LPAR:
result = read_list( make_frame(3, stream, readtable, character));
result =
read_list( make_frame( 3, stream, readtable, character ) );
break;
case EOF:
result = make_eof_exception( frame_pointer );

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

@ -25,6 +25,8 @@
#include "debug.h"
#include "environment/privileged_keywords.h"
#include "memory/destroy.h"
#include "memory/header.h"
#include "memory/memory.h"
@ -35,8 +37,11 @@
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/assoc.h"
#include "ops/truth.h"
#include "payloads/stack.h"
#ifdef DEBUG
int allocation_table_allocated = 0;
int allocation_table_freed = 1;
@ -98,7 +103,16 @@ struct pso_pointer cheaty_allocate( struct pso_pointer frame_pointer,
#endif
struct pso2 *obj = pointer_to_object( result );
// ensure memory really is clear, to prevent the 'dirty objects' bug.
int object_size = pow( 2, size_class ) * sizeof( int64_t );
memset( obj, 0, object_size );
// set up basic data
obj->header.tag.bytes.size_class = size_class;
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), tag, TAGLENGTH );
obj->header.access =
c_assoc( privileged_symbol_friends, fetch_env( frame_pointer ) );
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page,
result.offset );

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

@ -27,7 +27,9 @@ uint32_t get_tag_value( struct pso_pointer p ) {
} else {
// TODO: we need to check local cache, and if not found, request a
// copy from the curating node.
fwprintf( stderr, L"WARNING: tag requested of foreign object at node %d, page %d, offset %d.\n", p.node, p.page, p.offset);
fwprintf( stderr,
L"WARNING: tag requested of foreign object at node %d, page %d, offset %d.\n",
p.node, p.page, p.offset );
}
return result;

8
src/c/ops/cond.c
View file

@ -41,9 +41,11 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
#endif
if ( consp( clause ) ) {
struct pso_pointer test_frame =
push_local( frame_pointer,
make_frame( 1, frame_pointer, c_car( clause ) ) );
struct pso_pointer test_frame = push_local( frame_pointer,
make_frame( 1,
frame_pointer,
c_car
( clause ) ) );
struct pso_pointer val = lisp_eval( test_frame );
if ( !c_nilp( val ) ) {

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

@ -158,9 +158,10 @@ struct pso_pointer eval_forms( struct pso_pointer frame_pointer ) {
struct pso_pointer lisp_try( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer body_frame =
push_local( frame_pointer,
make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) );
struct pso_pointer body_frame = push_local( frame_pointer,
make_frame( 1, frame_pointer,
fetch_arg( frame,
0 ) ) );
result = push_local( frame_pointer, lisp_progn( body_frame ) );
@ -501,10 +502,10 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer ) {
debug_print( L"Entering apply\n", DEBUG_EVAL, 0 );
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer fn_frame =
inc_ref( make_frame
( 1, frame_pointer,
c_car( frame->payload.stack_frame.arg[0] ) ) );
struct pso_pointer fn_frame = inc_ref( make_frame( 1, frame_pointer,
c_car( frame->
payload.stack_frame.arg
[0] ) ) );
struct pso_pointer fn_pointer =
push_local( frame_pointer, eval_form( fn_frame ) );
@ -865,9 +866,10 @@ struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) {
struct pso_pointer pair = c_car( cursor );
struct pso_pointer symbol = c_car( pair );
struct pso_pointer next_pointer =
push_local( frame_pointer,
make_frame_with_env( 0, frame_pointer, bindings ) );
struct pso_pointer next_pointer = push_local( frame_pointer,
make_frame_with_env( 0,
frame_pointer,
bindings ) );
if ( symbolp( symbol ) ) {
add_arg( next_pointer, c_cdr( pair ) );

8
src/c/ops/mapcar.c
View file

@ -46,10 +46,10 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
debug_print_object( expr, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL );
struct pso_pointer r =
lisp_eval( push_local
( frame_pointer,
make_frame( 1, frame_pointer, expr ) ) );
struct pso_pointer r = lisp_eval( push_local( frame_pointer,
make_frame( 1,
frame_pointer,
expr ) ) );
if ( exceptionp( r ) ) {
result = r;