simon/post-scarcity
1
0
Fork 0
Code Issues 18 Pull requests Projects Releases Packages Wiki Activity Actions

Still making progress. Dropped the archive because it was causing problems.

Browse source
This commit is contained in:
Simon Brooke 2026-04-22 21:09:15 +01:00
parent eed4711fee
commit 8d2acbeb0f
97 changed files with 490 additions and 13322 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/c/payloads/character.h
View file

@ -38,5 +38,6 @@ struct character_payload {
char32_t character;
};
struct pso_pointer make_character( struct pso_pointer frame_pointer, wint_t c );
struct pso_pointer make_character( struct pso_pointer frame_pointer,
wint_t c );
#endif

142
src/c/payloads/cons.c
View file

@ -31,19 +31,21 @@
* @param frame_pointer a pointer to a stack frame.
* @return struct pso_pointer a pointer to the newly allocated cons cell.
*/
struct pso_pointer cons(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer result = allocate(frame_pointer, CONSTAG, 2);
struct pso_pointer cons( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = allocate( frame_pointer, CONSTAG, 2 );
struct pso2 *object = pointer_to_object(result);
object->payload.cons.car = inc_ref(fetch_arg(frame, 0));
object->payload.cons.cdr = inc_ref(fetch_arg(frame, 1));
struct pso2 *object = pointer_to_object( result );
object->payload.cons.car = inc_ref( fetch_arg( frame, 0 ) );
object->payload.cons.cdr = inc_ref( fetch_arg( frame, 1 ) );
return result;
return result;
}
struct pso_pointer make_cons(struct pso_pointer frame_pointer, struct pso_pointer car, struct pso_pointer cdr){
return cons( make_frame(2, frame_pointer, car, cdr));
struct pso_pointer make_cons( struct pso_pointer frame_pointer,
struct pso_pointer car,
struct pso_pointer cdr ) {
return cons( make_frame( 2, frame_pointer, car, cdr ) );
}
/**
@ -55,26 +57,32 @@ struct pso_pointer make_cons(struct pso_pointer frame_pointer, struct pso_pointe
* @return the car of the indicated cell.
* @exception if the pointer does not indicate a cons cell.
*/
struct pso_pointer car(struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer cons = fetch_arg(frame, 0);
struct pso2 *object = pointer_to_object(cons);
struct pso_pointer car( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer cons = fetch_arg( frame, 0 );
struct pso2 *object = pointer_to_object( cons );
if (consp(cons)) {
result = object->payload.cons.car;
} else {
result = make_exception(make_frame(
2, frame_pointer,
c_string_to_lisp_string(frame_pointer, L"Invalid type for car"),
make_cons(frame_pointer, make_cons(
frame_pointer,
c_string_to_lisp_keyword(frame_pointer, L"type"),
get_tag_string(cons)),
nil)));
}
if ( consp( cons ) ) {
result = object->payload.cons.car;
} else {
result = make_exception( make_frame( 2, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Invalid type for car" ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_keyword
( frame_pointer,
L"type" ),
get_tag_string
( frame_pointer,
cons ) ),
nil ) ) );
}
return result;
return result;
}
/**
@ -86,36 +94,40 @@ struct pso_pointer car(struct pso_pointer frame_pointer) {
* @return the cdr of the indicated cell.
* @exception if the pointer does not indicate a cons cell.
*/
struct pso_pointer cdr(struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer cons = fetch_arg(frame, 0);
struct pso2 *object = pointer_to_object(cons);
struct pso_pointer cdr( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer cons = fetch_arg( frame, 0 );
struct pso2 *object = pointer_to_object( cons );
switch (get_tag_value(cons)) {
case CONSTV:
result = object->payload.cons.cdr;
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
result = object->payload.string.cdr;
break;
default:
struct pso_pointer type_binding =
make_cons(frame_pointer,
c_string_to_lisp_keyword(frame_pointer, L"type"),
get_tag_string(cons));
result = make_exception(make_frame(
2, frame_pointer,
c_string_to_lisp_string(frame_pointer, L"Invalid type for cdr"),
make_cons(frame_pointer,
type_binding,
nil)));
break;
}
switch ( get_tag_value( cons ) ) {
case CONSTV:
result = object->payload.cons.cdr;
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
result = object->payload.string.cdr;
break;
default:
result = make_exception( make_frame( 2, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Invalid type for cdr" ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_keyword
( frame_pointer,
L"type" ),
get_tag_string
( frame_pointer,
cons ) ),
nil ) ) );
break;
}
return result;
return result;
}
/**
@ -125,15 +137,15 @@ struct pso_pointer cdr(struct pso_pointer frame_pointer) {
* Lisp calling conventions; one expected arg, the pointer to the cell to
* be destroyed.
*/
struct pso_pointer destroy_cons(struct pso_pointer fp) {
if (stackp(fp)) {
struct pso4 *frame = pointer_to_pso4(fp);
struct pso_pointer p = frame->payload.stack_frame.arg[0];
struct pso_pointer destroy_cons( struct pso_pointer fp ) {
if ( stackp( fp ) ) {
struct pso4 *frame = pointer_to_pso4( fp );
struct pso_pointer p = frame->payload.stack_frame.arg[0];
if (check_tag(p, CONSTV)) {
struct pso2 *cons = pointer_to_object(p);
dec_ref(cons->payload.cons.car);
dec_ref(cons->payload.cons.cdr);
}
}
if ( check_tag( p, CONSTV ) ) {
struct pso2 *cons = pointer_to_object( p );
dec_ref( cons->payload.cons.car );
dec_ref( cons->payload.cons.cdr );
}
}
}

7
src/c/payloads/cons.h
View file

@ -33,11 +33,10 @@ struct pso_pointer cdr( struct pso_pointer frame_pointer );
struct pso_pointer cons( struct pso_pointer frame_pointer );
struct pso_pointer destroy_cons( struct pso_pointer frame_pointer);
struct pso_pointer destroy_cons( struct pso_pointer frame_pointer );
struct pso_pointer make_cons(struct pso_pointer frame_pointer,
struct pso_pointer car,
struct pso_pointer cdr);
struct pso_pointer make_cons( struct pso_pointer frame_pointer,
struct pso_pointer car, struct pso_pointer cdr );
/**
* macro short-cuts for make_cons.

21
src/c/payloads/exception.c
View file

@ -47,21 +47,21 @@ b * @param meta metadata for this exception. Must be an assoc list, hashtable,
* or `nil`
* @param cause the exception that caused this exception to be `thrown`.
*/
struct pso_pointer make_exception( struct pso_pointer frame_pointer) {
struct pso4* frame = pointer_to_pso4( frame_pointer);
struct pso_pointer message = fetch_arg(frame, 0);
struct pso_pointer previous = frame->payload.stack_frame.previous;
struct pso_pointer meta = fetch_arg( frame, 1);
struct pso_pointer cause = fetch_arg( frame, 2);
struct pso_pointer make_exception( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer message = fetch_arg( frame, 0 );
struct pso_pointer previous = frame->payload.stack_frame.previous;
struct pso_pointer meta = fetch_arg( frame, 1 );
struct pso_pointer cause = fetch_arg( frame, 2 );
struct pso_pointer result =
allocate( frame_pointer, EXCEPTIONTAG, 3 );
struct pso_pointer result = allocate( frame_pointer, EXCEPTIONTAG, 3 );
if ( !c_nilp( result ) && !exceptionp( result ) ) {
struct pso3 *object = ( struct pso3 * ) pointer_to_object( result );
object->payload.exception.message = message;
object->payload.exception.stack = stackp( frame_pointer ) ? frame_pointer : nil;
object->payload.exception.stack =
stackp( frame_pointer ) ? frame_pointer : nil;
object->payload.exception.meta = ( consp( meta )
|| hashtabp( meta ) ) ? meta : nil;
object->payload.exception.cause = exceptionp( cause ) ? cause : nil;
@ -76,8 +76,7 @@ struct pso_pointer make_exception( struct pso_pointer frame_pointer) {
* Lisp calling conventions; one expected arg, the pointer to the object to
* be destroyed.
*/
struct pso_pointer destroy_exception( struct pso_pointer fp,
struct pso_pointer env ) {
struct pso_pointer destroy_exception( struct pso_pointer fp ) {
if ( stackp( fp ) ) {
struct pso4 *frame = pointer_to_pso4( fp );
struct pso_pointer p = frame->payload.stack_frame.arg[0];

3
src/c/payloads/exception.h
View file

@ -28,7 +28,6 @@ struct exception_payload {
struct pso_pointer make_exception( struct pso_pointer frame_pointer );
struct pso_pointer destroy_exception( struct pso_pointer fp,
struct pso_pointer env );
struct pso_pointer destroy_exception( struct pso_pointer fp );
#endif

3
src/c/payloads/integer.c
View file

@ -25,7 +25,8 @@
* @param more `nil`, or a pointer to the more significant cell(s) of this number.
* *NOTE* that if `more` is not `nil`, `value` *must not* exceed `MAX_INTEGER`.
*/
struct pso_pointer make_integer( struct pso_pointer frame_pointer, int64_t value ) {
struct pso_pointer make_integer( struct pso_pointer frame_pointer,
int64_t value ) {
struct pso_pointer result = nil;
debug_print( L"Entering make_integer\n", DEBUG_ALLOC, 0 );

3
src/c/payloads/integer.h
View file

@ -25,6 +25,7 @@ struct integer_payload {
__int128_t value;
};
struct pso_pointer make_integer( struct pso_pointer frame_pointer, int64_t value );
struct pso_pointer make_integer( struct pso_pointer frame_pointer,
int64_t value );
#endif

14
src/c/payloads/psse_string.c
View file

@ -22,6 +22,8 @@
#include "payloads/cons.h"
#include "ops/stack_ops.h"
/**
* @brief When an string is freed, its cdr pointer must be decremented.
@ -29,14 +31,10 @@
* Lisp calling conventions; one expected arg, the pointer to the object to
* be destroyed.
*/
struct pso_pointer destroy_string( struct pso_pointer fp,
struct pso_pointer env ) {
if ( stackp( fp ) ) {
struct pso4 *frame = pointer_to_pso4( fp );
struct pso_pointer p = frame->payload.stack_frame.arg[0];
dec_ref( c_cdr( p ) );
}
struct pso_pointer destroy_string( struct pso_pointer frame_pointer ) {
if ( stackp( frame_pointer ) ) {
dec_ref( c_cdr( fetch_arg( pointer_to_pso4( frame_pointer ), 0 ) ) );
}
return nil;
}

3
src/c/payloads/psse_string.h
View file

@ -33,7 +33,6 @@ struct string_payload {
struct pso_pointer cdr;
};
struct pso_pointer destroy_string( struct pso_pointer fp,
struct pso_pointer env );
struct pso_pointer destroy_string( struct pso_pointer fp );
#endif

77
src/c/payloads/stack.c
View file

@ -43,9 +43,8 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
va_start( args, previous );
struct pso4 *prev_frame = pointer_to_pso4( previous );
struct pso_pointer new_pointer =
allocate( previous, STACKTAG, 4 );
struct pso4* new_frame = pointer_to_pso4(new_pointer);
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
@ -57,14 +56,16 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
prev_frame->payload.stack_frame.previous = previous;
if ( stackp( previous ) ) {
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env = prev_frame->payload.stack_frame.env;
new_frame->payload.stack_frame.depth =
prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env =
prev_frame->payload.stack_frame.env;
} else {
new_frame->payload.stack_frame.depth = 0;
new_frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
new_frame->payload.stack_frame.depth );
new_frame->payload.stack_frame.depth );
int cursor = 0;
new_frame->payload.stack_frame.args = arg_count;
@ -86,7 +87,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
new_frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
new_frame->payload.stack_frame.arg[cursor] = nil;
new_frame->payload.stack_frame.arg[cursor] = nil;
}
}
@ -117,9 +118,8 @@ struct pso_pointer make_frame_with_env( int arg_count,
va_start( args, env );
struct pso4 *prev_frame = pointer_to_pso4( previous );
struct pso_pointer new_pointer =
allocate( previous, STACKTAG, 4 );
struct pso4* new_frame = pointer_to_pso4(new_pointer);
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
@ -131,14 +131,15 @@ struct pso_pointer make_frame_with_env( int arg_count,
prev_frame->payload.stack_frame.previous = previous;
if ( stackp( previous ) ) {
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.depth =
prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env = env;
} else {
new_frame->payload.stack_frame.depth = 0;
new_frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
new_frame->payload.stack_frame.depth );
new_frame->payload.stack_frame.depth );
int cursor = 0;
new_frame->payload.stack_frame.args = arg_count;
@ -160,7 +161,7 @@ struct pso_pointer make_frame_with_env( int arg_count,
new_frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
new_frame->payload.stack_frame.arg[cursor] = nil;
new_frame->payload.stack_frame.arg[cursor] = nil;
}
}
@ -181,14 +182,19 @@ struct pso_pointer make_frame_with_env( int arg_count,
*
* @return pointer to the new frame.
*/
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous, struct pso_pointer argvalues,
struct pso_pointer env) {
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
previous,
struct pso_pointer
argvalues,
struct pso_pointer env ) {
struct pso4 *prev_frame = pointer_to_pso4( previous );
struct pso_pointer new_pointer =
allocate( previous, STACKTAG, 4 );
struct pso4* new_frame = pointer_to_pso4(new_pointer);
struct pso_pointer arg_length = length(make_frame(1, previous, argvalues));
int arg_count = integerp(arg_length) ? pointer_to_object(arg_length)->payload.integer.value : 0;
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
struct pso_pointer arg_length =
length( make_frame( 1, previous, argvalues ) );
int arg_count =
integerp( arg_length ) ? pointer_to_object( arg_length )->
payload.integer.value : 0;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
L"\nAllocating stack frame with %d arguments at page %d, "
@ -199,28 +205,31 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous,
prev_frame->payload.stack_frame.previous = previous;
if ( stackp( previous ) ) {
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env = inc_ref( prev_frame->payload.stack_frame.env);
new_frame->payload.stack_frame.depth =
prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env =
inc_ref( prev_frame->payload.stack_frame.env );
} else {
new_frame->payload.stack_frame.depth = 0;
new_frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
new_frame->payload.stack_frame.depth );
new_frame->payload.stack_frame.depth );
int cursor = 0;
new_frame->payload.stack_frame.args = arg_count;
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
new_frame->payload.stack_frame.arg[cursor] = inc_ref( make_frame( 1, previous, car(argvalues)));
argvalues = cdr( make_frame( 1, previous, argvalues));
new_frame->payload.stack_frame.arg[cursor] =
inc_ref( make_frame( 1, previous, car( argvalues ) ) );
argvalues = cdr( make_frame( 1, previous, argvalues ) );
}
if ( cursor < arg_count ) {
new_frame->payload.stack_frame.more = inc_ref( argvalues);
new_frame->payload.stack_frame.more = inc_ref( argvalues );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
new_frame->payload.stack_frame.arg[cursor] = nil;
new_frame->payload.stack_frame.arg[cursor] = nil;
}
}
@ -239,8 +248,12 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous,
*
* @return pointer to the new frame.
*/
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous, struct pso_pointer argvalues) {
return make_frame_with_arglist_and_env( previous, argvalues, pointer_to_pso4(previous)->payload.stack_frame.env);
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
struct pso_pointer argvalues ) {
return make_frame_with_arglist_and_env( previous, argvalues,
pointer_to_pso4
( previous )->payload.stack_frame.
env );
}

18
src/c/payloads/stack.h
View file

@ -43,17 +43,19 @@ struct stack_frame_payload {
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
... );
struct pso_pointer make_frame_with_env( int arg_count,
struct pso_pointer previous,
struct pso_pointer env, ... );
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous,
struct pso_pointer argvalues,
struct pso_pointer env);
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
struct pso_pointer argvalues);
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
previous,
struct pso_pointer
argvalues,
struct pso_pointer env );
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
struct pso_pointer argvalues );
struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env );