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

Right, I'm committing this session because I'm too cold and tired to go on.

Browse source 
It does not at present build (and it's going to take a good bit more work
before it does).
This commit is contained in:
Simon Brooke 2026-04-20 18:29:28 +01:00
parent f05d1af9d6
commit 6148d3699f
32 changed files with 364 additions and 309 deletions
Download patch file Download diff file Expand all files Collapse all files

2
docs/State-of-play.md
View file

@ -9,7 +9,7 @@ and over the past few days I've logged four issues that I've tagged
These are: These are:
* 17: [Add readtables; implement quote and keyword through readtables.](https://git.journeyman.cc/simon/post-scarcity/issues/17) * 17: [Add readtables; implement quote and keyword through readtables.](https://git.journeyman.cc/simon/post-scarcity/issues/17)
* 18: [Consider converting from `char32_t` to `char32_t`, everywhere.](https://git.journeyman.cc/simon/post-scarcity/issues/18) * 18: [Consider converting from `wchar_t` to `char32_t`, everywhere.](https://git.journeyman.cc/simon/post-scarcity/issues/18)
* 20: [Environment in stack frame.](https://git.journeyman.cc/simon/post-scarcity/issues/20) * 20: [Environment in stack frame.](https://git.journeyman.cc/simon/post-scarcity/issues/20)
* 21: [Temporary objects in a function must be bound to a locals slot in the stack frame](https://git.journeyman.cc/simon/post-scarcity/issues/21) * 21: [Temporary objects in a function must be bound to a locals slot in the stack frame](https://git.journeyman.cc/simon/post-scarcity/issues/21)

4
src/c/debug.h
View file

@ -104,7 +104,7 @@
*/ */
extern int verbosity; extern int verbosity;
void debug_print( char32_t *message, int level, int indent ); void debug_print( char32_t * message, int level, int indent );
void debug_print_object( struct pso_pointer object, int level, int indent ); void debug_print_object( struct pso_pointer object, int level, int indent );
@ -114,6 +114,6 @@ void debug_print_128bit( __int128_t n, int level );
void debug_println( int level ); void debug_println( int level );
void debug_printf( int level, int indent, char32_t *format, ... ); void debug_printf( int level, int indent, char32_t * format, ... );
#endif #endif

46
src/c/io/io.c
View file

@ -150,9 +150,9 @@ int initialise_io( ) {
} }
struct pso_pointer initialise_default_streams( struct pso_pointer env ) { struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
// todo: issue #21: should this have stack frame passed in? // todo: issue #21: should this have stack frame passed in?
// It's called in initialisation before everything else is set // It's called in initialisation before everything else is set
// up, so **possibly** not? // up, so **possibly** not?
lisp_io_in = c_string_to_lisp_symbol( C_IO_IN ); lisp_io_in = c_string_to_lisp_symbol( C_IO_IN );
lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT ); lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT );
lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG ); lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG );
@ -168,11 +168,11 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ), lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword ( c_string_to_lisp_keyword
( L"url" ), ( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"::system:standard-input" ) ), ( L"::system:standard-input" ) ),
nil ) ) ); nil ) ) );
env = c_bind( lisp_io_in, lisp_stdin, env ); env = c_bind( lisp_io_in, lisp_stdin, env );
@ -183,10 +183,10 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lock_object( make_write_stream lock_object( make_write_stream
( file_to_url_file( stdout ), ( file_to_url_file( stdout ),
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword( L"url" ), ( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"::system:standard-output" ) ), ( L"::system:standard-output" ) ),
nil ) ) ); nil ) ) );
env = c_bind( lisp_io_out, lisp_stdout, env ); env = c_bind( lisp_io_out, lisp_stdout, env );
} }
@ -196,10 +196,10 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lock_object( make_write_stream lock_object( make_write_stream
( file_to_url_file( stderr ), ( file_to_url_file( stderr ),
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword( L"url" ), ( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"::system:standard-output" ) ), ( L"::system:standard-output" ) ),
nil ) ) ); nil ) ) );
env = c_bind( lisp_io_log, lisp_stderr, env ); env = c_bind( lisp_io_log, lisp_stderr, env );
} }
@ -420,29 +420,29 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key, struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key,
long int value ) { long int value ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
return return
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword( key ), make_integer( value ) ), ( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta ); meta );
} }
struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key, struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key,
char *value ) { char *value ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
value = trim( value ); value = trim( value );
char32_t buffer[strlen( value ) + 1]; char32_t buffer[strlen( value ) + 1];
mbstowcs( buffer, value, strlen( value ) + 1 ); mbstowcs( buffer, value, strlen( value ) + 1 );
return return
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword( key ), ( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta ); c_string_to_lisp_string( buffer ) ), meta );
} }
struct pso_pointer add_meta_time( struct pso_pointer meta, char32_t *key, struct pso_pointer add_meta_time( struct pso_pointer meta, char32_t *key,
time_t *value ) { time_t *value ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
char datestring[256]; char datestring[256];
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ), strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),

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

@ -21,7 +21,7 @@ extern CURLSH *io_share;
int initialise_io( ); int initialise_io( );
struct pso_pointer initialise_default_streams( struct pso_pointer env ); struct pso_pointer initialise_default_streams( struct pso_pointer env );
#define C_IO_IN L"*in*" #define C_IO_IN L"*in*"
#define C_IO_OUT L"*out*" #define C_IO_OUT L"*out*"
#define C_IO_LOG L"*log*" #define C_IO_LOG L"*log*"

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

@ -44,9 +44,9 @@
#include "ops/truth.h" #include "ops/truth.h"
struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output, struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape); bool escape );
/** /**
* @brief write this character `wc` to this `output` stream, escaping it if * @brief write this character `wc` to this `output` stream, escaping it if
* 1. `escape` is true; and * 1. `escape` is true; and
@ -54,75 +54,77 @@ struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
* *
* TODO: this does not yet even nearly cope with all the possible special * TODO: this does not yet even nearly cope with all the possible special
* cases. * cases.
*/ */
void write_char( char32_t wc, URL_FILE * output, bool escape) { void write_char( char32_t wc, URL_FILE *output, bool escape ) {
if (escape && !iswprint(wc)) { if ( escape && !iswprint( wc ) ) {
url_fwprintf(output, L"\\%04x", wc); url_fwprintf( output, L"\\%04x", wc );
// url_fputwc(L'\\', output); // url_fputwc(L'\\', output);
} else { } else {
url_fputwc(wc, output); url_fputwc( wc, output );
} }
} }
struct pso_pointer print_string_like_thing(struct pso_pointer p, struct pso_pointer print_string_like_thing( struct pso_pointer p,
URL_FILE *output, bool escape) { URL_FILE *output, bool escape ) {
switch (get_tag_value(p)) { switch ( get_tag_value( p ) ) {
case KEYTV: case KEYTV:
url_fputwc(L':', output); url_fputwc( L':', output );
break; break;
case STRINGTV: case STRINGTV:
if (escape) if ( escape )
url_fputwc(L'"', output); url_fputwc( L'"', output );
break; break;
} }
if (keywordp(p) || stringp(p) || symbolp(p)) { if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
for (struct pso_pointer cursor = p; !nilp(cursor); for ( struct pso_pointer cursor = p; !nilp( cursor );
cursor = pointer_to_object(cursor)->payload.string.cdr) { cursor = pointer_to_object( cursor )->payload.string.cdr ) {
char32_t wc = pointer_to_object(cursor)->payload.string.character; char32_t wc =
pointer_to_object( cursor )->payload.string.character;
write_char( wc, output, escape); write_char( wc, output, escape );
} }
} }
if (stringp(p)) { if ( stringp( p ) ) {
if (escape) if ( escape )
url_fputwc(L'"', output); url_fputwc( L'"', output );
} }
return p; return p;
} }
struct pso_pointer write_list_content(struct pso_pointer p, URL_FILE *output, struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
bool escape) { bool escape ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
if (consp(p)) { if ( consp( p ) ) {
for (; consp(p); p = c_cdr(p)) { for ( ; consp( p ); p = c_cdr( p ) ) {
struct pso2 *object = pointer_to_object(p); struct pso2 *object = pointer_to_object( p );
result = in_write(object->payload.cons.car, output, escape); result = in_write( object->payload.cons.car, output, escape );
if (exceptionp(result)) if ( exceptionp( result ) )
break; break;
switch (get_tag_value(object->payload.cons.cdr)) { switch ( get_tag_value( object->payload.cons.cdr ) ) {
case NILTV: case NILTV:
break; break;
case CONSTV: case CONSTV:
url_fputwc(L' ', output); url_fputwc( L' ', output );
break; break;
default: default:
url_fputws(L" . ", output); url_fputws( L" . ", output );
result = in_write(object->payload.cons.cdr, output, escape); result =
} in_write( object->payload.cons.cdr, output, escape );
} }
} else { }
// TODO: return exception } else {
} // TODO: return exception
}
return result; return result;
} }
/** /**
@ -135,52 +137,53 @@ struct pso_pointer write_list_content(struct pso_pointer p, URL_FILE *output,
* reader; otherwise, print it appropriately for human readers. * reader; otherwise, print it appropriately for human readers.
* @return p on success, exception on failure. * @return p on success, exception on failure.
*/ */
struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output, struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
bool escape) { bool escape ) {
struct pso2 *object = pointer_to_object(p); struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil; struct pso_pointer result = nil;
if (object != NULL) { if ( object != NULL ) {
uint32_t v = get_tag_value(p); uint32_t v = get_tag_value( p );
switch (v) { switch ( v ) {
case CHARACTERTV: case CHARACTERTV:
write_char(object->payload.character.character, output, escape); write_char( object->payload.character.character, output,
break; escape );
case CONSTV: break;
url_fputwc(L'(', output); case CONSTV:
result = write_list_content(p, output, escape); url_fputwc( L'(', output );
url_fputwc(L')', output); result = write_list_content( p, output, escape );
break; url_fputwc( L')', output );
case INTEGERTV: break;
url_fwprintf(output, L"%d", case INTEGERTV:
(int64_t)(object->payload.integer.value)); url_fwprintf( output, L"%d",
break; ( int64_t ) ( object->payload.integer.value ) );
case KEYTV: break;
case STRINGTV: case KEYTV:
case SYMBOLTV: case STRINGTV:
print_string_like_thing(p, output, escape); case SYMBOLTV:
break; print_string_like_thing( p, output, escape );
case NILTV: break;
url_fputws(L"nil", output); case NILTV:
break; url_fputws( L"nil", output );
case READTV: break;
case WRITETV: case READTV:
url_fwprintf(output, L"<%s stream: ", case WRITETV:
v == READTV ? "read" : "write"); url_fwprintf( output, L"<%s stream: ",
in_write(object->payload.stream.meta, output, escape); v == READTV ? "read" : "write" );
url_fputwc(L'>', output); in_write( object->payload.stream.meta, output, escape );
break; url_fputwc( L'>', output );
case TRUETV: break;
url_fputwc(L't', output); case TRUETV:
break; url_fputwc( L't', output );
default: break;
// TODO: return exception default:
} // TODO: return exception
} else { }
// TODO: return exception } else {
} // TODO: return exception
}
return result; return result;
} }
/** /**
@ -195,31 +198,32 @@ struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
* @param nl_after if true, print a newline *after* printing `p`; else a space. * @param nl_after if true, print a newline *after* printing `p`; else a space.
* @return p on success, exception on failure. * @return p on success, exception on failure.
*/ */
struct pso_pointer write(struct pso_pointer p, struct pso_pointer stream, struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
bool escape, bool nl_before, bool nl_after) { bool escape, bool nl_before, bool nl_after ) {
struct pso_pointer result = p; struct pso_pointer result = p;
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 );
if (writep(stream)) { if ( writep( stream ) ) {
inc_ref(stream); inc_ref( stream );
if (nl_before) if ( nl_before )
url_fputwc(L'\n', output); url_fputwc( L'\n', output );
result = in_write(p, output, true); result = in_write( p, output, true );
url_fputwc(nl_after ? L'\n' : L' ', output); url_fputwc( nl_after ? L'\n' : L' ', output );
dec_ref(stream); dec_ref( stream );
} else { } else {
result = make_exception( result =
c_string_to_lisp_string(L"Bad write stream passed to write."), nil, make_exception( c_string_to_lisp_string
nil, nil); ( L"Bad write stream passed to write." ), nil, nil,
} nil );
}
return result; return result;
} }
/** /**
@ -229,13 +233,13 @@ struct pso_pointer write(struct pso_pointer p, struct pso_pointer stream,
* @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 c_print(struct pso_pointer p, struct pso_pointer stream) { struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
return write(p, stream, true, true, false); return write( p, stream, true, true, false );
} }
/** /**
* @brief princ is pretty much like print except things are printed `unescaped` * @brief princ is pretty much like print except things are printed `unescaped`
*/ */
struct pso_pointer c_princ(struct pso_pointer p, struct pso_pointer stream) { struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream ) {
return write(p, stream, false, true, false); return write( p, stream, false, true, false );
} }

98
src/c/memory/memory.c
View file

@ -77,60 +77,60 @@ struct pso_pointer initialise_memory( uint32_t node ) {
/** /**
* @brief Pop an object off the freelist for the specified `size_class`. * @brief Pop an object off the freelist for the specified `size_class`.
*/ */
struct pso_pointer pop_freelist( uint8_t size_class) { struct pso_pointer pop_freelist( uint8_t size_class ) {
// `t`, because if `allocate_page` fails it will be set to `nil`. // `t`, because if `allocate_page` fails it will be set to `nil`.
struct pso_pointer result = t; struct pso_pointer result = t;
if ( size_class <= MAX_SIZE_CLASS ) {
if ( nilp( freelists[size_class] ) ) {
result = allocate_page( size_class );
}
if ( nilp( result ) ) { if ( size_class <= MAX_SIZE_CLASS ) {
fputws( L"FATAL: Page space exhausted\n", stderr ); if ( nilp( freelists[size_class] ) ) {
exit( 1 ); // TODO: we don't want to do this! Somehow, we need to result = allocate_page( size_class );
// recover a workable environment, ideally by throwing a pre-made }
// exception.
}
if ( !exceptionp( result ) && !nilp( result ) ) { if ( nilp( result ) ) {
pthread_mutex_lock( &freelists_mutices[size_class]); fputws( L"FATAL: Page space exhausted\n", stderr );
result = freelists[size_class]; exit( 1 ); // TODO: we don't want to do this! Somehow, we need to
struct pso2 *object = pointer_to_object( result ); // recover a workable environment, ideally by throwing a pre-made
freelists[size_class] = object->payload.free.next; // exception.
pthread_mutex_unlock(&freelists_mutices[size_class]); }
/* the object ought already to have the right size class in its tag if ( !exceptionp( result ) && !nilp( result ) ) {
* because it was popped off the freelist for that size class. */ pthread_mutex_lock( &freelists_mutices[size_class] );
if ( object->header.tag.bytes.size_class != size_class ) { result = freelists[size_class];
// TODO: return an exception instead? Or warn, set it, and continue? struct pso2 *object = pointer_to_object( result );
} freelists[size_class] = object->payload.free.next;
/* the objext ought to have a reference count ot zero, because it's pthread_mutex_unlock( &freelists_mutices[size_class] );
* on the freelist, but again we should sanity check. */
if ( object->header.count != 0 ) { /* the object ought already to have the right size class in its tag
fwprintf( stderr, * because it was popped off the freelist for that size class. */
L"WARNING: Request to allocate object of size class %d, which is not implemented", if ( object->header.tag.bytes.size_class != size_class ) {
size_class); // TODO: return an exception instead? Or warn, set it, and continue?
} }
} /* the objext ought to have a reference count ot zero, because it's
} // TODO: else throw exception * on the freelist, but again we should sanity check. */
if ( object->header.count != 0 ) {
return result; fwprintf( stderr,
L"WARNING: Request to allocate object of size class %d, which is not implemented",
size_class );
}
}
} // TODO: else throw exception
return result;
} }
void push_freelist( struct pso_pointer p) { void push_freelist( struct pso_pointer p ) {
struct pso2 *obj = pointer_to_object( p ); struct pso2 *obj = pointer_to_object( p );
uint8_t size_class = ( obj->header.tag.bytes.size_class ); uint8_t size_class = ( obj->header.tag.bytes.size_class );
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG, strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
TAGLENGTH ); TAGLENGTH );
pthread_mutex_lock( &freelists_mutices[size_class]);
if ( size_class <= MAX_SIZE_CLASS ) { pthread_mutex_lock( &freelists_mutices[size_class] );
obj->payload.free.next = freelists[size_class];
freelists[size_class] = p; if ( size_class <= MAX_SIZE_CLASS ) {
} obj->payload.free.next = freelists[size_class];
freelists[size_class] = p;
pthread_mutex_unlock(&freelists_mutices[size_class]); }
pthread_mutex_unlock( &freelists_mutices[size_class] );
} }

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

@ -10,6 +10,7 @@
#ifndef __psse_memory_memory_h #ifndef __psse_memory_memory_h
#define __psse_memory_memory_h #define __psse_memory_memory_h
#include <pthread.h> #include <pthread.h>
#include <stdbool.h>
#include "memory/pointer.h" #include "memory/pointer.h"
@ -26,10 +27,11 @@
struct pso_pointer initialise_memory( ); struct pso_pointer initialise_memory( );
struct pso_pointer pop_freelist( uint8_t size_class); struct pso_pointer pop_freelist( uint8_t size_class );
void push_freelist( struct pso_pointer p); void push_freelist( struct pso_pointer p );
extern struct pso_pointer out_of_memory_exception; extern struct pso_pointer out_of_memory_exception;
extern struct pso_pointer freelists[]; extern struct pso_pointer freelists[];
extern pthread_mutex_t freelists_mutices[]; extern pthread_mutex_t freelists_mutices[];
extern bool memory_initialised;
#endif #endif

4
src/c/memory/page.c
View file

@ -319,11 +319,11 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
L"\nAllocated page %d for objects of size class %x.\n", L"\nAllocated page %d for objects of size class %x.\n",
npages_allocated, size_class ); npages_allocated, size_class );
pthread_mutex_lock( &freelists_mutices[size_class]); pthread_mutex_lock( &freelists_mutices[size_class] );
freelists[size_class] = freelists[size_class] =
initialise_page( ( union page * ) pg, npages_allocated, initialise_page( ( union page * ) pg, npages_allocated,
size_class, freelists[size_class] ); size_class, freelists[size_class] );
pthread_mutex_unlock( &freelists_mutices[size_class]); pthread_mutex_unlock( &freelists_mutices[size_class] );
debug_printf( DEBUG_ALLOC, 0, debug_printf( DEBUG_ALLOC, 0,
L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n", L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n",

60
src/c/memory/pso.c
View file

@ -35,16 +35,20 @@
#include "ops/truth.h" #include "ops/truth.h"
/** /**
* @brief Allocate an object of this size_class with this tag. * @brief Allocate an object of this `size_class` with this `tag`.
* *
* All objects that are allocated (after completion of init)) should be linked * All objects that are allocated (after completion of init)) should be linked
* onto the `locals` slot on a stack frame. This guarantees * onto the `locals` slot of a stack frame. This guarantees
* 1. that they get `inc_ref`ed; and that, * 1. that they do get `inc_ref`ed; and that,
* 2. if nothing else hangs onto them they will be reclaimed when that stack * 2. if nothing else hangs onto them they will be reclaimed when that stack
* frame is reclaimed. * frame is reclaimed.
* for some objects (e.g. those cons cells on the locals list) this isn't * for some objects (e.g. those cons cells on the locals list) this isn't
* possible due to infinite recursion, but those special cases need to be * possible due to infinite recursion, but those special cases need to be
* audited carefully * audited carefully.
*
* The stack frame pointer is DELIBERATELY a C pointer, not a Lisp pointer,
* because you are definitely not supposed to be calling this function from
* Lisp. Please do not!
* *
* @param stack_pointer C (NOT Lisp!) pointer to an active stack frame (or * @param stack_pointer C (NOT Lisp!) pointer to an active stack frame (or
* NULL, but only during initialisation). * NULL, but only during initialisation).
@ -52,8 +56,9 @@
* @param size_class The size class for the object to be allocated; * @param size_class The size class for the object to be allocated;
* @return struct pso_pointer a pointer to the newly allocated object * @return struct pso_pointer a pointer to the newly allocated object
*/ */
struct pso_pointer allocate( /* struct pso4 * stack_pointer,*/ char *tag, uint8_t size_class ) { struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag,
// todo: issue #21: must have stack frame passed in. uint8_t size_class ) {
// todo: issue #21: must have stack frame passed in.
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, debug_printf( DEBUG_ALLOC, 0,
@ -61,26 +66,29 @@ struct pso_pointer allocate( /* struct pso4 * stack_pointer,*/ char *tag, uint8_
size_class, tag ); size_class, tag );
#endif #endif
struct pso_pointer result = pop_freelist(size_class); struct pso_pointer result = pop_freelist( size_class );
if (!nilp( result)) { if ( !nilp( result ) ) {
strncpy( ( char * ) ( pointer_to_object(result)->header.tag.bytes.mnemonic ), tag, strncpy( ( char * ) ( pointer_to_object( result )->header.tag.bytes.
TAGLENGTH ); mnemonic ), tag, TAGLENGTH );
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ",
result.page, result.offset ); result.page, result.offset );
// if ( stack_pointer != NULL && if ( stack_pointer != NULL &&
// (stack_pointer->header.tag.value & 0xffffff) == STACKTV) { ( stack_pointer->header.tag.value & 0xffffff ) == STACKTV ) {
// struct pso_pointer locals = make_cons(result, struct pso_pointer locals = make_cons( result,
// stack_pointer->payload.stack_frame.locals); stack_pointer->
// stack_pointer->payload.stack_frame.locals = locals; payload.stack_frame.
// locals );
// } else { stack_pointer->payload.stack_frame.locals = locals;
// fputws( L"WARNING: No stack frame passed to `allocate`.\n", stderr);
// } } else if ( memory_initialised ) {
} else { fputws( L"WARNING: No stack frame passed to `allocate`.\n",
// TODO: throw exception stderr );
} }
} else {
// TODO: throw exception
}
#ifdef DEBUG #ifdef DEBUG
debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC, debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC,
@ -203,7 +211,7 @@ struct pso_pointer free_object( struct pso_pointer p ) {
obj->payload.words[i] = 0; obj->payload.words[i] = 0;
} }
push_freelist(p); push_freelist( p );
return result; return result;
} }

5
src/c/memory/pso.h
View file

@ -14,9 +14,10 @@
#include "memory/header.h" #include "memory/header.h"
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso4.h"
// todo: issue #21: must have stack frame passed in. struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag,
struct pso_pointer allocate( char *tag, uint8_t size_class ); uint8_t size_class );
struct pso_pointer dec_ref( struct pso_pointer pointer ); struct pso_pointer dec_ref( struct pso_pointer pointer );

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

@ -41,6 +41,6 @@ struct pso_pointer lisp_bind(
struct pso_pointer c_bind( struct pso_pointer key, struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value, struct pso_pointer value,
struct pso_pointer store ) { struct pso_pointer store ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
return make_cons( make_cons( key, value ), store ); return make_cons( make_cons( key, value ), store );
} }

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

@ -85,12 +85,18 @@ struct pso_pointer eval(
default: default:
result = result =
make_exception( make_cons make_exception( make_cons
( c_string_to_lisp_string ( frame, c_string_to_lisp_string
( L"Can't yet evaluate things of this type: " ), ( frame,
result ), frame_pointer, L"Can't yet evaluate things of this type: " ),
make_cons( make_cons result ), frame_pointer, make_cons( frame,
( c_string_to_lisp_keyword( L"tag" ), make_cons
get_tag_string( result ) ), nil ), ( frame,
c_string_to_lisp_keyword
( frame,
L"tag" ),
get_tag_string
( result ) ),
nil ),
nil ); nil );
} }

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

@ -44,7 +44,7 @@ struct pso_pointer cdr(
#ifdef MANAGED_POINTER_ONLY #ifdef MANAGED_POINTER_ONLY
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif #endif
return c_cdr( fetch_arg( frame, 0 ) ); return c_cdr( frame, fetch_arg( frame, 0 ) );
} }
/** /**
@ -66,7 +66,7 @@ struct pso_pointer cons(
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer );
#endif #endif
return make_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) ); return make_cons( frame, fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) );
} }
#endif #endif

6
src/c/ops/repl.c
View file

@ -48,11 +48,13 @@ void int_handler( int dummy ) {
* Very simple read/eval/print loop for bootstrapping. * Very simple read/eval/print loop for bootstrapping.
*/ */
void c_repl( bool show_prompt ) { void c_repl( bool show_prompt ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
signal( SIGINT, int_handler ); signal( SIGINT, int_handler );
debug_print( L"Entered repl\n", DEBUG_REPL, 0 ); debug_print( L"Entered repl\n", DEBUG_REPL, 0 );
struct pso_pointer env = consp( oblist ) ? oblist : make_cons( oblist, nil ); // TODO: NULL is not OK here, but will do until we have a REPL in Lisp.
struct pso_pointer env =
consp( oblist ) ? oblist : make_cons( NULL, oblist, nil );
struct pso_pointer input_stream = c_assoc( lisp_io_in, env ); struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
struct pso_pointer output_stream = c_assoc( lisp_io_out, env ); struct pso_pointer output_stream = c_assoc( lisp_io_out, env );

2
src/c/ops/repl.h
View file

@ -13,7 +13,7 @@
#define SRC_C_OPS_REPL_H_ #define SRC_C_OPS_REPL_H_
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
void c_repl( ); void c_repl( );

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

@ -36,7 +36,7 @@
* the argument was not a sequence. * the argument was not a sequence.
*/ */
struct pso_pointer c_reverse( struct pso_pointer sequence ) { struct pso_pointer c_reverse( struct pso_pointer sequence ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
struct pso_pointer result = nil; struct pso_pointer result = nil;
for ( struct pso_pointer cursor = sequence; !nilp( sequence ); for ( struct pso_pointer cursor = sequence; !nilp( sequence );
@ -66,8 +66,8 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) {
default: default:
result = result =
make_exception( make_cons( c_string_to_lisp_string make_exception( make_cons( c_string_to_lisp_string
( L"Invalid object in sequence" ), ( L"Invalid object in sequence" ),
cursor ), nil, nil, nil ); cursor ), nil, nil, nil );
goto exit; goto exit;
break; break;
} }

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

@ -69,12 +69,13 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
* char32_t in larger pso classes, so this function may be only for strings * char32_t in larger pso classes, so this function may be only for strings
* (and thus simpler). * (and thus simpler).
*/ */
struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail, struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer,
wint_t c, struct pso_pointer tail,
char *tag ) { char *tag ) {
struct pso_pointer pointer = tail; struct pso_pointer pointer = tail;
if ( check_type( tail, tag ) || nilp( tail ) ) { if ( check_type( tail, tag ) || nilp( tail ) ) {
pointer = allocate( tag, CONS_SIZE_CLASS ); pointer = allocate( frame_pointer, tag, CONS_SIZE_CLASS );
struct pso2 *cell = pointer_to_object( pointer ); struct pso2 *cell = pointer_to_object( pointer );
cell->payload.string.character = c; cell->payload.string.character = c;
@ -106,8 +107,9 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
* @param c the character to add (prepend); * @param c the character to add (prepend);
* @param tail the string which is being built. * @param tail the string which is being built.
*/ */
struct pso_pointer make_string( wint_t c, struct pso_pointer tail ) { struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c,
return make_string_like_thing( c, tail, STRINGTAG ); struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, STRINGTAG );
} }
/** /**
@ -118,8 +120,9 @@ struct pso_pointer make_string( wint_t c, struct pso_pointer tail ) {
* @param c the character to add (prepend); * @param c the character to add (prepend);
* @param tail the keyword which is being built. * @param tail the keyword which is being built.
*/ */
struct pso_pointer make_keyword( wint_t c, struct pso_pointer tail ) { struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c,
return make_string_like_thing( c, tail, KEYTAG ); struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, KEYTAG );
} }
/** /**
@ -130,22 +133,26 @@ struct pso_pointer make_keyword( wint_t c, struct pso_pointer tail ) {
* @param c the character to add (prepend); * @param c the character to add (prepend);
* @param tail the symbol which is being built. * @param tail the symbol which is being built.
*/ */
struct pso_pointer make_symbol( wint_t c, struct pso_pointer tail ) { struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c,
return make_string_like_thing( c, tail, SYMBOLTAG ); struct pso_pointer tail ) {
return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG );
} }
/** /**
* Return a lisp string representation of this wide character string. * Return a lisp string representation of this wide character string.
*/ */
struct pso_pointer c_string_to_lisp_string( char32_t *string ) { struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer,
char32_t *string ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
if ( string[i] != '"' ) { if ( string[i] != '"' ) {
result = make_string( string[i], result ); result = make_string( frame_pointer, string[i], result );
} else { } else {
result = make_string( L'\\', make_string( string[i], result ) ); result = make_string( frame_pointer, L'\\',
make_string( frame_pointer, string[i],
result ) );
} }
} }
@ -157,14 +164,15 @@ struct pso_pointer c_string_to_lisp_string( char32_t *string ) {
* Return a lisp symbol representation of this wide character string. In * Return a lisp symbol representation of this wide character string. In
* symbols, I am accepting only lower case characters. * symbols, I am accepting only lower case characters.
*/ */
struct pso_pointer c_string_to_lisp_symbol( char32_t *symbol ) { struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer,
char32_t *symbol ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
char32_t c = towlower( symbol[i] ); char32_t c = towlower( symbol[i] );
if ( iswalpha( c ) || c == L'-' || c == L'*' ) { if ( iswalpha( c ) || c == L'-' || c == L'*' ) {
result = make_symbol( c, result ); result = make_symbol( frame_pointer, c, result );
} }
} }
@ -175,14 +183,15 @@ struct pso_pointer c_string_to_lisp_symbol( char32_t *symbol ) {
* Return a lisp keyword representation of this wide character string. In * Return a lisp keyword representation of this wide character string. In
* keywords, I am accepting only lower case characters and numbers. * keywords, I am accepting only lower case characters and numbers.
*/ */
struct pso_pointer c_string_to_lisp_keyword( char32_t *symbol ) { struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer,
char32_t *symbol ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
char32_t c = towlower( symbol[i] ); char32_t c = towlower( symbol[i] );
if ( iswalnum( c ) || c == L'-' ) { if ( iswalnum( c ) || c == L'-' ) {
result = make_keyword( c, result ); result = make_keyword( frame_pointer, c, result );
} }
} }

21
src/c/ops/string_ops.h
View file

@ -17,19 +17,26 @@
#include <wchar.h> #include <wchar.h>
#include <wctype.h> #include <wctype.h>
struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail, struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer,
wint_t c, struct pso_pointer tail,
char *tag ); char *tag );
struct pso_pointer make_string( wint_t c, struct pso_pointer tail ); struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer make_keyword( wint_t c, struct pso_pointer tail ); struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer make_symbol( wint_t c, struct pso_pointer tail ); struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c,
struct pso_pointer tail );
struct pso_pointer c_string_to_lisp_string( char32_t *string ); struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer,
char32_t * string );
struct pso_pointer c_string_to_lisp_keyword( char32_t *symbol ); struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer,
char32_t * symbol );
struct pso_pointer c_string_to_lisp_symbol( char32_t *symbol ); struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer,
char32_t * symbol );
#endif #endif

4
src/c/payloads/character.c
View file

