diff --git a/Makefile b/Makefile index 49bf5e1..701b16b 100644 --- a/Makefile +++ b/Makefile @@ -21,13 +21,14 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG LDFLAGS := -lm -lcurl DEBUGFLAGS := -g3 +GCCFLAGS := -std=gnu23 all: $(TARGET) Debug: $(TARGET) $(TARGET): $(OBJS) Makefile - $(CC) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) + $(CC) $(GCCFLAGS) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) doc: $(SRCS) Makefile Doxyfile doxygen diff --git a/src/c/io/read.c b/src/c/io/read.c new file mode 100644 index 0000000..9760023 --- /dev/null +++ b/src/c/io/read.c @@ -0,0 +1,72 @@ +/** + * read.c + * + * Read basic Lisp objects..This is :bootstrap layer print; it needs to be + * able to read characters, symbols, integers, lists and dotted pairs. I + * don't think it needs to be able to read anything else. It must, however, + * take a readtable as argument and expand reader macros. + * + * + * (c) 2017 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include +#include +#include + +/* + * wide characters + */ +#include +#include + +#include "debug.h" +#include "memory/node.h" +#include "memory/pointer.h" +#include "memory/pso2.h" + +#include "io/io.h" +#include "io/read.h" + +#include "payloads/integer.h" +#include "ops/stack_ops.h" + + +// TODO: what I've copied from 0.0.6 is *wierdly* over-complex for just now. +// I think I'm going to essentially delete all this and start again. We need +// to be able to despatch on readttables, and the initial readtable functions +// don't need to be written in Lisp. +// +// In the long run a readtable ought to be a hashtable, but for now an assoc +// list will do. +// +// A readtable function is a Lisp function so needs the stackframe and the +// environment. Other arguments (including the output stream) should be passed +// in the argument, so I think the first arg in the frame is the character read; +// the next is the input stream; the next is the readtable, if any. + +/* + * for the time being things which may be read are: + * * integers + * * lists + * * atoms + * * dotted pairs + */ + +/** + * An example wrapper function while I work out how I'm going to do this. + */ +struct pso_pointer read_example( struct pso4 *frame, + struct pso_pointer frame_pointer, + struct pso_pointer env) { + struct pso_pointer character = fetch_arg( frame, 0); + struct pso_pointer stream = fetch_arg( frame, 1); + struct pso_pointer readtable = fetch_arg( frame, 2); + + return character; +} + + +// struct pso_pointer read diff --git a/src/c/memory/page.c b/src/c/memory/page.c index 2d3319d..c5c735e 100644 --- a/src/c/memory/page.c +++ b/src/c/memory/page.c @@ -152,3 +152,11 @@ struct pso_pointer allocate_page( uint8_t size_class ) { return result; } + +/** + * @brief allow other files to see the current value of npages_allocated, but not + * change it. + */ +uint32_t get_pages_allocated() { + return npages_allocated; +} diff --git a/src/c/memory/page.h b/src/c/memory/page.h index ba64d38..3df37e6 100644 --- a/src/c/memory/page.h +++ b/src/c/memory/page.h @@ -74,4 +74,6 @@ union page { struct pso_pointer allocate_page( uint8_t size_class ); +uint32_t get_pages_allocated(); + #endif diff --git a/src/c/memory/pointer.c b/src/c/memory/pointer.c index 8227151..8120e78 100644 --- a/src/c/memory/pointer.c +++ b/src/c/memory/pointer.c @@ -41,8 +41,13 @@ struct pso2 *pointer_to_object( struct pso_pointer pointer ) { struct pso2 *result = NULL; if ( pointer.node == node_index ) { - union page *pg = pages[pointer.page]; - result = ( struct pso2 * ) &pg->words[pointer.offset]; + if (pointer.page < get_pages_allocated() && pointer.offset < (PAGE_BYTES / 8)) { + // TODO: that's not really a safe test of whether this is a valid pointer. + union page *pg = pages[pointer.page]; + result = ( struct pso2 * ) &pg->words[pointer.offset]; + } else { + // TODO: throw bad pointer exception. + } } // TODO: else if we have a copy of the object in cache, return that; // else request a copy of the object from the node which curates it. diff --git a/src/c/memory/pso2.h b/src/c/memory/pso2.h index 0c36b29..812d582 100644 --- a/src/c/memory/pso2.h +++ b/src/c/memory/pso2.h @@ -12,6 +12,7 @@ #include +#include "../payloads/psse_string.h" #include "memory/header.h" #include "payloads/character.h" #include "payloads/cons.h" @@ -22,7 +23,6 @@ #include "payloads/lambda.h" #include "payloads/nlambda.h" #include "payloads/read_stream.h" -#include "payloads/psse-string.h" #include "payloads/symbol.h" #include "payloads/time.h" #include "payloads/vector_pointer.h" diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c new file mode 100644 index 0000000..8589966 --- /dev/null +++ b/src/c/ops/assoc.c @@ -0,0 +1,92 @@ +/** + * ops/assoc.c + * + * Post Scarcity Software Environment: assoc. + * + * Search a store for the value associated with a key. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "memory/node.h" +#include "memory/pointer.h" +#include "memory/pso2.h" +#include "memory/tags.h" + +#include "payloads/cons.h" + +#include "ops/eq.h" +#include "ops/truth.h" + +/** + * @brief: fundamental search function; only knows about association lists + * + * @param key a pointer indicating the key to search for; + * @param store a pointer indicating the store to search; + * @param return_key if a binding is found for `key` in `store`, if true + * return the key found in the store, else return the value + * + * @return nil if no binding for `key` is found in `store`; otherwise, if + * `return_key` is true, return the key from the store; else + * return the binding. + */ +struct pso_pointer search( struct pso_pointer key, + struct pso_pointer store, + bool return_key ) { + struct pso_pointer result = nil; + bool found = false; + + if (consp( store)) { + for ( struct pso_pointer cursor = store; + consp( store) && found == false; + cursor = cdr( cursor)) { + struct pso_pointer pair = car( cursor); + + if (consp(pair) && equal(car(pair), key)) { + found = true; + result = return_key ? car(pair) : cdr( pair); + } + } + } + + return result; +} + +/** + * @prief: bootstap layer assoc; only knows about association lists. + * + * @param key a pointer indicating the key to search for; + * @param store a pointer indicating the store to search; + * + * @return a pointer to the value of the key in the store, or nil if not found + */ +struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store) { + return search( key, store, false); +} + +/** + * @prief: bootstap layer interned; only knows about association lists. + * + * @param key a pointer indicating the key to search for; + * @param store a pointer indicating the store to search; + * + * @return a pointer to the copy of the key in the store, or nil if not found. + */ +struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store) { + return search( key, store, true); +} + +/** + * @prief: bootstap layer interned; only knows about association lists. + * + * @param key a pointer indicating the key to search for; + * @param store a pointer indicating the store to search; + * + * @return `true` if a pointer the key was found in the store.. + */ +bool internedp(struct pso_pointer key, struct pso_pointer store) { + return !nilp( search( key, store, true)); +} diff --git a/src/c/ops/assoc.h b/src/c/ops/assoc.h new file mode 100644 index 0000000..e5572f9 --- /dev/null +++ b/src/c/ops/assoc.h @@ -0,0 +1,28 @@ +/** + * ops/assoc.h + * + * Post Scarcity Software Environment: assoc. + * + * Search a store for the value associated with a key. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_ops_assoc_h +#define __psse_ops_assoc_h + +#include + +#include "memory/pointer.h" + +struct cons_pointer search( struct pso_pointer key, + struct pso_pointer store, + bool return_key ); + +struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store); + +struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store); + +bool internedp(struct pso_pointer key, struct pso_pointer store); +#endif diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index 8ca0550..ed274f9 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -3,7 +3,7 @@ * * Post Scarcity Software Environment: eq. * - * Test for pointer equality. + * Test for pointer equality; bootstrap level tests for object equality. * * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. @@ -12,6 +12,11 @@ #include "memory/memory.h" #include "memory/node.h" #include "memory/pointer.h" +#include "memory/pso2.h" +#include "memory/tags.h" + +#include "payloads/cons.h" +#include "payloads/integer.h" #include "payloads/stack.h" #include "ops/stack_ops.h" #include "ops/truth.h" @@ -32,6 +37,39 @@ bool eq( struct pso_pointer a, struct pso_pointer b ) { return ( a.node == b.node && a.page == b.page && a.offset == b.offset ); } +bool equal( struct pso_pointer a, struct pso_pointer b) { + bool result = false; + + if ( eq( a, b)) { + result = true; + } else if ( get_tag_value(a) == get_tag_value(b)) { + switch ( get_tag_value(a)) { + case CONSTV : + result = (equal( car(a), car(b)) && equal( cdr(a), cdr(b))); + break; + case INTEGERTV : + result = (pointer_to_object(a)->payload.integer.value == + pointer_to_object(b)->payload.integer.value); + break; + case KEYTV: + case STRINGTV : + case SYMBOLTV : + while (result == false && !nilp(a) && !nilp(b)) { + if (pointer_to_object(a)->payload.string.character == + pointer_to_object(b)->payload.string.character) { + a = cdr(a); + b = cdr(b); + } + } + result = nilp(a) && nilp(b); + break; + } + } + + return result; +} + + /** * Function; do all arguments to this finction point to the same object? * @@ -60,3 +98,5 @@ struct pso_pointer lisp_eq( struct pso4 *frame, return result; } + + diff --git a/src/c/ops/eq.h b/src/c/ops/eq.h index ca330f4..4b4300c 100644 --- a/src/c/ops/eq.h +++ b/src/c/ops/eq.h @@ -22,4 +22,5 @@ struct pso_pointer lisp_eq( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ); +bool equal( struct pso_pointer a, struct pso_pointer b); #endif diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c new file mode 100644 index 0000000..1b70342 --- /dev/null +++ b/src/c/ops/reverse.c @@ -0,0 +1,55 @@ +/** + * ops/reverse.c + * + * Post Scarcity Software Environment: reverse. + * + * Reverse a sequence. Didn'e want to do this in the substrate, but I need + * if for reading atoms!. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "memory/node.h" +#include "memory/pointer.h" +#include "memory/pso.h" +#include "memory/pso2.h" +#include "memory/tags.h" + +#include "payloads/cons.h" +#include "payloads/exception.h" +#include "payloads/psse_string.h" + +#include "ops/string_ops.h" +#include "ops/truth.h" + +struct pso_pointer reverse( struct pso_pointer sequence) { + struct pso_pointer result = nil; + + for (struct pso_pointer cursor = sequence; !nilp( sequence); cursor = cdr(cursor)) { + struct pso2* object = pointer_to_object( cursor); + switch (get_tag_value(cursor)) { + case CONSTV : + result = cons( car(cursor), result); + break; + case KEYTV : + result = make_string_like_thing( object->payload.string.character, result, KEYTAG); + break; + case STRINGTV : + result = make_string_like_thing( object->payload.string.character, result, STRINGTAG); + break; + case SYMBOLTV : + result = make_string_like_thing( object->payload.string.character, result, SYMBOLTAG); + break; + default : + result = make_exception( c_string_to_lisp_string(L"Invalid object in sequence"), nil, nil); + goto exit; + break; + } + } +exit: + + return result; +} diff --git a/src/c/ops/reverse.h b/src/c/ops/reverse.h new file mode 100644 index 0000000..18cb36e --- /dev/null +++ b/src/c/ops/reverse.h @@ -0,0 +1,21 @@ +/** + * ops/reverse.h + * + * Post Scarcity Software Environment: reverse. + * + * Reverse a sequence. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_ops_reverse_h +#define __psse_ops_reverse_h + +#include + +#include "memory/pointer.h" + +struct pso_pointer reverse( struct pso_pointer sequence); + +#endif diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 2417385..8fde4b4 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -14,7 +14,11 @@ #include "memory/pso.h" #include "memory/pso2.h" #include "memory/tags.h" + #include "payloads/cons.h" +#include "payloads/exception.h" + +#include "ops/string_ops.h" /** * @brief allocate a cons cell with this car and this cdr, and return a pointer @@ -58,19 +62,29 @@ struct pso_pointer car( struct pso_pointer cons ) { } /** - * @brief return the cdr of this cons cell. + * @brief return the cdr of this cons (or other sequence) cell. * * @param cons a pointer to the cell. * @return the cdr of the indicated cell. * @exception if the pointer does not indicate a cons cell. */ -struct pso_pointer cdr( struct pso_pointer cons ) { +struct pso_pointer cdr( struct pso_pointer p ) { struct pso_pointer result = nil; struct pso2 *object = pointer_to_object( result ); - if ( consp( cons ) ) { - result = object->payload.cons.cdr; + switch (get_tag_value( p)) { + case CONSTV : result = object->payload.cons.cdr; break; + case KEYTV : + case STRINGTV : + case SYMBOLTV : + result = object->payload.string.cdr; break; + default : + result = make_exception( + cons(c_string_to_lisp_string(L"Invalid type for cdr"), p), + nil, nil); + break; } + // TODO: else throw an exception return result; diff --git a/src/c/payloads/exception.h b/src/c/payloads/exception.h index 1b082ae..bb1777f 100644 --- a/src/c/payloads/exception.h +++ b/src/c/payloads/exception.h @@ -24,6 +24,7 @@ struct exception_payload { struct pso_pointer cause; }; -struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer frame_pointer, struct pso_pointer cause); +struct pso_pointer make_exception( struct pso_pointer message, + struct pso_pointer frame_pointer, struct pso_pointer cause); #endif diff --git a/src/c/payloads/psse-string.h b/src/c/payloads/psse_string.h similarity index 100% rename from src/c/payloads/psse-string.h rename to src/c/payloads/psse_string.h diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c new file mode 100644 index 0000000..7008b20 --- /dev/null +++ b/src/c/payloads/stack.c @@ -0,0 +1,66 @@ +/** + * payloads/stack.h + * + * a Lisp stack frame. + * + * Sits in a pso4. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "memory/node.h" +#include "memory/pointer.h" +#include "memory/pso.h" +#include "memory/pso2.h" +#include "memory/pso4.h" +#include "memory/tags.h" + +/** + * @brief Construct a stack frame with this `previous` pointer, and arguments + * taken from the remaining arguments to this function, which should all be + * struct pso_pointer. + * + * @return a pso_pointer to the stack frame. + */ +struct pso_pointer make_frame( struct pso_pointer previous, ...) { + va_list args; + va_start(args, previous); + int count = va_arg(args, int); + + struct pso_pointer frame_pointer = allocate( STACKTAG, 4); + struct pso4* frame = (struct pso4*)pointer_to_object( frame_pointer); + + frame->payload.stack_frame.previous = previous; + + // I *think* the count starts with the number of args, so there are + // one fewer actual args. Need to test to verify this! + count --; + int cursor = 0; + frame->payload.stack_frame.args = count; + + for ( ; cursor < count && cursor < args_in_frame; cursor++) { + struct pso_pointer argument = va_arg( args, struct pso_pointer); + + frame->payload.stack_frame.arg[cursor] = argument; + } + if ( cursor < count) { + struct pso_pointer more_args = nil; + + for (; cursor < count; cursor++) { + more_args = cons( va_arg( args, struct pso_pointer), more_args); + } + + // should be frame->payload.stack_frame.more = reverse( more_args), but + // we don't have reverse yet. TODO: fix. + frame->payload.stack_frame.more = more_args; + } else { + for (; cursor < args_in_frame; cursor++) { + frame->payload.stack_frame.arg[cursor] = nil; + } + } + + return frame_pointer; +} diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index b33d7a3..a43b1e8 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -37,4 +37,6 @@ struct stack_frame_payload { uint32_t depth; }; +struct pso_pointer make_frame( struct pso_pointer previous, ...); + #endif