Compare commits
2 commits
364d7d2c7b
...
a302663b32
| Author | SHA1 | Date | |
|---|---|---|---|
| a302663b32 | |||
| 1196b3eb1d |
17 changed files with 418 additions and 10 deletions
3
Makefile
3
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
|
||||
|
|
|
|||
72
src/c/io/read.c
Normal file
72
src/c/io/read.c
Normal file
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <math.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#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
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -74,4 +74,6 @@ union page {
|
|||
|
||||
struct pso_pointer allocate_page( uint8_t size_class );
|
||||
|
||||
uint32_t get_pages_allocated();
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -41,8 +41,13 @@ struct pso2 *pointer_to_object( struct pso_pointer pointer ) {
|
|||
struct pso2 *result = NULL;
|
||||
|
||||
if ( pointer.node == node_index ) {
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
|
||||
#include <stdint.h>
|
||||
|
||||
#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"
|
||||
|
|
|
|||
92
src/c/ops/assoc.c
Normal file
92
src/c/ops/assoc.c
Normal file
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#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));
|
||||
}
|
||||
28
src/c/ops/assoc.h
Normal file
28
src/c/ops/assoc.h
Normal file
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_ops_assoc_h
|
||||
#define __psse_ops_assoc_h
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#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
|
||||
|
|
@ -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 <simon@journeyman.cc>
|
||||
* 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;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
55
src/c/ops/reverse.c
Normal file
55
src/c/ops/reverse.c
Normal file
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
21
src/c/ops/reverse.h
Normal file
21
src/c/ops/reverse.h
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
/**
|
||||
* ops/reverse.h
|
||||
*
|
||||
* Post Scarcity Software Environment: reverse.
|
||||
*
|
||||
* Reverse a sequence.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_ops_reverse_h
|
||||
#define __psse_ops_reverse_h
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
struct pso_pointer reverse( struct pso_pointer sequence);
|
||||
|
||||
#endif
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
66
src/c/payloads/stack.c
Normal file
66
src/c/payloads/stack.c
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
/**
|
||||
* payloads/stack.h
|
||||
*
|
||||
* a Lisp stack frame.
|
||||
*
|
||||
* Sits in a pso4.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdarg.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
|
|
@ -37,4 +37,6 @@ struct stack_frame_payload {
|
|||
uint32_t depth;
|
||||
};
|
||||
|
||||
struct pso_pointer make_frame( struct pso_pointer previous, ...);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue