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

Reformatted code; made paths in generated documentation relative.

Browse source
This commit is contained in:
Simon Brooke 2026-02-14 15:32:59 +00:00
parent 222368bf64
commit 08a7c4153c
24 changed files with 496 additions and 716 deletions
Download patch file Download diff file Expand all files Collapse all files

159
src/init.c
View file

@ -45,19 +45,20 @@
* @param location_descriptor a description of where the pointer was caught.
* @return struct cons_pointer
*/
struct cons_pointer check_exception( struct cons_pointer pointer, char * location_descriptor) {
struct cons_pointer check_exception( struct cons_pointer pointer,
char *location_descriptor ) {
struct cons_pointer result = NIL;
struct cons_space_object * object = &pointer2cell( pointer);
struct cons_space_object *object = &pointer2cell( pointer );
if ( exceptionp( pointer)) {
fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor);
if ( exceptionp( pointer ) ) {
fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 );
print( ustderr, object->payload.exception.payload );
free( ustderr );
dec_ref( pointer);
dec_ref( pointer );
} else {
result = pointer;
}
@ -68,21 +69,21 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
struct cons_pointer init_name_symbol = NIL;
struct cons_pointer init_primitive_symbol = NIL;
void maybe_bind_init_symbols() {
if ( nilp( init_name_symbol)) {
void maybe_bind_init_symbols( ) {
if ( nilp( init_name_symbol ) ) {
init_name_symbol = c_string_to_lisp_keyword( L"name" );
}
if ( nilp( init_primitive_symbol)) {
if ( nilp( init_primitive_symbol ) ) {
init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
}
if ( nilp( privileged_symbol_nil)) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"nil");
if ( nilp( privileged_symbol_nil ) ) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
}
}
void free_init_symbols() {
dec_ref( init_name_symbol);
dec_ref( init_primitive_symbol);
void free_init_symbols( ) {
dec_ref( init_name_symbol );
dec_ref( init_primitive_symbol );
}
/**
@ -92,20 +93,22 @@ void free_init_symbols() {
* the name on the source pointer. Would make stack frames potentially
* more readable and aid debugging generally.
*/
struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer bind_function( wchar_t *name,
struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer,
struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n ),
NIL ) );
struct cons_pointer r = check_exception(
deep_bind( n, make_function( meta, executable ) ),
"bind_function");
dec_ref( n);
struct cons_pointer r =
check_exception( deep_bind( n, make_function( meta, executable ) ),
"bind_function" );
dec_ref( n );
return r;
}
@ -114,20 +117,21 @@ struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executa
* Bind this compiled `executable` function, as a Lisp special form, to
* this `name` in the `oblist`.
*/
struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer bind_special( wchar_t *name,
struct cons_pointer ( *executable )
( struct stack_frame *, struct cons_pointer,
struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n), NIL ) );
make_cons( make_cons( init_name_symbol, n ), NIL ) );
struct cons_pointer r =
check_exception(deep_bind( n, make_special( meta, executable ) ),
"bind_special");
dec_ref( n);
struct cons_pointer r =
check_exception( deep_bind( n, make_special( meta, executable ) ),
"bind_special" );
dec_ref( n );
return r;
}
@ -135,14 +139,14 @@ struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executab
/**
* Bind this `value` to this `symbol` in the `oblist`.
*/
struct cons_pointer
bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool lock) {
struct cons_pointer r = check_exception(
deep_bind( symbol, value ),
"bind_symbol_value");
struct cons_pointer
bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value,
bool lock ) {
struct cons_pointer r = check_exception( deep_bind( symbol, value ),
"bind_symbol_value" );
if ( lock && !exceptionp( r)){
struct cons_space_object * cell = & pointer2cell( r);
if ( lock && !exceptionp( r ) ) {
struct cons_space_object *cell = &pointer2cell( r );
cell->count = UINT32_MAX;
}
@ -153,12 +157,13 @@ bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool l
/**
* Bind this `value` to this `name` in the `oblist`.
*/
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value, bool lock ) {
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value,
bool lock ) {
struct cons_pointer p = c_string_to_lisp_symbol( name );
struct cons_pointer r = bind_symbol_value( p, value, lock);
struct cons_pointer r = bind_symbol_value( p, value, lock );
dec_ref( p);
dec_ref( p );
return r;
}
@ -173,7 +178,7 @@ void print_banner( ) {
*
* @stream the stream to print to.
*/
void print_options( FILE * stream ) {
void print_options( FILE *stream ) {
fwprintf( stream, L"Expected options are:\n" );
fwprintf( stream,
L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
@ -201,7 +206,7 @@ int main( int argc, char *argv[] ) {
int option;
bool dump_at_end = false;
bool show_prompt = false;
char * infilename = NULL;
char *infilename = NULL;
setlocale( LC_ALL, "" );
if ( io_init( ) != 0 ) {
@ -219,7 +224,7 @@ int main( int argc, char *argv[] ) {
print_options( stdout );
exit( 0 );
break;
case 'i' :
case 'i':
infilename = optarg;
break;
case 'p':
@ -236,9 +241,9 @@ int main( int argc, char *argv[] ) {
}
}
initialise_cons_pages();
initialise_cons_pages( );
maybe_bind_init_symbols();
maybe_bind_init_symbols( );
if ( show_prompt ) {
@ -254,7 +259,7 @@ int main( int argc, char *argv[] ) {
/*
* privileged variables (keywords)
*/
bind_symbol_value( privileged_symbol_nil, NIL, true);
bind_symbol_value( privileged_symbol_nil, NIL, true );
bind_value( L"t", TRUE, true );
/*
@ -267,43 +272,49 @@ int main( int argc, char *argv[] ) {
fwide( stderr, 1 );
fwide( sink->handle.file, 1 );
FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r");
FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r" );
lisp_io_in = bind_value( C_IO_IN, make_read_stream( file_to_url_file(infile),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard input" ) ),
NIL ) ), false );
lisp_io_out = bind_value( C_IO_OUT,
make_write_stream( file_to_url_file( stdout ),
lisp_io_in =
bind_value( C_IO_IN,
make_read_stream( file_to_url_file( infile ),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard input" ) ),
NIL ) ), false );
lisp_io_out =
bind_value( C_IO_OUT,
make_write_stream( file_to_url_file( stdout ),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard output]" ) ),
NIL ) ), false );
bind_value( L"*log*",
make_write_stream( file_to_url_file( stderr ),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard output]" ) ),
NIL ) ), false);
bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard log" ) ),
NIL ) ), false );
bind_value( L"*sink*", make_write_stream( sink,
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard sink" ) ),
NIL ) ), false );
( L"system:standard log" ) ),
NIL ) ), false );
bind_value( L"*sink*",
make_write_stream( sink,
make_cons( make_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard sink" ) ),
NIL ) ), false );
/*
* the default prompt
*/
prompt_name = bind_value( L"*prompt*",
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
show_prompt ? c_string_to_lisp_symbol( L":: " ) :
NIL, false );
/*
* primitive function operations
*/
@ -377,7 +388,7 @@ int main( int argc, char *argv[] ) {
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
free_init_symbols();
free_init_symbols( );
summarise_allocation( );
curl_global_cleanup( );