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

Also, start on setting up the read ACL on new objects.

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
+                     ( make_frame_with_env( 0, frame_pointer, result ) ) );
-                       ( frame_pointer,
-                         make_frame_with_env( 0, frame_pointer, result ) ) ) );
 
         dec_ref( frame_pointer );
     }

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].
+                                                     function_initialisers
-                                                     name,
+                                                     [i].name,
-                                                     function_initialisers[i].
+                                                     function_initialisers
-                                                     documentation,
+                                                     [i].documentation,
-                                                     function_initialisers[i].
+                                                     function_initialisers
-                                                     executable ) );
+                                                     [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].
+                                                    special_initialisers
-                                                    name,
+                                                    [i].name,
-                                                    special_initialisers[i].
+                                                    special_initialisers
-                                                    documentation,
+                                                    [i].documentation,
-                                                    special_initialisers[i].
+                                                    special_initialisers
-                                                    executable ) );
+                                                    [i].executable ) );
         result = make_cons( frame_pointer, b, result );
     }
 

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;
 }

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_ */

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 =
+    struct pso_pointer next_pointer = push_local( frame_pointer,
-        push_local( frame_pointer,
+                                                  make_frame( 5, frame_pointer,
-                    make_frame( 5, frame_pointer, object, stream,
+                                                              object, stream,
-                                escape ? t : nil,
+                                                              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 ) );
 

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
+                                       c_string_to_lisp_string
-                                         ( frame_pointer,
+                                       ( frame_pointer,
-                                           L"Read: end of input while reading" ) ) );
+                                         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)) {
+    if ( characterp( character ) ) {
-        wchar_t wc = pointer_to_object(character)->payload.character.character;
+        wchar_t wc =
-        if (!iswspace( wc) && wc != L',') {
+            pointer_to_object( character )->payload.character.character;
+        if ( !iswspace( wc ) && wc != L',' ) {
             result = character;
         }
     }
 
-    if (c_nilp( result) && readp( stream)) {
+    if ( c_nilp( result ) && readp( stream ) ) {
-        URL_FILE* input = pointer_to_object(stream)->payload.stream.stream;
+        URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
 
-        wint_t wc = url_fgetwc( input);
+        wint_t wc = url_fgetwc( input );
-        while ( iswspace(wc) || wc==L',') { wc = url_fgetwc( input); }
+        while ( iswspace( wc ) || wc == L',' ) {
-        result = (wc == WEOF) ? make_eof_exception(frame_pointer) : make_character(frame_pointer, wc);
+            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) &&
+    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;
     }
-    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) &&
+    while ( c_nilp( character ) || ( characterp( character ) &&
-        pointer_to_object(character)->payload.character.character != SYNTAX_RPAR)) {
+                                     pointer_to_object( character )->
-            character = skip_whitespace( make_frame(3, frame_pointer, stream, readtable, character));
+                                     payload.character.character !=
-            struct pso_pointer r = read( make_frame(3, frame_pointer, stream, readtable, 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)) {
+        if ( exceptionp( r ) ) {
-                result = r;
+            result = r;
-                break;
+            break;
-            } else {
+        } else {
-                result = make_cons( frame_pointer, r, result);
+            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 ) );
         }
+    }
 
-    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,

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 );

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;

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 =
+        struct pso_pointer test_frame = push_local( frame_pointer,
-            push_local( frame_pointer,
+                                                    make_frame( 1,
-                        make_frame( 1, frame_pointer, c_car( clause ) ) );
+                                                                frame_pointer,
+                                                                c_car
+                                                                ( clause ) ) );
         struct pso_pointer val = lisp_eval( test_frame );
 
         if ( !c_nilp( val ) ) {

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 =
+    struct pso_pointer body_frame = push_local( frame_pointer,
-        push_local( frame_pointer,
+                                                make_frame( 1, frame_pointer,
-                    make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) );
+                                                            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 =
+    struct pso_pointer fn_frame = inc_ref( make_frame( 1, frame_pointer,
-        inc_ref( make_frame
+                                                       c_car( frame->
-                 ( 1, frame_pointer,
+                                                              payload.stack_frame.arg
-                   c_car( frame->payload.stack_frame.arg[0] ) ) );
+                                                              [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 =
+        struct pso_pointer next_pointer = push_local( frame_pointer,
-            push_local( frame_pointer,
+                                                      make_frame_with_env( 0,
-                        make_frame_with_env( 0, frame_pointer, bindings ) );
+                                                                           frame_pointer,
+                                                                           bindings ) );
 
         if ( symbolp( symbol ) ) {
             add_arg( next_pointer, c_cdr( pair ) );

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 =
+        struct pso_pointer r = lisp_eval( push_local( frame_pointer,
-            lisp_eval( push_local
+                                                      make_frame( 1,
-                       ( frame_pointer,
+                                                                  frame_pointer,
-                         make_frame( 1, frame_pointer, expr ) ) );
+                                                                  expr ) ) );
 
         if ( exceptionp( r ) ) {
             result = r;

src/c/payloads/stack.c

@@ -362,7 +362,7 @@ 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;
         }