Substantial work on read-list, not yet fully working.

docs/State-of-play.md

@@ -1,5 +1,30 @@
 # State of Play
 
+## 20260506
+
+A day of some achievements. I got `dump` working, although not perfectly, and this helped me diagnose the problem with `equal`, and hence with `assoc`; these are now fixed, and consequently `eval_symbol` now works.
+
+However the problem was that you cannot mix `wchar_t` and `char32_t`: the same character in the two encodings does not have the same value. So I've reversed the [issue 18](https://git.journeyman.cc/simon/post-scarcity/issues/18) fix.
+
+I've started work on reading lists, and although it doesn't completely work yet, it's close.
+
+However!
+
+### Unclean objects
+
+It's been obvious for some time that freshly allocated objects are not always clean. 
+
+I'm seeing entries like these in the logs:
+
+```
+WARNING: Count of 2 in newly allocated object at 3, 5456, should be 0
+WARNING: Count of 4 in newly allocated object at 1, 0, should be 0
+WARNING: Count of 2 in newly allocated object at 4, 5456, should be 0
+WARNING: Count of 8 in newly allocated object at 1, 0, should be 0
+```
+
+What's worse than dirty counts is dirty pointers, and we're seeing those, too. This is particularly dangerous for stack frames, but it isn't good for anything. I have a faint worry — I don't *think* this is the problem — that I might be miscalculating offsets, and have objects interfering with one another. I am going to need to have a thorough go at object sanitation, both when objects are freed, and when they're reallocated. In good news, garbage collection of stack frames really is working — but nothing else is yet getting garbage collected.
+
 ## 20260505
 
 ### The stack frame corruption(?) bug

src/c/io/read.c

@@ -87,6 +87,13 @@ struct pso_pointer read_example( struct pso_pointer frame_pointer ) {
     return result;
 }
 
+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" ) ) );
+}
+
 /**
  * Function: return the next character from the stream indicated by arg 0;
  * further arguments are ignored.
@@ -115,6 +122,71 @@ struct pso_pointer read_character( struct pso_pointer frame_pointer ) {
     return result;
 }
 
+/**
+ * @brief advance the `stream` indicated in arg[0] of this stack frame over any
+ * whitespace characters. The character indicated by arg[2] will be treated as
+ * potentially the first such character. Returns the first non-space character
+ * encountered, or an exception.
+ */
+struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) {
+    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+    struct pso_pointer stream = fetch_arg( frame, 0 );
+    struct pso_pointer readtable = fetch_arg( frame, 1 );
+    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',') {
+            result = character;
+        }
+    }
+
+    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);
+    }
+
+    return result;
+}
+
+struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
+    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+    struct pso_pointer stream = fetch_arg( frame, 0 );
+    struct pso_pointer readtable = fetch_arg( frame, 1 );
+    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) {
+        // it's OK if an LPAR is passed in, but we don't want it now.
+        character = nil;
+    }
+    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));
+
+            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;
+}
+
+
 /**
  * @brief Read one integer from the stream and return it.
  *
@@ -226,7 +298,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
     }
 
     if ( c_nilp( character ) ) {
-        character = read_character( make_frame( 1, frame_pointer, stream ) );
+        character = skip_whitespace( make_frame( 1, frame_pointer, stream ) );
     }
 
     struct pso_pointer readmacro = c_assoc( character, readtable );
@@ -239,16 +311,16 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
         URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
 
         switch ( c ) {
-            case ';':
+            case SYNTAX_SEMICOLON:
                 for ( c = url_fgetwc( input ); c != '\n';
                       c = url_fgetwc( input ) );
                 /* 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));
+                break;
             case EOF:
-                result = make_exception( make_frame( 1, frame_pointer,
+                result = make_eof_exception(frame_pointer);
-                                                     c_string_to_lisp_string
-                                                     ( frame_pointer,
-                                                       L"Read: end of input while reading" ) ) );
                 break;
             default:
                 struct pso_pointer next = make_frame( 3, frame_pointer, stream,

src/c/io/read.h

@@ -13,6 +13,15 @@
 
 #ifndef __psse_io_read_h
 #define __psse_io_read_h
+
+#define SYNTAX_LPAR L'('
+#define SYNTAX_RPAR L')'
+#define SYNTAX_LBRACE L'{'
+#define SYNTAX_RBRACE L'}'
+#define SYNTAX_DOT L'.'
+#define SYNTAX_COLON L':'
+#define SYNTAX_SEMICOLON L';'
+
 struct pso_pointer read_character( struct pso_pointer frame_pointer );
 
 struct pso_pointer read_number( struct pso_pointer frame_pointer );

src/c/memory/tags.c

@@ -20,9 +20,17 @@
 #include "ops/string_ops.h"
 
 uint32_t get_tag_value( struct pso_pointer p ) {
-    struct pso2 *object = pointer_to_object( p );
+    uint32_t result = 0;
+    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);
+    }
 
-    return object->header.tag.value & 0xffffff;
+    return result;
 }
 
 /**
@@ -61,12 +69,12 @@ bool check_tag( struct pso_pointer p, uint32_t v ) {
 
 /**
  * @brief Like check_tag, q.v., but comparing with the string value of the tag
- * rather than the integer value. Only the first TAGLENGTH characters of `s` 
+ * rather than the integer value. Only the first TAGLENGTH characters of `s`
  * are considered.
- * 
+ *
  * @param p a pointer to an object;
  * @param s a string, in C conventions;
- * @return true if the first TAGLENGTH characters of `s` are equal to the tag 
+ * @return true if the first TAGLENGTH characters of `s` are equal to the tag
  *			of the object.
  * @return false otherwise.
  */

src/c/payloads/stack.c

@@ -362,8 +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.previous = nil;
         frame->payload.stack_frame.function = nil;
         frame->payload.stack_frame.more = nil;