diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index c167eb1..8ae1f52 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -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 ); } diff --git a/src/c/environment/function_bindings.c b/src/c/environment/function_bindings.c index b393c3c..fb5b639 100644 --- a/src/c/environment/function_bindings.c +++ b/src/c/environment/function_bindings.c @@ -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 ); } diff --git a/src/c/environment/privileged_keywords.c b/src/c/environment/privileged_keywords.c index 26f785e..22a010c 100644 --- a/src/c/environment/privileged_keywords.c +++ b/src/c/environment/privileged_keywords.c @@ -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; } diff --git a/src/c/environment/privileged_keywords.h b/src/c/environment/privileged_keywords.h index fe08e4c..0ed2be6 100644 --- a/src/c/environment/privileged_keywords.h +++ b/src/c/environment/privileged_keywords.h @@ -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_ */ diff --git a/src/c/io/print.c b/src/c/io/print.c index e780b20..1c35650 100644 --- a/src/c/io/print.c +++ b/src/c/io/print.c @@ -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, - escape ? t : nil, - nl_before ? t : nil, nl_after ? t : nil ) ); + 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 ) ); struct pso_pointer result = push_local( frame_pointer, write( next_pointer ) ); diff --git a/src/c/io/read.c b/src/c/io/read.c index 56dc306..f17349d 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -87,11 +87,11 @@ struct pso_pointer read_example( struct pso_pointer frame_pointer ) { return result; } -struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer) { +struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) { return make_exception( make_frame( 1, frame_pointer, - c_string_to_lisp_string - ( frame_pointer, - L"Read: end of input while reading" ) ) ); + c_string_to_lisp_string + ( frame_pointer, + L"Read: end of input while reading" ) ) ); } /** @@ -135,19 +135,25 @@ struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) { struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer result = nil; - if (characterp(character)) { - wchar_t wc = pointer_to_object(character)->payload.character.character; - if (!iswspace( wc) && wc != L',') { + if ( characterp( character ) ) { + wchar_t wc = + pointer_to_object( character )->payload.character.character; + if ( !iswspace( wc ) && wc != L',' ) { result = character; } } - if (c_nilp( result) && readp( stream)) { - URL_FILE* input = pointer_to_object(stream)->payload.stream.stream; + if ( c_nilp( result ) && readp( stream ) ) { + 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); + 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 ); } return result; @@ -160,30 +166,41 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) { struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer result = nil; - if (!c_nilp(character) && characterp(character) && - pointer_to_object(character)->payload.character.character == SYNTAX_LPAR) { + if ( !c_nilp( character ) && characterp( character ) && + 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; } - if (!c_nilp( character)) { + if ( !c_nilp( character ) ) { // if anything other than LPAR is passed in as character, TODO: throw exception. } - 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)); + 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 ) ); - 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)); - } + 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 ) ); } + } - return consp(result) ? c_reverse( frame_pointer, result) : result; + return consp( result ) ? c_reverse( frame_pointer, result ) : result; } @@ -317,10 +334,11 @@ 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); + result = make_eof_exception( frame_pointer ); break; default: struct pso_pointer next = make_frame( 3, frame_pointer, stream, diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index b5e97d4..7e5d2c3 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -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 ); diff --git a/src/c/memory/tags.c b/src/c/memory/tags.c index fcb5737..10b1893 100644 --- a/src/c/memory/tags.c +++ b/src/c/memory/tags.c @@ -21,13 +21,15 @@ uint32_t get_tag_value( struct pso_pointer p ) { uint32_t result = 0; - if (p.node == node_index) { + if ( p.node == node_index ) { struct pso2 *object = pointer_to_object( p ); result = object->header.tag.value & 0xffffff; } 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; diff --git a/src/c/ops/cond.c b/src/c/ops/cond.c index d0e5744..90b0511 100644 --- a/src/c/ops/cond.c +++ b/src/c/ops/cond.c @@ -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 ) ) { diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index 5dc79f4..54dbd6b 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -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 ) ); diff --git a/src/c/ops/mapcar.c b/src/c/ops/mapcar.c index d6315b4..3a74a4d 100644 --- a/src/c/ops/mapcar.c +++ b/src/c/ops/mapcar.c @@ -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; diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 9696a92..248793f 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -362,10 +362,10 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp, for ( int i = 0; i < args_in_frame; i++ ) { dec_ref( frame->payload.stack_frame.arg[i] ); - frame->payload.stack_frame.arg[i] = nil; + frame->payload.stack_frame.arg[i] = nil; } - + frame->payload.stack_frame.previous = nil; frame->payload.stack_frame.function = nil; frame->payload.stack_frame.more = nil;