@ -24,8 +24,8 @@
#include "payloads/character.h" #include "payloads/character.h"
struct pso_pointer make_character( wint_t c ) { struct pso_pointer make_character( struct pso4 *frame_pointer, wint_t c ) {
struct pso_pointer result = allocate( CHARACTERTAG, 2 ); struct pso_pointer result = allocate( frame_pointer, CHARACTERTAG, 2 );
if ( !nilp( result ) ) { if ( !nilp( result ) ) {
pointer_to_object( result )->payload.character.character = pointer_to_object( result )->payload.character.character =

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

@ -26,6 +26,7 @@
#include <wchar.h> #include <wchar.h>
#include <wctype.h> #include <wctype.h>
#include "memory/pso4.h"
#define CHARTAG "CHR" #define CHARTAG "CHR"
#define CHARTV 5392451 #define CHARTV 5392451
@ -37,5 +38,5 @@ struct character_payload {
char32_t character; char32_t character;
}; };
struct pso_pointer make_character( wint_t c ); struct pso_pointer make_character( struct pso4 *frame_pointer, wint_t c );
#endif #endif

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

@ -30,9 +30,11 @@
* @param cdr the pointer which should form the cdr of this cons cell. * @param cdr the pointer which should form the cdr of this cons cell.
* @return struct pso_pointer a pointer to the newly allocated cons cell. * @return struct pso_pointer a pointer to the newly allocated cons cell.
*/ */
struct pso_pointer make_cons(struct pso_pointer car, struct pso_pointer cdr) { struct pso_pointer make_cons( struct pso4 *frame_pointer,
// todo: issue #21: must have stack frame passed in. struct pso_pointer car,
struct pso_pointer result = allocate( CONSTAG, 2 ); struct pso_pointer cdr ) {
// todo: issue #21: must have stack frame passed in.
struct pso_pointer result = allocate( frame_pointer, CONSTAG, 2 );
struct pso2 *object = pointer_to_object( result ); struct pso2 *object = pointer_to_object( result );
object->payload.cons.car = inc_ref( car ); object->payload.cons.car = inc_ref( car );
@ -68,8 +70,8 @@ struct pso_pointer c_car( struct pso_pointer cons ) {
* @return the cdr of the indicated cell. * @return the cdr of the indicated cell.
* @exception if the pointer does not indicate a cons cell. * @exception if the pointer does not indicate a cons cell.
*/ */
struct pso_pointer c_cdr(struct pso_pointer p) { struct pso_pointer c_cdr( struct pso4 *stack_pointer, struct pso_pointer p ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso2 *object = pointer_to_object( p ); struct pso2 *object = pointer_to_object( p );
@ -85,8 +87,8 @@ struct pso_pointer c_cdr(struct pso_pointer p) {
default: default:
result = result =
make_exception( make_cons make_exception( make_cons
( c_string_to_lisp_string ( stack_pointer, c_string_to_lisp_string
( L"Invalid type for cdr" ), ( stack_pointer, L"Invalid type for cdr" ),
get_tag_string( p ) ), nil, nil, nil ); get_tag_string( p ) ), nil, nil, nil );
break; break;
} }
@ -109,6 +111,6 @@ struct pso_pointer destroy_cons( struct pso_pointer 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];
dec_ref( c_car( p ) ); dec_ref( c_car( p ) );
dec_ref( c_cdr( p ) ); dec_ref( c_cdr( frame, p ) );
} }
} }

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

@ -12,6 +12,7 @@
#include <stdbool.h> #include <stdbool.h>
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso4.h"
#define CONS_SIZE_CLASS 2 #define CONS_SIZE_CLASS 2
@ -28,10 +29,12 @@ struct cons_payload {
struct pso_pointer c_car( struct pso_pointer cons ); struct pso_pointer c_car( struct pso_pointer cons );
struct pso_pointer c_cdr( struct pso_pointer cons ); struct pso_pointer c_cdr( struct pso4 *stack_pointer,
struct pso_pointer cons );
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
struct pso_pointer make_cons( struct pso_pointer car, struct pso_pointer cdr ); struct pso_pointer make_cons( struct pso4 *stack_pointer,
struct pso_pointer car, struct pso_pointer cdr );
struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer destroy_cons( struct pso_pointer fp,
struct pso_pointer env ); struct pso_pointer env );

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

@ -38,7 +38,8 @@ 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( pointer_to_pso4( frame ), 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 );

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

@ -14,6 +14,7 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
#include "debug.h" #include "debug.h"
@ -24,11 +25,11 @@
* @param more `nil`, or a pointer to the more significant cell(s) of this number. * @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`. * *NOTE* that if `more` is not `nil`, `value` *must not* exceed `MAX_INTEGER`.
*/ */
struct pso_pointer make_integer( int64_t value ) { struct pso_pointer make_integer( struct pso4 *frame_pointer, int64_t value ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
debug_print( L"Entering make_integer\n", DEBUG_ALLOC, 0 ); debug_print( L"Entering make_integer\n", DEBUG_ALLOC, 0 );
result = allocate( INTEGERTAG, 2 ); result = allocate( frame_pointer, INTEGERTAG, 2 );
struct pso2 *cell = pointer_to_object( result ); struct pso2 *cell = pointer_to_object( result );
cell->payload.integer.value = value; cell->payload.integer.value = value;

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

@ -12,6 +12,8 @@
#include <stdint.h> #include <stdint.h>
#include "memory/pso4.h"
/** /**
* @brief An integer . * @brief An integer .
* *
@ -23,6 +25,6 @@ struct integer_payload {
__int128_t value; __int128_t value;
}; };
struct pso_pointer make_integer( int64_t value ); struct pso_pointer make_integer( struct pso4 *frame_pointer, int64_t value );
#endif #endif

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

@ -8,23 +8,19 @@
*/ */
#include <stdint.h>
/* /*
* wide characters * wide characters
*/ */
#include <wchar.h>
#include <wctype.h>
#include "memory/node.h" #include "memory/node.h"
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
#include "memory/pso2.h"
#include "memory/pso4.h" #include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
#include "ops/string_ops.h" #include "payloads/cons.h"
#include "ops/truth.h"
/** /**
* @brief When an string is freed, its cdr pointer must be decremented. * @brief When an string is freed, its cdr pointer must be decremented.
@ -38,7 +34,7 @@ struct pso_pointer destroy_string( struct pso_pointer 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];
dec_ref( c_cdr( p ) ); dec_ref( c_cdr( frame, p ) );
} }
return nil; return nil;

6
src/c/payloads/read_stream.c
View file

@ -15,6 +15,7 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
@ -24,9 +25,10 @@
* @param metadata a pointer to an associaton containing metadata on the stream. * @param metadata a pointer to an associaton containing metadata on the stream.
* @return a pointer to the new read stream. * @return a pointer to the new read stream.
*/ */
struct pso_pointer make_read_stream( URL_FILE *input, struct pso_pointer make_read_stream( struct pso4 *frame_pointer,
URL_FILE *input,
struct pso_pointer metadata ) { struct pso_pointer metadata ) {
struct pso_pointer pointer = allocate( READTAG, 2 ); struct pso_pointer pointer = allocate( frame_pointer, READTAG, 2 );
struct pso2 *cell = pointer_to_object( pointer ); struct pso2 *cell = pointer_to_object( pointer );
cell->payload.stream.stream = input; cell->payload.stream.stream = input;

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

@ -29,7 +29,8 @@ struct stream_payload {
struct pso_pointer meta; struct pso_pointer meta;
}; };
struct pso_pointer make_read_stream( URL_FILE * input, struct pso_pointer make_read_stream( struct pso4 *frame_pointer,
URL_FILE * input,
struct pso_pointer metadata ); struct pso_pointer metadata );
#endif #endif

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

@ -33,12 +33,13 @@
*/ */
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
... ) { ... ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
va_list args; va_list args;
va_start( args, previous ); va_start( args, previous );
struct pso_pointer frame_pointer = allocate( STACKTAG, 4 ); struct pso4 *frame = pointer_to_pso4( previous );
struct pso4 *frame = ( struct pso4 * ) pointer_to_object( frame_pointer ); struct pso_pointer frame_pointer =
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, debug_printf( DEBUG_ALLOC, 0,
@ -72,7 +73,8 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
for ( ; cursor < arg_count; cursor++ ) { for ( ; cursor < arg_count; cursor++ ) {
more_args = more_args =
make_cons( va_arg( args, struct pso_pointer ), more_args ); make_cons( frame, va_arg( args, struct pso_pointer ),
more_args );
} }
frame->payload.stack_frame.more = c_reverse( more_args ); frame->payload.stack_frame.more = c_reverse( more_args );
@ -103,6 +105,8 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
dec_ref( frame->payload.stack_frame.previous ); dec_ref( frame->payload.stack_frame.previous );
dec_ref( frame->payload.stack_frame.function ); dec_ref( frame->payload.stack_frame.function );
dec_ref( frame->payload.stack_frame.more ); dec_ref( frame->payload.stack_frame.more );
dec_ref( frame->payload.stack_frame.locals );
dec_ref( frame->payload.stack_frame.env );
for ( int i = 0; i < args_in_frame; i++ ) { for ( int i = 0; i < args_in_frame; i++ ) {
dec_ref( frame->payload.stack_frame.arg[i] ); dec_ref( frame->payload.stack_frame.arg[i] );

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

@ -31,10 +31,10 @@ struct stack_frame_payload {
struct pso_pointer more; struct pso_pointer more;
/** the function to be called. */ /** the function to be called. */
struct pso_pointer function; struct pso_pointer function;
/** the execute-time environment */ /** the execute-time environment */
struct pso_pointer env; struct pso_pointer env;
/** a list of objects created in the context of this frame */ /** a list of objects created in the context of this frame */
struct pso_pointer locals; struct pso_pointer locals;
/** the number of arguments provided. */ /** the number of arguments provided. */
uint32_t args; uint32_t args;
/** the depth of the stack below this frame */ /** the depth of the stack below this frame */

6
src/c/payloads/write_stream.c
View file

@ -15,6 +15,7 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
@ -24,9 +25,10 @@
* @param metadata a pointer to an associaton containing metadata on the stream. * @param metadata a pointer to an associaton containing metadata on the stream.
* @return a pointer to the new read stream. * @return a pointer to the new read stream.
*/ */
struct pso_pointer make_write_stream( URL_FILE *output, struct pso_pointer make_write_stream( struct pso4 *frame_pointer,
URL_FILE *output,
struct pso_pointer metadata ) { struct pso_pointer metadata ) {
struct pso_pointer pointer = allocate( WRITETAG, 2 ); struct pso_pointer pointer = allocate( frame_pointer, WRITETAG, 2 );
struct pso2 *cell = pointer_to_object( pointer ); struct pso2 *cell = pointer_to_object( pointer );
cell->payload.stream.stream = output; cell->payload.stream.stream = output;

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

@ -13,6 +13,7 @@
/* write stream shares a payload with /see read_streem.h */ /* write stream shares a payload with /see read_streem.h */
#include "io/fopen.h" #include "io/fopen.h"
struct pso_pointer make_write_stream( URL_FILE * output, struct pso_pointer make_write_stream( struct pso4 *frame_pointer,
URL_FILE * output,
struct pso_pointer metadata ); struct pso_pointer metadata );
#endif #endif