Work on ensuring new objects are clean, but not sure it's successful.
Also, start on setting up the read ACL on new objects.
This commit is contained in:
parent
6b89779bab
commit
d1bfb029b8
12 changed files with 141 additions and 72 deletions
|
|
@ -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 );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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_ */
|
||||
|
|
|
|||
|
|
@ -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 ) );
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 ) ) {
|
||||
|
|
|
|||
|
|
@ -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 ) );
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue