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

Very close to a basic REPL now.

Browse source
This commit is contained in:
Simon Brooke 2026-04-16 22:28:35 +01:00
parent 83537391a6
commit 4efe9eab87
23 changed files with 188 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

2
archive/c/init.c
View file

@ -56,7 +56,7 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor ); fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
URL_FILE *ustderr = file_to_url_file( stderr ); URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 ); fwide( stderr, 1 );
print( ustderr, object->payload.exception.payload ); c_print( ustderr, object->payload.exception.payload );
free( ustderr ); free( ustderr );
dec_ref( pointer ); dec_ref( pointer );

28
archive/c/io/print.c
View file

@ -72,7 +72,7 @@ print_list_contents( URL_FILE *output, struct cons_pointer pointer,
if ( initial_space ) { if ( initial_space ) {
url_fputwc( btowc( ' ' ), output ); url_fputwc( btowc( ' ' ), output );
} }
print( output, cell->payload.cons.car ); c_print( output, cell->payload.cons.car );
print_list_contents( output, cell->payload.cons.cdr, true ); print_list_contents( output, cell->payload.cons.cdr, true );
break; break;
@ -80,7 +80,7 @@ print_list_contents( URL_FILE *output, struct cons_pointer pointer,
break; break;
default: default:
url_fwprintf( output, L" . " ); url_fwprintf( output, L" . " );
print( output, pointer ); c_print( output, pointer );
} }
} }
@ -99,9 +99,9 @@ void print_map( URL_FILE *output, struct cons_pointer map ) {
for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks );
ks = c_cdr( ks ) ) { ks = c_cdr( ks ) ) {
struct cons_pointer key = c_car( ks ); struct cons_pointer key = c_car( ks );
print( output, key ); c_print( output, key );
url_fputwc( btowc( ' ' ), output ); url_fputwc( btowc( ' ' ), output );
print( output, hashmap_get( map, key, false ) ); c_print( output, hashmap_get( map, key, false ) );
if ( !nilp( c_cdr( ks ) ) ) { if ( !nilp( c_cdr( ks ) ) ) {
url_fputws( L", ", output ); url_fputws( L", ", output );
@ -153,7 +153,7 @@ void print_128bit( URL_FILE *output, __int128_t n ) {
* Print the cons-space object indicated by `pointer` to the stream indicated * Print the cons-space object indicated by `pointer` to the stream indicated
* by `output`. * by `output`.
*/ */
struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { struct cons_pointer c_print( URL_FILE *output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer ); struct cons_space_object cell = pointer2cell( pointer );
char *buffer; char *buffer;
@ -171,7 +171,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case FUNCTIONTV: case FUNCTIONTV:
url_fputws( L"<Function: ", output ); url_fputws( L"<Function: ", output );
print( output, cell.payload.function.meta ); c_print( output, cell.payload.function.meta );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; break;
case INTEGERTV: case INTEGERTV:
@ -190,7 +190,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) ); cell.payload.lambda.body ) );
print( output, to_print ); c_print( output, to_print );
dec_ref( to_print ); dec_ref( to_print );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
@ -206,20 +206,20 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) ); cell.payload.lambda.body ) );
print( output, to_print ); c_print( output, to_print );
dec_ref( to_print ); dec_ref( to_print );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
} }
break; break;
case RATIOTV: case RATIOTV:
print( output, cell.payload.ratio.dividend ); c_print( output, cell.payload.ratio.dividend );
url_fputws( L"/", output ); url_fputws( L"/", output );
print( output, cell.payload.ratio.divisor ); c_print( output, cell.payload.ratio.divisor );
break; break;
case READTV: case READTV:
url_fwprintf( output, L"<Input stream: " ); url_fwprintf( output, L"<Input stream: " );
print( output, cell.payload.stream.meta ); c_print( output, cell.payload.stream.meta );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; break;
case REALTV: case REALTV:
@ -246,7 +246,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case SPECIALTV: case SPECIALTV:
url_fwprintf( output, L"<Special form: " ); url_fwprintf( output, L"<Special form: " );
print( output, cell.payload.special.meta ); c_print( output, cell.payload.special.meta );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; break;
case TIMETV: case TIMETV:
@ -264,7 +264,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case WRITETV: case WRITETV:
url_fwprintf( output, L"<Output stream: " ); url_fwprintf( output, L"<Output stream: " );
print( output, cell.payload.stream.meta ); c_print( output, cell.payload.stream.meta );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; break;
default: default:
@ -312,7 +312,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
debug_print( L"lisp_print: about to print\n", DEBUG_IO ); debug_print( L"lisp_print: about to print\n", DEBUG_IO );
debug_dump_object( frame->arg[0], DEBUG_IO ); debug_dump_object( frame->arg[0], DEBUG_IO );
result = print( output, frame->arg[0] ); result = c_print( output, frame->arg[0] );
debug_print( L"lisp_print returning\n", DEBUG_IO ); debug_print( L"lisp_print returning\n", DEBUG_IO );
debug_dump_object( result, DEBUG_IO ); debug_dump_object( result, DEBUG_IO );

2
archive/c/io/print.h
View file

@ -16,7 +16,7 @@
#ifndef __print_h #ifndef __print_h
#define __print_h #define __print_h
struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ); struct cons_pointer c_print( URL_FILE * output, struct cons_pointer pointer );
void println( URL_FILE * output ); void println( URL_FILE * output );
struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer lisp_print( struct stack_frame *frame,

16
archive/c/memory/dump.c
View file

@ -48,7 +48,7 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count ); cell.payload.string.cdr.offset, cell.count );
url_fwprintf( output, L"\t\t value: " ); url_fwprintf( output, L"\t\t value: " );
print( output, pointer ); c_print( output, pointer );
url_fwprintf( output, L"\n" ); url_fwprintf( output, L"\n" );
} }
} }
@ -71,7 +71,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
cell.payload.cons.car.offset, cell.payload.cons.car.offset,
cell.payload.cons.cdr.page, cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset, cell.count ); cell.payload.cons.cdr.offset, cell.count );
print( output, pointer ); c_print( output, pointer );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case EXCEPTIONTV: case EXCEPTIONTV:
@ -97,18 +97,18 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case LAMBDATV: case LAMBDATV:
url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " );
print( output, cell.payload.lambda.args ); c_print( output, cell.payload.lambda.args );
url_fwprintf( output, L";\n\t\t\tbody: " ); url_fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body ); c_print( output, cell.payload.lambda.body );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case NILTV: case NILTV:
break; break;
case NLAMBDATV: case NLAMBDATV:
url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " );
print( output, cell.payload.lambda.args ); c_print( output, cell.payload.lambda.args );
url_fwprintf( output, L";\n\t\t\tbody: " ); url_fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body ); c_print( output, cell.payload.lambda.body );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case RATIOTV: case RATIOTV:
@ -121,7 +121,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );
print( output, cell.payload.stream.meta ); c_print( output, cell.payload.stream.meta );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case REALTV: case REALTV:
@ -159,7 +159,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
break; break;
case WRITETV: case WRITETV:
url_fputws( L"\t\tOutput stream; metadata: ", output ); url_fputws( L"\t\tOutput stream; metadata: ", output );
print( output, cell.payload.stream.meta ); c_print( output, cell.payload.stream.meta );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
} }

6
archive/c/memory/hashmap.c
View file

@ -140,13 +140,13 @@ void dump_map( URL_FILE *output, struct cons_pointer pointer ) {
&pointer_to_vso( pointer )->payload.hashmap; &pointer_to_vso( pointer )->payload.hashmap;
url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets ); url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets );
url_fwprintf( output, L"\tHash function: " ); url_fwprintf( output, L"\tHash function: " );
print( output, payload->hash_fn ); c_print( output, payload->hash_fn );
url_fwprintf( output, L"\n\tWrite ACL: " ); url_fwprintf( output, L"\n\tWrite ACL: " );
print( output, payload->write_acl ); c_print( output, payload->write_acl );
url_fwprintf( output, L"\n\tBuckets:" ); url_fwprintf( output, L"\n\tBuckets:" );
for ( int i = 0; i < payload->n_buckets; i++ ) { for ( int i = 0; i < payload->n_buckets; i++ ) {
url_fwprintf( output, L"\n\t\t[%d]: ", i ); url_fwprintf( output, L"\n\t\t[%d]: ", i );
print( output, payload->buckets[i] ); c_print( output, payload->buckets[i] );
} }
url_fwprintf( output, L"\n" ); url_fwprintf( output, L"\n" );
} }

8
archive/c/memory/stack.c
View file

@ -291,7 +291,7 @@ void dump_frame_context_fragment( URL_FILE *output,
if ( frame != NULL ) { if ( frame != NULL ) {
url_fwprintf( output, L" <= " ); url_fwprintf( output, L" <= " );
print( output, frame->arg[0] ); c_print( output, frame->arg[0] );
} }
} }
@ -332,12 +332,12 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ", url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ",
arg, cell.tag.bytes, cell.count ); arg, cell.tag.bytes, cell.count );
print( output, frame->arg[arg] ); c_print( output, frame->arg[arg] );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
} }
if ( !nilp( frame->more ) ) { if ( !nilp( frame->more ) ) {
url_fputws( L"More: \t", output ); url_fputws( L"More: \t", output );
print( output, frame->more ); c_print( output, frame->more );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
} }
} }
@ -345,7 +345,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
void dump_stack_trace( URL_FILE *output, struct cons_pointer pointer ) { void dump_stack_trace( URL_FILE *output, struct cons_pointer pointer ) {
if ( exceptionp( pointer ) ) { if ( exceptionp( pointer ) ) {
print( output, pointer2cell( pointer ).payload.exception.payload ); c_print( output, pointer2cell( pointer ).payload.exception.payload );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
dump_stack_trace( output, dump_stack_trace( output,
pointer2cell( pointer ).payload.exception.frame ); pointer2cell( pointer ).payload.exception.frame );

4
archive/c/ops/lispops.c
View file

@ -1526,7 +1526,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer prompt = c_assoc( prompt_name, new_env ); struct cons_pointer prompt = c_assoc( prompt_name, new_env );
if ( !nilp( prompt ) ) { if ( !nilp( prompt ) ) {
print( os, prompt ); c_print( os, prompt );
} }
expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer, expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
@ -1541,7 +1541,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
println( os ); println( os );
print( os, eval_form( frame, frame_pointer, expr, new_env ) ); c_print( os, eval_form( frame, frame_pointer, expr, new_env ) );
dec_ref( expr ); dec_ref( expr );
} }

67
src/c/debug.c
View file

@ -11,9 +11,14 @@
*/ */
#include <stdarg.h> #include <stdarg.h>
#include <stdlib.h>
#include "debug.h" #include "debug.h"
#include "io/fopen.h"
#include "io/io.h"
#include "io/print.h"
int verbosity = 0; int verbosity = 0;
@ -45,14 +50,6 @@ void debug_print( wchar_t *message, int level, int indent ) {
#endif #endif
} }
void debug_print_object( struct pso_pointer object, int level, int indent ) {
// TODO: not yet implemented
}
void debug_dump_object( struct pso_pointer object, int level, int indent ) {
// TODO: not yet implemented
}
/** /**
* @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`. * @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`.
* *
@ -133,5 +130,55 @@ void debug_printf( int level, int indent, wchar_t *format, ... ) {
#endif #endif
} }
// debug_dump_object, debug_print_binding, debug_print_exception, debug_print_object,
// not yet implemented but probably will be. /**
* @brief print the object indicated by this `pointer` to stderr, if `verbosity`
* matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/
void debug_print_object( struct pso_pointer pointer, int level, int indent ) {
#ifdef DEBUG
if ( level & verbosity ) {
URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 );
in_print( pointer, ustderr );
free( ustderr );
}
#endif
}
/**
* @brief Like `dump_object`, q.v., but protected by the verbosity mechanism.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/
void debug_dump_object( struct pso_pointer pointer, int level, int indent ) {
//#ifdef DEBUG
// if ( level & verbosity ) {
// URL_FILE *ustderr = file_to_url_file( stderr );
// fwide( stderr, 1 );
// dump_object( ustderr, pointer );
// free( ustderr );
// }
//#endif
}
///**
// * Standardise printing of binding trace messages.
// */
//void debug_print_binding( struct cons_pointer key, struct cons_pointer val,
// bool deep, int level, int indent ) {
//#ifdef DEBUG
// // wchar_t * depth = (deep ? L"Deep" : L"Shallow");
//
// debug_print( ( deep ? L"Deep" : L"Shallow" ), level, indent );
// debug_print( L" binding `", level, indent );
// debug_print_object( key, level, indent );
// debug_print( L"` to `", level, indent );
// debug_print_object( val, level, indent );
// debug_print( L"`\n", level, indent );
//#endif
//}

12
src/c/io/io.c
View file

@ -286,8 +286,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
if ( characterp( c ) && readp( r ) ) { if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t ) if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.character. ( pointer_to_object( c )->payload.
character ), character.character ),
pointer_to_object( r )->payload.stream.stream ) >= pointer_to_object( r )->payload.stream.stream ) >=
0 ) { 0 ) {
result = t; result = t;
@ -315,8 +315,8 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) { if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
if ( url_fclose if ( url_fclose
( pointer_to_object( fetch_arg( frame, 0 ) )->payload. ( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.
stream.stream ) stream )
== 0 ) { == 0 ) {
result = t; result = t;
} }
@ -569,8 +569,8 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
if ( readp( fetch_arg( frame, 0 ) ) ) { if ( readp( fetch_arg( frame, 0 ) ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer_to_object( fetch_arg( frame, 0 ) )->payload. ( pointer_to_object( fetch_arg( frame, 0 ) )->
stream.stream ), nil ); payload.stream.stream ), nil );
} }
return result; return result;

2
src/c/io/print.c
View file

@ -109,7 +109,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
* @param stream if a pointer to an open write stream, print to there. * @param stream if a pointer to an open write stream, print to there.
* @return struct pso_pointer `nil`, or an exception if some erroe occurred. * @return struct pso_pointer `nil`, or an exception if some erroe occurred.
*/ */
struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ) { struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
URL_FILE *output = writep( stream ) ? URL_FILE *output = writep( stream ) ?
pointer_to_object( stream )->payload.stream.stream : pointer_to_object( stream )->payload.stream.stream :
file_to_url_file( stdout ); file_to_url_file( stdout );

4
src/c/io/print.h
View file

@ -14,6 +14,8 @@
#ifndef __psse_io_print_h #ifndef __psse_io_print_h
#define __psse_io_print_h #define __psse_io_print_h
struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ); struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream );
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
#endif #endif

3
src/c/memory/memory.c
View file

@ -49,7 +49,8 @@ struct pso_pointer initialise_memory( uint32_t node ) {
if ( memory_initialised ) { if ( memory_initialised ) {
result = result =
make_exception( c_string_to_lisp_string make_exception( c_string_to_lisp_string
( L"Attenpt to reinitialise memory." ), nil, nil, nil ); ( L"Attenpt to reinitialise memory." ), nil, nil,
nil );
} else { } else {
for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) { for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) {
freelists[i] = nil; freelists[i] = nil;

5
src/c/memory/node.c
View file

@ -46,6 +46,11 @@ struct pso_pointer nil = ( struct pso_pointer ) { 0, 0, 0 };
*/ */
struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 }; struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 };
/**
* @brief The root of the data space.
*/
struct pso_pointer oblist = ( struct pso_pointer ) { 0, 0, 0 };
/** /**
* @brief Set up the basic informetion about this node. * @brief Set up the basic informetion about this node.

2
src/c/memory/node.h
View file

@ -31,6 +31,8 @@ extern struct pso_pointer nil;
*/ */
extern struct pso_pointer t; extern struct pso_pointer t;
extern struct pso_pointer oblist;
struct pso_pointer initialise_node( uint32_t index ); struct pso_pointer initialise_node( uint32_t index );
#endif #endif

6
src/c/memory/tags.c
View file

@ -31,12 +31,14 @@ uint32_t get_tag_value( struct pso_pointer p ) {
* *
* @param p must be a struct pso_pointer, indicating the appropriate object. * @param p must be a struct pso_pointer, indicating the appropriate object.
*/ */
struct pso_pointer get_tag_string( struct pso_pointer p) { struct pso_pointer get_tag_string( struct pso_pointer p ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso2 *object = pointer_to_object( p ); struct pso2 *object = pointer_to_object( p );
for ( int i = 2 - 1; i >= 0; i-- ) { for ( int i = 2 - 1; i >= 0; i-- ) {
result = make_string( (wchar_t)(object->header.tag.bytes.mnemonic[i]), result ); result =
make_string( ( wchar_t ) ( object->header.tag.bytes.mnemonic[i] ),
result );
} }
return result; return result;

2
src/c/memory/tags.h
View file

@ -84,7 +84,7 @@
// #define get_tag_value(p)((pointer_to_object(p)->header.tag.value) & 0xffffff) // #define get_tag_value(p)((pointer_to_object(p)->header.tag.value) & 0xffffff)
uint32_t get_tag_value( struct pso_pointer p ); uint32_t get_tag_value( struct pso_pointer p );
struct pso_pointer get_tag_string( struct pso_pointer p); struct pso_pointer get_tag_string( struct pso_pointer p );
/** /**
* @brief check that the tag of the object indicated by this poiner has this * @brief check that the tag of the object indicated by this poiner has this

10
src/c/ops/eval_apply.c
View file

@ -87,8 +87,10 @@ struct pso_pointer eval(
( c_string_to_lisp_string ( c_string_to_lisp_string
( L"Can't yet evaluate things of this type: " ), ( L"Can't yet evaluate things of this type: " ),
result ), frame_pointer, result ), frame_pointer,
c_cons( c_cons( c_string_to_lisp_keyword(L"tag"), c_cons( c_cons
get_tag_string(result)), nil), nil ); ( c_string_to_lisp_keyword( L"tag" ),
get_tag_string( result ) ), nil ),
nil );
} }
if ( exceptionp( result ) ) { if ( exceptionp( result ) ) {
@ -98,8 +100,8 @@ struct pso_pointer eval(
if ( nilp( x->payload.exception.stack ) ) { if ( nilp( x->payload.exception.stack ) ) {
result = result =
make_exception( x->payload.exception.message, frame_pointer, nil, make_exception( x->payload.exception.message, frame_pointer,
result ); nil, result );
} }
} }

4
src/c/ops/reverse.c
View file

@ -65,8 +65,8 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) {
default: default:
result = result =
make_exception( c_cons( c_string_to_lisp_string make_exception( c_cons( c_string_to_lisp_string
( L"Invalid object in sequence" ), cursor), nil, ( L"Invalid object in sequence" ),
nil , nil); cursor ), nil, nil, nil );
goto exit; goto exit;
break; break;
} }

2
src/c/ops/string_ops.c
View file

@ -182,5 +182,3 @@ struct pso_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
return result; return result;
} }

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

@ -82,11 +82,10 @@ struct pso_pointer c_cdr( struct pso_pointer p ) {
break; break;
default: default:
result = result =
make_exception( make_exception( c_cons
c_cons( ( c_string_to_lisp_string
c_string_to_lisp_string( L"Invalid type for cdr" ), ( L"Invalid type for cdr" ),
get_tag_string( p) ), get_tag_string( p ) ), nil, nil, nil );
nil, nil, nil );
break; break;
} }

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

@ -36,17 +36,18 @@
*/ */
struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer make_exception( struct pso_pointer message,
struct pso_pointer frame, struct pso_pointer frame,
struct pso_pointer meta, struct pso_pointer meta,
struct pso_pointer cause ) { struct pso_pointer cause ) {
struct pso_pointer result = allocate(EXCEPTIONTAG, 3); struct pso_pointer result = allocate( EXCEPTIONTAG, 3 );
if (!nilp(result) && !exceptionp(result)) { if ( !nilp( result ) && !exceptionp( result ) ) {
struct pso3* object = (struct pso3*)pointer_to_object( result); struct pso3 *object = ( struct pso3 * ) pointer_to_object( result );
object->payload.exception.message = message; object->payload.exception.message = message;
object->payload.exception.stack = stackp(frame) ? frame : nil; object->payload.exception.stack = stackp( frame ) ? frame : nil;
object->payload.exception.meta = (consp(meta) || hashtabp(meta)) ? meta : nil; object->payload.exception.meta = ( consp( meta )
object->payload.exception.cause = exceptionp(cause) ? cause : nil; || hashtabp( meta ) ) ? meta : nil;
object->payload.exception.cause = exceptionp( cause ) ? cause : nil;
} }
return result; return result;
@ -63,12 +64,12 @@ struct pso_pointer destroy_exception( struct pso_pointer fp,
if ( stackp( fp ) ) { if ( stackp( fp ) ) {
struct pso4 *frame = pointer_to_pso4( fp ); struct pso4 *frame = pointer_to_pso4( fp );
struct pso_pointer p = frame->payload.stack_frame.arg[0]; struct pso_pointer p = frame->payload.stack_frame.arg[0];
struct pso3* object = (struct pso3*)pointer_to_object( p); struct pso3 *object = ( struct pso3 * ) pointer_to_object( p );
dec_ref( object->payload.exception.message); dec_ref( object->payload.exception.message );
dec_ref( object->payload.exception.stack); dec_ref( object->payload.exception.stack );
dec_ref( object->payload.exception.meta); dec_ref( object->payload.exception.meta );
dec_ref( object->payload.exception.cause); dec_ref( object->payload.exception.cause );
} }
return nil; return nil;

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

@ -16,7 +16,7 @@
* @brief An exception; required three pointers, so use object of size class 3. * @brief An exception; required three pointers, so use object of size class 3.
*/ */
struct exception_payload { struct exception_payload {
/** @brief the exception message. Expected to be a string, but may be anything printable. */ /** @brief the exception message. Expected to be a string, but may be anything printable. */
struct pso_pointer message; struct pso_pointer message;
/** @brief the stack frame at which the exception was thrown. */ /** @brief the stack frame at which the exception was thrown. */
struct pso_pointer stack; struct pso_pointer stack;
@ -28,7 +28,7 @@ struct exception_payload {
struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer make_exception( struct pso_pointer message,
struct pso_pointer frame_pointer, struct pso_pointer frame_pointer,
struct pso_pointer meta, struct pso_pointer meta,
struct pso_pointer cause ); struct pso_pointer cause );
struct pso_pointer destroy_exception( struct pso_pointer fp, struct pso_pointer destroy_exception( struct pso_pointer fp,

47
src/c/psse.c
View file

@ -12,13 +12,24 @@
* Licensed under GPL version 2.0, or, at your option, any later version. * Licensed under GPL version 2.0, or, at your option, any later version.
*/ */
#include <stdbool.h>
#include <stdio.h>
#include <wchar.h>
#include <signal.h>
#include "debug.h"
#include "psse.h" #include "psse.h"
#include "io/io.h" #include "io/io.h"
#include "memory/node.h" #include "memory/node.h"
#include "memory/pso.h"
#include "memory/tags.h"
#include "ops/stack_ops.h" #include "ops/stack_ops.h"
#include "ops/truth.h" #include "ops/truth.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
void print_banner( ) { void print_banner( ) {
fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n", fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n",
VERSION ); VERSION );
@ -54,6 +65,35 @@ void print_options( FILE *stream ) {
#endif #endif
} }
/**
* @brief Handle an interrupt signal.
*
* @param dummy
*/
void int_handler( int dummy ) {
wprintf( L"TODO: handle ctrl-C in a more interesting way\n" );
}
/**
* The read/eval/print loop.
*/
void repl( ) {
signal( SIGINT, int_handler );
debug_print( L"Entered repl\n", DEBUG_REPL, 0 );
struct pso_pointer env = consp( oblist ) ? oblist : c_cons( oblist, nil );
/* bottom of stack */
struct pso_pointer frame_pointer = make_frame( 1, nil, nil, env );
if ( !nilp( frame_pointer ) ) {
// lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
dec_ref( frame_pointer );
}
debug_print( L"Leaving repl\n", DEBUG_REPL, 0 );
}
/** /**
* main entry point; parse command line arguments, initialise the environment, * main entry point; parse command line arguments, initialise the environment,
@ -101,7 +141,12 @@ int main( int argc, char *argv[] ) {
} }
} }
if ( nilp( initialise_node( 0 ) ) ) { oblist = initialise_node( 0 );
debug_print( L"Oblist: ", DEBUG_BOOTSTRAP, 0 );
debug_print_object( oblist, DEBUG_BOOTSTRAP, 0 );
debug_println( DEBUG_BOOTSTRAP );
if ( nilp( oblist ) ) {
fputs( "Failed to initialise node\n", stderr ); fputs( "Failed to initialise node\n", stderr );
exit( 1 ); exit( 1 );
} }