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

It compiles. It runs. Nothing works, but it also doesn't crash. Victory!

Browse source
This commit is contained in:
Simon Brooke 2026-04-23 11:50:30 +01:00
parent 8d2acbeb0f
commit aa0d60bbed
20 changed files with 390 additions and 244 deletions
Download patch file Download diff file Expand all files Collapse all files

338
src/c/io/io.c
View file

@ -106,6 +106,16 @@ struct pso_pointer lisp_stderr;
*/
struct pso_pointer lisp_io_prompt;
/**
* @brief bound to the Lisp symbol representing C_IO_READBASE in initialisation
*/
struct pso_pointer lisp_io_readbase;
/**
* @brief bound to the Lisp symbol representing C_IO_READTABLE in initialisation
*/
struct pso_pointer lisp_io_readtable;
/**
* Allow a one-character unget facility. This may not be enough - we may need
* to allocate a buffer.
@ -134,6 +144,10 @@ URL_FILE *file_to_url_file( FILE *f ) {
* @return 0 on success; any other value means failure.
*/
int initialise_io( ) {
fwide( stdin, 1 );
fwide( stdout, 1 );
fwide( stderr, 1 );
int result = curl_global_init( CURL_GLOBAL_SSL );
io_share = curl_share_init( );
@ -150,75 +164,100 @@ int initialise_io( ) {
return result;
}
struct pso_pointer initialise_default_streams( struct pso_pointer stack_frame,
struct pso_pointer initialise_default_streams( struct pso_pointer
frame_pointer,
struct pso_pointer env ) {
// todo: issue #21: should this have stack frame passed in?
// It's called in initialisation before everything else is set
// up, so **possibly** not?
lisp_io_in = c_string_to_lisp_symbol( stack_frame, C_IO_IN );
lisp_io_out = c_string_to_lisp_symbol( stack_frame, C_IO_OUT );
lisp_io_log = c_string_to_lisp_symbol( stack_frame, C_IO_LOG );
lisp_io_prompt = c_string_to_lisp_symbol( stack_frame, C_IO_PROMPT );
lisp_io_in = c_string_to_lisp_symbol( frame_pointer, C_IO_IN );
lisp_io_out = c_string_to_lisp_symbol( frame_pointer, C_IO_OUT );
lisp_io_log = c_string_to_lisp_symbol( frame_pointer, C_IO_LOG );
lisp_io_prompt = c_string_to_lisp_symbol( frame_pointer, C_IO_PROMPT );
lisp_io_readbase = c_string_to_lisp_symbol( frame_pointer, C_IO_READBASE );
lisp_io_readtable =
c_string_to_lisp_symbol( frame_pointer, C_IO_READTABLE );
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
0 );
debug_print_object( env, DEBUG_IO, 0 );
env =
lisp_bind( make_frame
( 3, stack_frame, lisp_io_prompt,
c_string_to_lisp_string( stack_frame, INITIAL_PROMPT ),
env ) );
lisp_bind( make_frame( 3, frame_pointer, lisp_io_prompt,
c_string_to_lisp_string( frame_pointer,
INITIAL_PROMPT ),
lisp_bind( make_frame
( 3, frame_pointer, lisp_io_readbase,
acquire_integer( frame_pointer,
10 ),
lisp_bind( make_frame
( 3, frame_pointer,
lisp_io_readtable,
nil, env ) ) ) ) ) );
lisp_stdin =
lock_object( make_read_stream
( stack_frame, file_to_url_file( stdin ),
make_cons( stack_frame,
make_cons( stack_frame,
( frame_pointer, file_to_url_file( stdin ),
make_cons( frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_keyword
( stack_frame, L"url" ),
( frame_pointer, L"url" ),
c_string_to_lisp_string
( stack_frame,
( frame_pointer,
L"::system:standard-input" ) ),
stack_frame ) ) );
frame_pointer ) ) );
env =
lisp_bind( make_frame( 3, stack_frame, lisp_io_in, lisp_stdin, env ) );
lisp_bind( make_frame
( 3, frame_pointer, lisp_io_in, lisp_stdin, env ) );
debug_print_object( env, DEBUG_IO, 0 );
if ( !c_nilp( env ) && !exceptionp( env ) ) {
lisp_stdout =
lock_object( make_write_stream( stack_frame,
lock_object( make_write_stream( frame_pointer,
file_to_url_file( stdout ),
make_cons( stack_frame,
make_cons( stack_frame,
c_string_to_lisp_keyword
( stack_frame,
L"url" ),
c_string_to_lisp_string
( stack_frame,
L"::system:standard-output" ) ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_keyword
( frame_pointer,
L"url" ),
c_string_to_lisp_string
( frame_pointer,
L"::system:standard-output" ) ),
nil ) ) );
env =
lisp_bind( make_frame
( 3, stack_frame, lisp_io_out, lisp_stdout, env ) );
( 3, frame_pointer, lisp_io_out, lisp_stdout, env ) );
}
if ( !c_nilp( env ) && !exceptionp( env ) ) {
lisp_stderr =
lock_object( make_write_stream
( stack_frame, file_to_url_file( stderr ),
make_cons( stack_frame,
make_cons( stack_frame,
( frame_pointer, file_to_url_file( stderr ),
make_cons( frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_keyword
( stack_frame, L"url" ),
( frame_pointer, L"url" ),
c_string_to_lisp_string
( stack_frame,
( frame_pointer,
L"::system:standard-output" ) ),
nil ) ) );
env =
lisp_bind( make_frame
( 3, frame_pointer, lisp_io_log, lisp_stderr, env ) );
}
// TODO: create the sink stream. Something like:
// URL_FILE *sink = url_fopen( "/dev/null", "w" );
// fwide( sink->handle.file, 1 );
// 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 );
debug_print( L"Leaving initialise_default_streams; environment is: ",
DEBUG_IO, 0 );
@ -226,40 +265,6 @@ struct pso_pointer initialise_default_streams( struct pso_pointer stack_frame,
return env;
}
/**
* Convert this lisp string-like-thing (also works for symbols, and, later
* keywords) into a UTF-8 string. NOTE that the returned value has been
* malloced and must be freed. TODO: candidate to moving into a utilities
* file.
*
* @param s the lisp string or symbol;
* @return the c string.
*/
char *lisp_string_to_c_string( struct pso_pointer s ) {
char *result = NULL;
if ( stringp( s ) || symbolp( s ) ) {
int len = 0;
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
len++;
}
char32_t *buffer = calloc( len + 1, sizeof( char32_t ) );
/* worst case, one wide char = four utf bytes */
result = calloc( ( len * 4 ) + 1, sizeof( char ) );
int i = 0;
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
buffer[i++] = pointer_to_object( c )->payload.string.character;
}
wcstombs( result, buffer, len );
free( buffer );
}
debug_print( L"lisp_string_to_c_string( ", DEBUG_IO, 0 );
debug_print_object( s, DEBUG_IO, 0 );
debug_printf( DEBUG_IO, 0, L") => '%s'\n", result );
return result;
}
/**
* get one wide character from the buffer.
@ -351,25 +356,6 @@ wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
return result;
}
/**
* @brief Read one character object from this `read_stream`.
*
* @param read_stream a pointer to an object which should be a read stream
* object,
*
* @return a pointer to a character object on success, or `nil` on failure.
*/
struct pso_pointer get_character( struct pso_pointer read_stream ) {
struct pso_pointer result = nil;
if ( readp( read_stream ) ) {
result =
make_character( url_fgetwc
( pointer_to_object_of_size_class
( read_stream, 2 )->payload.stream.stream ) );
}
return result;
}
/**
* @brief Push back this character `c` onto this read stream `r`.
@ -384,8 +370,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
struct pso_pointer result = nil;
if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.character.
character ),
( pointer_to_object( c )->payload.
character.character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t;
@ -412,8 +398,8 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
struct pso_pointer result = nil;
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
if ( url_fclose
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.
stream )
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream )
== 0 ) {
result = t;
}
@ -422,34 +408,43 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
return result;
}
struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key,
struct pso_pointer add_meta_integer( struct pso_pointer frame_pointer,
struct pso_pointer meta, char32_t *key,
long int value ) {
// todo: issue #21: must have stack frame passed in.
return
make_cons( make_cons
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta );
return make_cons( frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_keyword( frame_pointer,
key ),
make_integer( frame_pointer, value ) ),
meta );
}
struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key,
struct pso_pointer add_meta_string( struct pso_pointer frame_pointer,
struct pso_pointer meta, char32_t *key,
char *value ) {
// todo: issue #21: must have stack frame passed in.
value = trim( value );
char32_t buffer[strlen( value ) + 1];
mbstowcs( buffer, value, strlen( value ) + 1 );
return
make_cons( make_cons
( c_string_to_lisp_keyword( frame_pointer, key ),
c_string_to_lisp_string( buffer ) ), meta );
return make_cons( frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_keyword( frame_pointer,
key ),
c_string_to_lisp_string( frame_pointer,
buffer ) ), meta );
}
struct pso_pointer add_meta_time( struct pso_pointer meta, char32_t *key,
struct pso_pointer add_meta_time( struct pso_pointer frame_pointer,
struct pso_pointer meta, char32_t *key,
time_t *value ) {
// todo: issue #21: must have stack frame passed in.
char datestring[256];
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),
localtime( value ) );
return add_meta_string( meta, key, datestring );
return make_cons( frame_pointer,
make_cons( frame_pointer,
c_string_to_lisp_keyword( frame_pointer,
key ),
make_time( frame_pointer,
( value ==
NULL ) ? nil :
make_integer( frame_pointer,
*value ) ) ), meta );
}
/**
@ -505,11 +500,12 @@ static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
return 0; // strlen( string );
}
void collect_meta( struct pso_pointer stream, char *url ) {
void collect_meta( struct pso_pointer frame_pointer, struct pso_pointer stream,
char *url ) {
struct pso2 *cell = pointer_to_object( stream );
URL_FILE *s = pointer_to_object( stream )->payload.stream.stream;
struct pso_pointer meta =
add_meta_string( cell->payload.stream.meta, L"url",
add_meta_string( frame_pointer, cell->payload.stream.meta, L"url",
url );
struct stat statbuf;
int result = stat( url, &statbuf );
@ -521,21 +517,31 @@ void collect_meta( struct pso_pointer stream, char *url ) {
case CFTYPE_FILE:
if ( result == 0 ) {
if ( ( pwd = getpwuid( statbuf.st_uid ) ) != NULL ) {
meta = add_meta_string( meta, L"owner", pwd->pw_name );
meta =
add_meta_string( frame_pointer, meta, L"owner",
pwd->pw_name );
} else {
meta = add_meta_integer( meta, L"owner", statbuf.st_uid );
meta =
add_meta_integer( frame_pointer, meta, L"owner",
statbuf.st_uid );
}
if ( ( grp = getgrgid( statbuf.st_gid ) ) != NULL ) {
meta = add_meta_string( meta, L"group", grp->gr_name );
meta =
add_meta_string( frame_pointer, meta, L"group",
grp->gr_name );
} else {
meta = add_meta_integer( meta, L"group", statbuf.st_gid );
meta =
add_meta_integer( frame_pointer, meta, L"group",
statbuf.st_gid );
}
meta =
add_meta_integer( meta, L"size",
add_meta_integer( frame_pointer, meta, L"size",
( intmax_t ) statbuf.st_size );
meta = add_meta_time( meta, L"modified", &statbuf.st_mtime );
meta =
add_meta_time( frame_pointer, meta, L"modified",
&statbuf.st_mtime );
}
break;
case CFTYPE_CURL:
@ -595,75 +601,51 @@ struct pso_pointer lisp_open( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = nil;
// if ( stringp( fetch_arg( frame, 0) ) ) {
// char *url = lisp_string_to_c_string( fetch_arg( frame, 0) );
// if ( c_nilp( fetch_arg( frame, 1) ) ) {
// URL_FILE *stream = url_fopen( url, "r" );
// debug_printf( DEBUG_IO, 0,
// L"lisp_open: stream @ %ld, stream type = %d, stream
// handle = %ld\n", ( long int ) &stream, ( int )
// stream->type, ( long int ) stream->handle.file );
// switch ( stream->type ) {
// case CFTYPE_NONE:
// return
// make_exception( c_string_to_lisp_string
// ( L"Could not open stream" ),
// frame_pointer , nil );
// break;
// case CFTYPE_FILE:
// if ( stream->handle.file == NULL ) {
// return
// make_exception( c_string_to_lisp_string
// ( L"Could not open file" ),
// frame_pointer , nil);
// }
// break;
// case CFTYPE_CURL:
// /* can't tell whether a URL is bad without reading it */
// break;
// }
// result = make_read_stream( stream, nil );
// } else {
// // TODO: anything more complex is a problem for another day.
// URL_FILE *stream = url_fopen( url, "w" );
// result = make_write_stream( stream, nil );
// }
// if ( pointer_to_object( result )->payload.stream.stream == NULL ) {
// result = nil;
// } else {
// collect_meta( result, url );
// }
// free( url );
// }
return result;
}
/**
* Function: return the next character from the stream indicated by arg 0;
* further arguments are ignored.
*
* * (read-char stream)
*
* @param frame my stack frame.
* @param frame_pointer a pointer to my stack frame.
* @param env my environment.
* @return a string of one character, namely the next available character
* on my stream, if any, else nil.
*/
struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = nil;
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
if ( readp( stream_pointer ) ) {
result = make_string( frame_pointer,
url_fgetwc( stream_get_url_file
( stream_pointer ) ), nil );
if ( stringp( fetch_arg( frame, 0 ) ) ) {
char *url = lisp_string_to_c_string( fetch_arg( frame, 0 ) );
if ( c_nilp( fetch_arg( frame, 1 ) ) ) {
URL_FILE *stream = url_fopen( url, "r" );
debug_printf( DEBUG_IO, 0,
L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n",
( long int ) &stream, ( int ) stream->type,
( long int ) stream->handle.file );
switch ( stream->type ) {
case CFTYPE_NONE:
return make_exception( make_frame( 1, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Could not open stream" ) ) );
break;
case CFTYPE_FILE:
if ( stream->handle.file == NULL ) {
return make_exception( make_frame( 1, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Could not open file" ) ) );
}
break;
case CFTYPE_CURL:
/* can't tell whether a URL is bad without reading it */
break;
}
result = make_read_stream( frame_pointer, stream, nil );
} else {
// TODO: anything more complex is a problem for another day.
URL_FILE *stream = url_fopen( url, "w" );
result = make_write_stream( frame_pointer, stream, nil );
}
if ( pointer_to_object( result )->payload.stream.stream == NULL ) {
result = nil;
} else {
collect_meta( frame_pointer, result, url );
}
free( url );
}
return result;
}
/**
* Function: return a string representing all characters from the stream
* indicated by arg 0; further arguments are ignored.

10
src/c/io/io.h
View file

@ -33,10 +33,14 @@ struct pso_pointer initialise_default_streams( struct pso_pointer
#define C_IO_IN L"*in*"
#define C_IO_OUT L"*out*"
#define C_IO_LOG L"*log*"
#define C_IO_READBASE L"*read_base*"
#define C_IO_READTABLE L"*read_table*"
extern struct pso_pointer lisp_io_in;
extern struct pso_pointer lisp_io_out;
extern struct pso_pointer lisp_io_log;
extern struct pso_pointer lisp_io_readbase;
extern struct pso_pointer lisp_io_read_table;
extern struct pso_pointer lisp_stdin;
extern struct pso_pointer lisp_stdout;
@ -47,11 +51,12 @@ extern struct pso_pointer lisp_stderr;
extern struct pso_pointer lisp_io_prompt;
URL_FILE *file_to_url_file( FILE * f );
wint_t url_fgetwc( URL_FILE * input );
wint_t url_ungetwc( wint_t wc, URL_FILE * input );
struct pso_pointer get_character( struct pso_pointer read_stream );
struct pso_pointer push_back_character( struct pso_pointer c,
struct pso_pointer r );
@ -65,9 +70,6 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env );
char *lisp_string_to_c_string( struct pso_pointer s );
#endif

51
src/c/io/read.c
View file

@ -32,6 +32,7 @@
#include "memory/pso2.h"
#include "memory/tags.h"
#include "payloads/exception.h"
#include "payloads/function.h"
#include "payloads/integer.h"
#include "payloads/read_stream.h"
@ -73,12 +74,7 @@
* 1. The read table currently in use;
* 2. The character most recently read from that stream.
*/
struct pso_pointer read_example(
#ifndef MANAGED_POINTER_ONLY
struct pso4 *frame,
#endif
struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso_pointer read_example( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer stream = fetch_arg( frame, 0 );
struct pso_pointer readtable = fetch_arg( frame, 1 );
@ -88,6 +84,31 @@ struct pso_pointer read_example(
return result;
}
/**
* Function: return the next character from the stream indicated by arg 0;
* further arguments are ignored.
*
* * (read-char stream)
*
* @param frame my stack frame.
* @param frame_pointer a pointer to my stack frame.
* @param env my environment.
* @return a string of one character, namely the next available character
* on my stream, if any, else nil.
*/
struct pso_pointer read_character( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = nil;
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
if ( readp( stream_pointer ) ) {
result = make_string( frame_pointer,
url_fgetwc( stream_get_url_file
( stream_pointer ) ), nil );
}
return result;
}
/**
* @brief Read one integer from the stream and return it.
*
@ -111,7 +132,8 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
if ( readp( stream ) ) {
if ( c_nilp( character ) ) {
character = get_character( stream );
character =
read_character( make_frame( 1, frame_pointer, stream ) );
}
char32_t c = c_nilp( character )
? 0 : pointer_to_object( character )->payload.character.character;
@ -137,7 +159,8 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
if ( readp( stream ) ) {
if ( c_nilp( character ) ) {
character = get_character( stream );
character =
read_character( make_frame( 1, frame_pointer, stream ) );
}
char32_t c = c_nilp( character )
@ -186,7 +209,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
}
if ( c_nilp( character ) ) {
character = get_character( stream );
character = read_character( make_frame( 1, frame_pointer, stream ) );
}
struct pso_pointer readmacro = c_assoc( character, readtable );
@ -205,12 +228,10 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
/* skip all characters from semi-colon to the end of the line */
break;
case EOF:
// result = throw_exception( c_string_to_lisp_symbol(
// L"read" ),
// c_string_to_lisp_string
// ( L"End of input while
// reading" ),
// frame_pointer );
result = make_exception( make_frame( 1, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Read: end of input while reading" ) ) );
break;
default:
struct pso_pointer next = make_frame( 3, frame_pointer, stream,

2
src/c/io/read.h
View file

@ -13,6 +13,8 @@
#ifndef __psse_io_read_h
#define __psse_io_read_h
struct pso_pointer read_character( struct pso_pointer frame_pointer );
struct pso_pointer read_number( struct pso_pointer frame_pointer );
struct pso_pointer read_symbol( struct pso_pointer frame_pointer );