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

Compare commits

base: simon:b6480aebd520a8623fb2ce34dfdd842a9f8ae4fa
Branches Tags
simon:master
simon:develop
simon:intern-rewrite
simon:feature-2
simon:feature/all-integers-are-bignums
simon:release/0.0.6
simon:release_0.0.5
..
compare: simon:9eb0d3c5a07a171d3506679d9c1b211712921ed1
Branches Tags
simon:develop
simon:master
simon:intern-rewrite
simon:feature-2
simon:feature/all-integers-are-bignums
simon:release/0.0.6
simon:release_0.0.5

No commits in common. "b6480aebd520a8623fb2ce34dfdd842a9f8ae4fa" and "9eb0d3c5a07a171d3506679d9c1b211712921ed1" have entirely different histories.
b6480aebd5 ... 9eb0d3c5a0

53 changed files with 505 additions and 645 deletions
Download patch file Download diff file Expand all files Collapse all files

10
archive/c/ops/equal.c
View file

@ -272,7 +272,7 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) { for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
struct cons_pointer key = c_car( i ); struct cons_pointer key = c_car( i );
if ( !c_equal if ( !equal
( hashmap_get( a, key, false ), ( hashmap_get( a, key, false ),
hashmap_get( b, key, false ) ) ) { hashmap_get( b, key, false ) ) ) {
result = false; result = false;
@ -331,7 +331,7 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
* Deep, and thus expensive, equality: true if these two objects have * Deep, and thus expensive, equality: true if these two objects have
* identical structure, else false. * identical structure, else false.
*/ */
bool c_equal( struct cons_pointer a, struct cons_pointer b ) { bool equal( struct cons_pointer a, struct cons_pointer b ) {
debug_print( L"\nequal: ", DEBUG_EQUAL ); debug_print( L"\nequal: ", DEBUG_EQUAL );
debug_print_object( a, DEBUG_EQUAL ); debug_print_object( a, DEBUG_EQUAL );
debug_print( L" = ", DEBUG_EQUAL ); debug_print( L" = ", DEBUG_EQUAL );
@ -353,8 +353,8 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
* structures can be of indefinite extent. It *must* be done by * structures can be of indefinite extent. It *must* be done by
* iteration (and even that is problematic) */ * iteration (and even that is problematic) */
result = result =
c_equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
&& c_equal( cell_a->payload.cons.cdr, && equal( cell_a->payload.cons.cdr,
cell_b->payload.cons.cdr ); cell_b->payload.cons.cdr );
break; break;
case KEYTV: case KEYTV:
@ -401,7 +401,7 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
* isn't sufficient. So we recurse at least once. */ * isn't sufficient. So we recurse at least once. */
result = ( wcsncmp( a_buff, b_buff, i ) == 0 ) result = ( wcsncmp( a_buff, b_buff, i ) == 0 )
&& c_equal( c_cdr( a ), c_cdr( b ) ); && equal( c_cdr( a ), c_cdr( b ) );
} }
break; break;
case VECTORPOINTTV: case VECTORPOINTTV:

2
archive/c/ops/equal.h
View file

@ -31,6 +31,6 @@ bool eq( struct cons_pointer a, struct cons_pointer b );
* Deep, and thus expensive, equality: true if these two objects have * Deep, and thus expensive, equality: true if these two objects have
* identical structure, else false. * identical structure, else false.
*/ */
bool c_equal( struct cons_pointer a, struct cons_pointer b ); bool equal( struct cons_pointer a, struct cons_pointer b );
#endif #endif

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

@ -334,7 +334,7 @@ struct cons_pointer search_store( struct cons_pointer key,
switch ( get_tag_value( entry_ptr ) ) { switch ( get_tag_value( entry_ptr ) ) {
case CONSTV: case CONSTV:
if ( c_equal( key, c_car( entry_ptr ) ) ) { if ( equal( key, c_car( entry_ptr ) ) ) {
result = result =
return_key ? c_car( entry_ptr ) return_key ? c_car( entry_ptr )
: c_cdr( entry_ptr ); : c_cdr( entry_ptr );
@ -441,7 +441,7 @@ struct cons_pointer internedp( struct cons_pointer key,
for ( struct cons_pointer pair = c_car( store ); for ( struct cons_pointer pair = c_car( store );
eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) { eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
if ( consp( pair ) ) { if ( consp( pair ) ) {
if ( c_equal( c_car( pair ), key ) ) { if ( equal( c_car( pair ), key ) ) {
// yes, this should be `eq`, but if symbols are correctly // yes, this should be `eq`, but if symbols are correctly
// interned this will work efficiently, and if not it will // interned this will work efficiently, and if not it will
// still work. // still work.

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

@ -987,7 +987,7 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( frame->args > 1 ) { if ( frame->args > 1 ) {
for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) { for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
result = result =
c_equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL; equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
} }
} }

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

@ -10,6 +10,6 @@
#ifndef __psse_environment_environment_h #ifndef __psse_environment_environment_h
#define __psse_environment_environment_h #define __psse_environment_environment_h
struct pso_pointer initialise_environment( uint32_t node ); struct pso_pointer initialise_environment( uint32_t node);
#endif #endif

60
src/c/io/io.c
View file

@ -114,7 +114,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
if ( stringp( s ) || symbolp( s ) ) { if ( stringp( s ) || symbolp( s ) ) {
int len = 0; int len = 0;
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) { for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
len++; len++;
} }
@ -123,7 +124,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
result = calloc( ( len * 4 ) + 1, sizeof( char ) ); result = calloc( ( len * 4 ) + 1, sizeof( char ) );
int i = 0; int i = 0;
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) { for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
buffer[i++] = pointer_to_object( c )->payload.string.character; buffer[i++] = pointer_to_object( c )->payload.string.character;
} }
@ -132,7 +134,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
} }
debug_print( L"lisp_string_to_c_string( ", DEBUG_IO, 0 ); debug_print( L"lisp_string_to_c_string( ", DEBUG_IO, 0 );
debug_print_object( s, DEBUG_IO, 0 ); debug_print_object( s, DEBUG_IO , 0);
debug_printf( DEBUG_IO, 0, L") => '%s'\n", result ); debug_printf( DEBUG_IO, 0, L") => '%s'\n", result );
return result; return result;
@ -262,11 +264,8 @@ wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
struct pso_pointer get_character( struct pso_pointer read_stream ) { struct pso_pointer get_character( struct pso_pointer read_stream ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( readp( read_stream ) ) { if (readp( read_stream)) {
result = result = make_character( url_fgetwc( pointer_to_object_of_size_class(read_stream, 2)->payload.stream.stream));
make_character( url_fgetwc
( pointer_to_object_of_size_class
( read_stream, 2 )->payload.stream.stream ) );
} }
return result; return result;
@ -280,16 +279,12 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
* *
* @return `t` on success, else `nil`. * @return `t` on success, else `nil`.
*/ */
struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r) {
struct pso_pointer r ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
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.character),
( pointer_to_object( c )->payload.character. pointer_to_object(r)->payload.stream.stream) >= 0) {
character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t; result = t;
} }
} }
@ -309,14 +304,12 @@ struct pso_pointer push_back_character( struct pso_pointer c,
* @return T if the stream was successfully closed, else nil. * @return T if the stream was successfully closed, else nil.
*/ */
struct pso_pointer struct pso_pointer
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) { lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer env ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
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.stream.stream )
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream )
== 0 ) { == 0 ) {
result = t; result = t;
} }
@ -496,8 +489,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
* on my stream, if any, else nil. * on my stream, if any, else nil.
*/ */
struct pso_pointer struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) { lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer env ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
// if ( stringp( fetch_arg( frame, 0) ) ) { // if ( stringp( fetch_arg( frame, 0) ) ) {
@ -563,14 +556,14 @@ lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* on my stream, if any, else nil. * on my stream, if any, else nil.
*/ */
struct pso_pointer struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) { lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer env ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
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) )->payload.
stream.stream ), nil ); stream.stream ), nil );
} }
@ -592,19 +585,18 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* on my stream, if any, else nil. * on my stream, if any, else nil.
*/ */
struct pso_pointer struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env ) { lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer env ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( readp( fetch_arg( frame, 0 ) ) ) { if ( readp( fetch_arg( frame, 0) ) ) {
URL_FILE *stream = URL_FILE *stream = pointer_to_object( fetch_arg( frame, 0) )->payload.stream.stream;
pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.stream;
struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil ); struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil );
result = cursor; result = cursor;
for ( wint_t c = url_fgetwc( stream ); !url_feof( stream ) && c != 0; for ( wint_t c = url_fgetwc( stream ); !url_feof( stream ) && c != 0;
c = url_fgetwc( stream ) ) { c = url_fgetwc( stream ) ) {
debug_print( L"slurp: cursor is: ", DEBUG_IO, 0 ); debug_print( L"slurp: cursor is: ", DEBUG_IO, 0);
debug_dump_object( cursor, DEBUG_IO, 0 ); debug_dump_object( cursor, DEBUG_IO, 0 );
debug_print( L"; result is: ", DEBUG_IO, 0 ); debug_print( L"; result is: ", DEBUG_IO, 0 );
debug_dump_object( result, DEBUG_IO, 0 ); debug_dump_object( result, DEBUG_IO, 0 );

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

@ -8,8 +8,8 @@
* 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.
*/ */
#ifndef __psse_io_io_h #ifndef __psse_io_h
#define __psse_io_io_h #define __psse_io_h
#include <curl/curl.h> #include <curl/curl.h>
#include "memory/pointer.h" #include "memory/pointer.h"
@ -32,19 +32,22 @@ wint_t url_ungetwc( wint_t wc, URL_FILE * input );
struct pso_pointer get_character( struct pso_pointer read_stream ); struct pso_pointer get_character( struct pso_pointer read_stream );
struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r);
struct pso_pointer r );
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ); struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env );
struct pso_pointer struct pso_pointer
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ); lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ); lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ); lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env ); lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
char *lisp_string_to_c_string( struct pso_pointer s ); char *lisp_string_to_c_string( struct pso_pointer s );
#endif #endif

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

@ -36,29 +36,28 @@
#include "payloads/cons.h" #include "payloads/cons.h"
#include "payloads/integer.h" #include "payloads/integer.h"
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output ); struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output);
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) { struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE * output) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( consp( p ) ) { if (consp(p)) {
for ( ; consp( p ); p = cdr( p ) ) { for (; consp( p); p = cdr(p)) {
struct pso2 *object = pointer_to_object( p ); struct pso2* object = pointer_to_object(p);
result = in_print( object->payload.cons.car, output ); result = in_print( object->payload.cons.car, output);
if ( exceptionp( result ) ) if (exceptionp(result)) break;
switch (get_tag_value(object->payload.cons.cdr)) {
case NILTV :
break; break;
case CONSTV :
switch ( get_tag_value( object->payload.cons.cdr ) ) {
case NILTV:
break;
case CONSTV:
url_fputwc( L' ', output ); url_fputwc( L' ', output );
break; break;
default: default :
url_fputws( L" . ", output ); url_fputws( L" . ", output);
result = in_print( object->payload.cons.cdr, output ); result = in_print( object->payload.cons.cdr, output);
} }
} }
@ -69,30 +68,29 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
return result; return result;
} }
struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) { struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output) {
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) {
switch ( get_tag_value( p ) ) { switch (get_tag_value( p)) {
case CHARACTERTV: case CHARACTERTV :
url_fputwc( object->payload.character.character, output ); url_fputwc( object->payload.character.character, output);
break; break;
case CONSTV: case CONSTV :
url_fputwc( L'(', output ); url_fputwc( L'(', output );
result = print_list_content( p, output ); result = print_list_content( p, output);
url_fputwc( L')', output ); url_fputwc( L')', output );
break; break;
case INTEGERTV: case INTEGERTV :
url_fwprintf( output, L"%d", url_fwprintf( output, L"%d", (int64_t)(object->payload.integer.value));
( int64_t ) ( object->payload.integer.value ) );
break; break;
case TRUETV: case TRUETV :
url_fputwc( L't', output ); url_fputwc( L't', output );
break; break;
case NILTV: case NILTV :
url_fputws( L"nil", output ); url_fputws( L"nil", output );
default: default :
// TODO: return exception // TODO: return exception
} }
} else { } else {
@ -109,20 +107,16 @@ 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 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);
if ( writep( stream ) ) { if ( writep( stream)) { inc_ref( stream); }
inc_ref( stream );
}
struct pso_pointer result = in_print( p, output ); struct pso_pointer result = in_print(p, output);
if ( writep( stream ) ) { if ( writep( stream)) { dec_ref( stream); }
dec_ref( stream );
}
return result; return result;
} }

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

@ -14,6 +14,6 @@
#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 print( struct pso_pointer p, struct pso_pointer stream);
#endif #endif

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

@ -28,7 +28,6 @@
#include "io/read.h" #include "io/read.h"
#include "memory/node.h" #include "memory/node.h"
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/tags.h" #include "memory/tags.h"
@ -73,11 +72,11 @@
* 2. The character most recently read from that stream. * 2. The character most recently read from that stream.
*/ */
struct pso_pointer read_example( struct pso_pointer frame_pointer, struct pso_pointer read_example( struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg( frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg( frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg( frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
return result; return result;
@ -94,59 +93,61 @@ struct pso_pointer read_example( struct pso_pointer frame_pointer,
* 2. The character most recently read from that stream. * 2. The character most recently read from that stream.
*/ */
struct pso_pointer read_number( struct pso_pointer frame_pointer, struct pso_pointer read_number( struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg( frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg( frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg( frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
int base = 10; int base = 10;
// TODO: should check for *read-base* in the environment // TODO: should check for *read-base* in the environment
int64_t value = 0; int64_t value = 0;
if ( readp( stream ) ) { if (readp(stream)) {
if ( nilp( character ) ) { if (nilp( character)) {
character = get_character( stream ); character = get_character( stream);
} }
wchar_t c = nilp( character ) ? 0 : wchar_t c = nilp(character) ? 0 :
pointer_to_object( character )->payload.character.character; pointer_to_object( character)->payload.character.character;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
for ( ; iswdigit( c ); c = url_fgetwc( input ) ) { for ( ; iswdigit( c );
value = ( value * base ) + ( ( int ) c - ( int ) L'0' ); c = url_fgetwc( input ) ){
value = (value * base) + ((int)c - (int)L'0');
} }
url_ungetwc( c, input ); url_ungetwc( c, input);
result = make_integer( value ); result = make_integer( value);
} // else exception? } // else exception?
return result; return result;
} }
struct pso_pointer read_symbol( struct pso_pointer frame_pointer, struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg( frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg( frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg( frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( readp( stream ) ) { if (readp(stream)) {
if ( nilp( character ) ) { if (nilp( character)) {
character = get_character( stream ); character = get_character( stream);
} }
wchar_t c = nilp( character ) ? 0 : wchar_t c = nilp(character) ? 0 :
pointer_to_object( character )->payload.character.character; pointer_to_object( character)->payload.character.character;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
for ( ; iswalnum( c ); c = url_fgetwc( input ) ) { for ( ; iswalnum( c );
result = make_string_like_thing( c, result, SYMBOLTAG ); c = url_fgetwc( input ) ){
result = make_string_like_thing(c, result, SYMBOLTAG);
} }
url_ungetwc( c, input ); url_ungetwc( c, input);
result = reverse( result ); result = reverse( result);
} }
return result; return result;
@ -165,34 +166,33 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
*/ */
struct pso_pointer read( struct pso_pointer frame_pointer, struct pso_pointer read( struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg( frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg( frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg( frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( nilp( stream ) ) { if (nilp(stream)) {
stream = make_read_stream( file_to_url_file( stdin ), nil ); stream = make_read_stream( file_to_url_file(stdin), nil);
} }
if ( nilp( readtable ) ) { if (nilp( readtable)) {
// TODO: check for the value of `*read-table*` in the environment and // TODO: check for the value of `*read-table*` in the environment and
// use that. // use that.
} }
if ( nilp( character ) ) { if (nilp( character)) {
character = get_character( stream ); character = get_character( stream);
} }
struct pso_pointer readmacro = assoc( character, readtable ); struct pso_pointer readmacro = assoc(character, readtable);
if ( !nilp( readmacro ) ) { if (!nilp( readmacro)) {
// invoke the read macro on the stream // invoke the read macro on the stream
} else if ( readp( stream ) && characterp( character ) ) { } else if (readp( stream) && characterp(character)) {
wchar_t c = wchar_t c = pointer_to_object( character)->payload.character.character;
pointer_to_object( character )->payload.character.character; URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
switch ( c ) { switch ( c ) {
case ';': case ';':
@ -207,12 +207,10 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// frame_pointer ); // frame_pointer );
break; break;
default: default:
struct pso_pointer next = struct pso_pointer next = make_frame( frame_pointer, stream, readtable, make_character(c));
make_frame( frame_pointer, stream, readtable,
make_character( c ) );
inc_ref( next );
if ( iswdigit( c ) ) { if ( iswdigit( c ) ) {
result = read_number( next, env ); result =
read_number( next, env );
} else if ( iswalpha( c ) ) { } else if ( iswalpha( c ) ) {
result = read_symbol( next, env ); result = read_symbol( next, env );
} else { } else {
@ -223,7 +221,6 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// make_string( c, NIL ) ), // make_string( c, NIL ) ),
// frame_pointer ); // frame_pointer );
} }
dec_ref( next );
break; break;
} }
} }

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

@ -1,25 +0,0 @@
/**
* read.h
*
* Read basic Lisp objects..This is :bootstrap layer print; it needs to be
* able to read characters, symbols, integers, lists and dotted pairs. I
* don't think it needs to be able to read anything else. It must, however,
* take a readtable as argument and expand reader macros.
*
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_io_read_h
#define __psse_io_read_h
struct pso_pointer read_number( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer read( struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif

29
src/c/memory/destroy.c
View file

@ -37,29 +37,22 @@
* failure. This function returns that exception pointer. How we * failure. This function returns that exception pointer. How we
* handle that exception pointer I simply don't know yet. * handle that exception pointer I simply don't know yet.
*/ */
struct pso_pointer destroy( struct pso_pointer p ) { struct pso_pointer destroy( struct pso_pointer p) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso_pointer f = make_frame( nil, p ); struct pso_pointer f = make_frame( nil, p);
inc_ref( f ); inc_ref( f);
switch ( get_tag_value( p ) ) { switch (get_tag_value(p)) {
case CONSTV: case CONSTV: destroy_cons(f, nil); break;
destroy_cons( f, nil ); case EXCEPTIONTV: destroy_exception(f, nil); break;
break; case KEYTV :
case EXCEPTIONTV:
destroy_exception( f, nil );
break;
case KEYTV:
case STRINGTV: case STRINGTV:
case SYMBOLTV: case SYMBOLTV: destroy_string(f, nil); break;
destroy_string( f, nil ); case STACKTV: destroy_stack_frame(f, nil); break;
break;
case STACKTV:
destroy_stack_frame( f, nil );
break;
// TODO: others. // TODO: others.
} }
dec_ref( f ); dec_ref(f);
return result; return result;
} }

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

@ -12,6 +12,6 @@
#include "memory/pointer.h" #include "memory/pointer.h"
struct pso_pointer destroy( struct pso_pointer p ); struct pso_pointer destroy( struct pso_pointer p);
#endif #endif

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

@ -57,7 +57,7 @@ struct pso_pointer initialise_node( uint32_t index ) {
struct pso_pointer result = initialise_memory( index ); struct pso_pointer result = initialise_memory( index );
if ( c_eq( result, t ) ) { if ( eq( result, t ) ) {
result = initialise_environment( index ); result = initialise_environment( index );
} }

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

@ -34,3 +34,4 @@ extern struct pso_pointer t;
struct pso_pointer initialise_node( uint32_t index ); struct pso_pointer initialise_node( uint32_t index );
#endif #endif

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

@ -125,10 +125,10 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
L"Initialised page %d; freelist for size class %x updated.\n", L"Initialised page %d; freelist for size class %x updated.\n",
npages_allocated, size_class ); npages_allocated, size_class );
if ( npages_allocated == 0 ) { if (npages_allocated == 0) {
// first page allocated; initialise nil and t // first page allocated; initialise nil and t
nil = lock_object( allocate( NILTAG, 2 ) ); nil = lock_object( allocate(NILTAG, 2));
t = lock_object( allocate( TRUETAG, 2 ) ); t = lock_object( allocate(TRUETAG, 2));
} }
npages_allocated++; npages_allocated++;
@ -164,6 +164,6 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
* @brief allow other files to see the current value of npages_allocated, but not * @brief allow other files to see the current value of npages_allocated, but not
* change it. * change it.
*/ */
uint32_t get_pages_allocated( ) { uint32_t get_pages_allocated() {
return npages_allocated; return npages_allocated;
} }

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

@ -74,6 +74,6 @@ union page {
struct pso_pointer allocate_page( uint8_t size_class ); struct pso_pointer allocate_page( uint8_t size_class );
uint32_t get_pages_allocated( ); uint32_t get_pages_allocated();
#endif #endif

18
src/c/memory/pointer.c
View file

@ -54,8 +54,7 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
struct pso2 *result = NULL; struct pso2 *result = NULL;
if ( p.node == node_index ) { if ( p.node == node_index ) {
if ( p.page < get_pages_allocated( ) if (p.page < get_pages_allocated() && p.offset < (PAGE_BYTES / 8)) {
&& p.offset < ( PAGE_BYTES / 8 ) ) {
// TODO: that's not really a safe test of whether this is a valid pointer. // TODO: that's not really a safe test of whether this is a valid pointer.
union page *pg = pages[p.page]; union page *pg = pages[p.page];
result = ( struct pso2 * ) &pg->words[p.offset]; result = ( struct pso2 * ) &pg->words[p.offset];
@ -86,11 +85,10 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
* @return the memory address of the object, provided it is a valid object and * @return the memory address of the object, provided it is a valid object and
* of the specified size class, else NULL. * of the specified size class, else NULL.
*/ */
struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p, struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class) {
uint8_t size_class ) { struct pso2 * result = pointer_to_object( p);
struct pso2 *result = pointer_to_object( p );
if ( result->header.tag.bytes.size_class != size_class ) { if (result->header.tag.bytes.size_class != size_class) {
result = NULL; result = NULL;
} }
@ -105,13 +103,13 @@ struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
* exception back from this function. Consequently, if anything goes wrong * exception back from this function. Consequently, if anything goes wrong
* we return NULL. The caller *should* check for that and throw an exception. * we return NULL. The caller *should* check for that and throw an exception.
*/ */
struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p, struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value) {
uint32_t tag_value ) { struct pso2 * result = pointer_to_object( p);
struct pso2 *result = pointer_to_object( p );
if ( ( result->header.tag.value & 0xffffff ) != tag_value ) { if ((result->header.tag.value & 0xffffff) != tag_value) {
result = NULL; result = NULL;
} }
return result; return result;
} }

11
src/c/memory/pointer.h
View file

@ -39,15 +39,12 @@ struct pso_pointer {
}; };
struct pso_pointer make_pointer( uint32_t node, uint16_t page, struct pso_pointer make_pointer( uint32_t node, uint16_t page, uint16_t offset);
uint16_t offset );
struct pso2 *pointer_to_object( struct pso_pointer pointer ); struct pso2* pointer_to_object( struct pso_pointer pointer);
struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p, struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class);
uint8_t size_class );
struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p, struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value);
uint32_t tag_value );
#endif #endif

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

@ -169,7 +169,7 @@ struct pso_pointer free_object( struct pso_pointer p ) {
uint32_t array_size = payload_size( obj ); uint32_t array_size = payload_size( obj );
uint8_t size_class = obj->header.tag.bytes.size_class; uint8_t size_class = obj->header.tag.bytes.size_class;
result = destroy( p ); result = destroy( p);
/* will C just let me cheerfully walk off the end of the array I've declared? */ /* will C just let me cheerfully walk off the end of the array I've declared? */
for ( int i = 0; i < array_size; i++ ) { for ( int i = 0; i < array_size; i++ ) {
@ -181,9 +181,8 @@ struct pso_pointer free_object( struct pso_pointer p ) {
strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG, strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
TAGLENGTH ); TAGLENGTH );
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, debug_printf( DEBUG_ALLOC, 0, L"Freeing object of size class %d at {%d, %d, %d}",
L"Freeing object of size class %d at {%d, %d, %d}", size_class, p.node, p.page, p.offset);
size_class, p.node, p.page, p.offset );
#endif #endif
/* TODO: obtain mutex on freelist */ /* TODO: obtain mutex on freelist */

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

@ -15,13 +15,13 @@
#include "memory/header.h" #include "memory/header.h"
#include "memory/pointer.h" #include "memory/pointer.h"
struct pso_pointer allocate( char *tag, uint8_t size_class ); struct pso_pointer allocate( char* tag, uint8_t size_class);
struct pso_pointer dec_ref( struct pso_pointer pointer ); struct pso_pointer dec_ref( struct pso_pointer pointer );
struct pso_pointer inc_ref( struct pso_pointer pointer ); struct pso_pointer inc_ref( struct pso_pointer pointer );
struct pso_pointer lock_object( struct pso_pointer pointer ); struct pso_pointer lock_object( struct pso_pointer pointer);
struct pso_pointer free_object( struct pso_pointer p ); struct pso_pointer free_object( struct pso_pointer p );

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

@ -12,7 +12,6 @@
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso4.h" #include "memory/pso4.h"
struct pso4 *pointer_to_pso4( struct pso_pointer p ) { struct pso4* pointer_to_pso4( struct pso_pointer p) {
struct pso4 *result = struct pso4* result = (struct pso4*)pointer_to_object_of_size_class( p, 4);
( struct pso4 * ) pointer_to_object_of_size_class( p, 4 );
} }

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

@ -31,6 +31,6 @@ struct pso4 {
} payload; } payload;
}; };
struct pso4 *pointer_to_pso4( struct pso_pointer p ); struct pso4* pointer_to_pso4( struct pso_pointer p);
#endif #endif

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

@ -16,8 +16,8 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso2.h" #include "memory/pso2.h"
uint32_t get_tag_value( struct pso_pointer p ) { uint32_t get_tag_value (struct pso_pointer p) {
struct pso2 *object = pointer_to_object( p ); struct pso2* object = pointer_to_object( p);
return object->header.tag.value & 0xffffff; return object->header.tag.value & 0xffffff;
} }
@ -31,8 +31,8 @@ uint32_t get_tag_value( struct pso_pointer p ) {
* *
* @return true if the tag at p matches v, else false. * @return true if the tag at p matches v, else false.
*/ */
bool check_tag( struct pso_pointer p, uint32_t v ) { bool check_tag( struct pso_pointer p, uint32_t v) {
return get_tag_value( p ) == v; return get_tag_value(p) == v;
} }
/** /**
@ -46,9 +46,8 @@ bool check_tag( struct pso_pointer p, uint32_t v ) {
* of the object. * of the object.
* @return false otherwise. * @return false otherwise.
*/ */
bool check_type( struct pso_pointer p, char *s ) { bool check_type( struct pso_pointer p, char* s) {
return ( strncmp return (strncmp(
( &( pointer_to_object( p )->header.tag.bytes.mnemonic[0] ), s, &(pointer_to_object(p)->header.tag.bytes.mnemonic[0]), s, TAGLENGTH)
TAGLENGTH ) == 0);
== 0 );
} }

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

@ -82,7 +82,7 @@
* @return the numerical value of the tag, as a uint32_t. * @return the numerical value of the tag, as a uint32_t.
*/ */
// #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);
/** /**
* @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
@ -94,9 +94,9 @@ uint32_t get_tag_value( struct pso_pointer p );
* @return true if the tag at p matches v, else false. * @return true if the tag at p matches v, else false.
*/ */
// #define check_tag(p,v) (get_tag_value(p) == v) // #define check_tag(p,v) (get_tag_value(p) == v)
bool check_tag( struct pso_pointer p, uint32_t v ); bool check_tag( struct pso_pointer p, uint32_t v);
bool check_type( struct pso_pointer p, char *s ); bool check_type( struct pso_pointer p, char* s);
#define characterp(p) (check_tag(p, CHARACTERTV)) #define characterp(p) (check_tag(p, CHARACTERTV))
#define consp(p) (check_tag(p, CONSTV)) #define consp(p) (check_tag(p, CONSTV))

26
src/c/ops/assoc.c
View file

@ -34,18 +34,20 @@
* return the binding. * return the binding.
*/ */
struct pso_pointer search( struct pso_pointer key, struct pso_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key ) { struct pso_pointer store,
bool return_key ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
bool found = false; bool found = false;
if ( consp( store ) ) { if (consp( store)) {
for ( struct pso_pointer cursor = store; for ( struct pso_pointer cursor = store;
consp( store ) && found == false; cursor = cdr( cursor ) ) { consp( store) && found == false;
struct pso_pointer pair = car( cursor ); cursor = cdr( cursor)) {
struct pso_pointer pair = car( cursor);
if ( consp( pair ) && c_equal( car( pair ), key ) ) { if (consp(pair) && equal(car(pair), key)) {
found = true; found = true;
result = return_key ? car( pair ) : cdr( pair ); result = return_key ? car(pair) : cdr( pair);
} }
} }
} }
@ -61,8 +63,8 @@ struct pso_pointer search( struct pso_pointer key,
* *
* @return a pointer to the value of the key in the store, or nil if not found * @return a pointer to the value of the key in the store, or nil if not found
*/ */
struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ) { struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store) {
return search( key, store, false ); return search( key, store, false);
} }
/** /**
@ -73,8 +75,8 @@ struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ) {
* *
* @return a pointer to the copy of the key in the store, or nil if not found. * @return a pointer to the copy of the key in the store, or nil if not found.
*/ */
struct pso_pointer interned( struct pso_pointer key, struct pso_pointer store ) { struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store) {
return search( key, store, true ); return search( key, store, true);
} }
/** /**
@ -85,6 +87,6 @@ struct pso_pointer interned( struct pso_pointer key, struct pso_pointer store )
* *
* @return `true` if a pointer the key was found in the store.. * @return `true` if a pointer the key was found in the store..
*/ */
bool internedp( struct pso_pointer key, struct pso_pointer store ) { bool internedp(struct pso_pointer key, struct pso_pointer store) {
return !nilp( search( key, store, true ) ); return !nilp( search( key, store, true));
} }

10
src/c/ops/assoc.h
View file

@ -17,12 +17,12 @@
#include "memory/pointer.h" #include "memory/pointer.h"
struct cons_pointer search( struct pso_pointer key, struct cons_pointer search( struct pso_pointer key,
struct pso_pointer store, bool return_key ); struct pso_pointer store,
bool return_key );
struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ); struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store);
struct pso_pointer interned( struct pso_pointer key, struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store);
struct pso_pointer store );
bool internedp( struct pso_pointer key, struct pso_pointer store ); bool internedp(struct pso_pointer key, struct pso_pointer store);
#endif #endif

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

@ -1,44 +0,0 @@
/**
* ops/bind.c
*
* Post Scarcity Software Environment: bind.
*
* Add a binding for a key/value pair to a store -- at this stage, just an
* association list.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "ops/stack_ops.h"
#include "payloads/cons.h"
#include "payloads/stack.h"
struct pso_pointer bind( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer key = fetch_arg( frame, 0 );
struct pso_pointer value = fetch_arg( frame, 1 );
struct pso_pointer store = fetch_arg( frame, 2 );
return cons( cons( key, value ), store );
}
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store ) {
struct pso_pointer result = nil;
struct pso_pointer next = make_frame( nil, key, value, store );
inc_ref( next );
result = bind( next, nil );
dec_ref( next );
return result;
}

25
src/c/ops/bind.h
View file

@ -1,25 +0,0 @@
/**
* ops/bind.h
*
* Post Scarcity Software Environment: bind.
*
* Test for pointer binduality.
*
* (c) 2026 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_ops_bind_h
#define __psse_ops_bind_h
#include <stdbool.h>
#include "memory/pointer.h"
struct pso_pointer bind( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store );
#endif

57
src/c/ops/eq.c
View file

@ -33,44 +33,42 @@
* @param b another pointer; * @param b another pointer;
* @return `true` if they are the same, else `false` * @return `true` if they are the same, else `false`
*/ */
bool c_eq( struct pso_pointer a, struct pso_pointer b ) { bool eq( struct pso_pointer a, struct pso_pointer b ) {
return ( a.node == b.node && a.page == b.page && a.offset == b.offset ); return ( a.node == b.node && a.page == b.page && a.offset == b.offset );
} }
bool c_equal( struct pso_pointer a, struct pso_pointer b ) { bool equal( struct pso_pointer a, struct pso_pointer b) {
bool result = false; bool result = false;
if ( c_eq( a, b ) ) { if ( eq( a, b)) {
result = true; result = true;
} else if ( get_tag_value( a ) == get_tag_value( b ) ) { } else if ( get_tag_value(a) == get_tag_value(b)) {
struct pso2 *oa = pointer_to_object( a ); struct pso2 *oa = pointer_to_object(a);
struct pso2 *ob = pointer_to_object( b ); struct pso2 *ob = pointer_to_object(b);
switch ( get_tag_value( a ) ) { switch ( get_tag_value(a)) {
case CHARACTERTV: case CHARACTERTV :
result = result = (oa->payload.character.character == ob->payload.character.character);
( oa->payload.character.character ==
ob->payload.character.character );
break; break;
case CONSTV: case CONSTV :
result = ( c_equal( car( a ), car( b ) ) result = (equal( car(a), car(b)) && equal( cdr(a), cdr(b)));
&& c_equal( cdr( a ), cdr( b ) ) );
break; break;
case INTEGERTV: case INTEGERTV :
result = ( oa->payload.integer.value result = (oa->payload.integer.value
== ob->payload.integer.value ); ==
ob->payload.integer.value);
break; break;
case KEYTV: case KEYTV:
case STRINGTV: case STRINGTV :
case SYMBOLTV: case SYMBOLTV :
while ( result == false && !nilp( a ) && !nilp( b ) ) { while (result == false && !nilp(a) && !nilp(b)) {
if ( pointer_to_object( a )->payload.string.character == if (pointer_to_object(a)->payload.string.character ==
pointer_to_object( b )->payload.string.character ) { pointer_to_object(b)->payload.string.character) {
a = cdr( a ); a = cdr(a);
b = cdr( b ); b = cdr(b);
} }
} }
result = nilp( a ) && nilp( b ); result = nilp(a) && nilp(b);
break; break;
} }
} }
@ -91,10 +89,9 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
* @param env my environment (ignored). * @param env my environment (ignored).
* @return `t` if all args are pointers to the same object, else `nil`; * @return `t` if all args are pointers to the same object, else `nil`;
*/ */
struct pso_pointer eq( struct pso_pointer frame_pointer, struct pso_pointer lisp_eq( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = t; struct pso_pointer result = t;
if ( frame->payload.stack_frame.args > 1 ) { if ( frame->payload.stack_frame.args > 1 ) {
@ -102,9 +99,11 @@ struct pso_pointer eq( struct pso_pointer frame_pointer,
( truep( result ) ) && ( b < frame->payload.stack_frame.args ); ( truep( result ) ) && ( b < frame->payload.stack_frame.args );
b++ ) { b++ ) {
result = result =
c_eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil; eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
} }
} }
return result; return result;
} }

7
src/c/ops/eq.h
View file

@ -16,10 +16,11 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso4.h" #include "memory/pso4.h"
bool c_eq( struct pso_pointer a, struct pso_pointer b ); bool eq( struct pso_pointer a, struct pso_pointer b );
struct pso_pointer eq( struct pso_pointer frame_pointer, struct pso_pointer lisp_eq( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ); struct pso_pointer env );
bool c_equal( struct pso_pointer a, struct pso_pointer b ); bool equal( struct pso_pointer a, struct pso_pointer b);
#endif #endif

28
src/c/ops/eval.c
View file

@ -10,9 +10,7 @@
*/ */
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso3.h"
#include "memory/pso4.h" #include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
@ -25,8 +23,6 @@
#include "payloads/special.h" #include "payloads/special.h"
#include "payloads/stack.h" #include "payloads/stack.h"
#include "ops/truth.h"
/** /**
* @brief Despatch eval based on tag of the form in the first position. * @brief Despatch eval based on tag of the form in the first position.
* *
@ -35,9 +31,9 @@
* @param env the evaluation environment. * @param env the evaluation environment.
* @return struct pso_pointer * @return struct pso_pointer
*/ */
struct pso_pointer lisp_eval( struct pso_pointer frame_pointer, struct pso_pointer eval_despatch( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = frame->payload.stack_frame.arg[0]; struct pso_pointer result = frame->payload.stack_frame.arg[0];
// switch ( get_tag_value( result)) { // switch ( get_tag_value( result)) {
@ -59,17 +55,17 @@ struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
// break; // break;
// } // }
if ( exceptionp( result ) ) { return result;
struct pso3 *x = }
( struct pso3 * ) pointer_to_object_with_tag_value( result,
EXCEPTIONTV );
if ( nilp( x->payload.exception.stack ) ) { struct pso_pointer lisp_eval( struct pso4 *frame,
inc_ref( result ); struct pso_pointer frame_pointer,
result = struct pso_pointer env ) {
make_exception( x->payload.exception.message, frame_pointer, struct pso_pointer result = eval_despatch( frame, frame_pointer, env );
result );
} if ( exceptionp( result ) ) {
// todo: if result doesn't have a stack frame, create a new exception wrapping
// result with this stack frame.
} }
return result; return result;

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

@ -35,41 +35,31 @@
* @return a sequence like the `sequence` passed, but reversed; or `nil` if * @return a sequence like the `sequence` passed, but reversed; or `nil` if
* the argument was not a sequence. * the argument was not a sequence.
*/ */
struct pso_pointer reverse( struct pso_pointer sequence ) { struct pso_pointer reverse( struct pso_pointer sequence) {
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); cursor = cdr(cursor)) {
cursor = cdr( cursor ) ) { struct pso2* object = pointer_to_object( cursor);
struct pso2 *object = pointer_to_object( cursor ); switch (get_tag_value(cursor)) {
switch ( get_tag_value( cursor ) ) { case CONSTV :
case CONSTV: result = cons( car(cursor), result);
result = cons( car( cursor ), result );
break; break;
case KEYTV: case KEYTV :
result = result = make_string_like_thing( object->payload.string.character, result, KEYTAG);
make_string_like_thing( object->payload.string.character,
result, KEYTAG );
break; break;
case STRINGTV: case STRINGTV :
result = result = make_string_like_thing( object->payload.string.character, result, STRINGTAG);
make_string_like_thing( object->payload.string.character,
result, STRINGTAG );
break; break;
case SYMBOLTV: case SYMBOLTV :
result = result = make_string_like_thing( object->payload.string.character, result, SYMBOLTAG);
make_string_like_thing( object->payload.string.character,
result, SYMBOLTAG );
break; break;
default: default :
result = result = make_exception( c_string_to_lisp_string(L"Invalid object in sequence"), nil, nil);
make_exception( c_string_to_lisp_string
( L"Invalid object in sequence" ), nil,
nil );
goto exit; goto exit;
break; break;
} }
} }
exit: exit:
return result; return result;
} }

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

@ -16,6 +16,6 @@
#include "memory/pointer.h" #include "memory/pointer.h"
struct pso_pointer reverse( struct pso_pointer sequence ); struct pso_pointer reverse( struct pso_pointer sequence);
#endif #endif

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

@ -42,7 +42,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
struct pso2 *cell = pointer_to_object( ptr ); struct pso2 *cell = pointer_to_object( ptr );
uint32_t result = 0; uint32_t result = 0;
switch ( get_tag_value( ptr ) ) { switch ( get_tag_value(ptr)) {
case KEYTV: case KEYTV:
case STRINGTV: case STRINGTV:
case SYMBOLTV: case SYMBOLTV:
@ -70,17 +70,17 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
* (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( wint_t c, struct pso_pointer tail,
char *tag ) { char* tag ) {
struct pso_pointer pointer = nil; struct pso_pointer pointer = nil;
if ( check_type( tail, tag ) || check_tag( tail, NILTV ) ) { if ( check_type( tail, tag ) || check_tag( tail, NILTV ) ) {
pointer = allocate( tag, CONS_SIZE_CLASS ); pointer = allocate( 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;
cell->payload.string.cdr = tail; cell->payload.string.cdr = tail;
cell->payload.string.hash = calculate_hash( c, tail ); cell->payload.string.hash = calculate_hash( c, tail);
debug_dump_object( pointer, DEBUG_ALLOC, 0 ); debug_dump_object( pointer, DEBUG_ALLOC, 0 );
debug_println( DEBUG_ALLOC ); debug_println( DEBUG_ALLOC );
} else { } else {

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

@ -17,7 +17,7 @@
#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( 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( wint_t c, struct pso_pointer tail );

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

@ -13,7 +13,6 @@
#include "memory/node.h" #include "memory/node.h"
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso4.h"
#include "ops/stack_ops.h" #include "ops/stack_ops.h"
/** /**
@ -65,11 +64,10 @@ bool truep( struct pso_pointer p ) {
* @param env the evaluation environment. * @param env the evaluation environment.
* @return `t` if the first argument in this frame is `nil`, else `t` * @return `t` if the first argument in this frame is `nil`, else `t`
*/ */
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer, struct pso_pointer lisp_nilp( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); return ( nilp( fetch_arg( frame, 0 )) ? t : nil );
return ( nilp( fetch_arg( frame, 0 ) ) ? t : nil );
} }
/** /**
@ -80,10 +78,9 @@ struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
* @param env the evaluation environment. * @param env the evaluation environment.
* @return `t` if the first argument in this frame is `t`, else `nil`. * @return `t` if the first argument in this frame is `t`, else `nil`.
*/ */
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer, struct pso_pointer lisp_truep( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( truep( fetch_arg( frame, 0 ) ) ? t : nil ); return ( truep( fetch_arg( frame, 0 ) ) ? t : nil );
} }
@ -96,9 +93,8 @@ struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
* @param env the evaluation environment. * @param env the evaluation environment.
* @return `t` if the first argument in this frame is not `nil`, else `t`. * @return `t` if the first argument in this frame is not `nil`, else `t`.
*/ */
struct pso_pointer lisp_not( struct pso_pointer frame_pointer, struct pso_pointer lisp_not( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ) { struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return ( not( fetch_arg( frame, 0 ) ) ? t : nil ); return ( not( fetch_arg( frame, 0 ) ) ? t : nil );
} }

9
src/c/ops/truth.h
View file

@ -18,17 +18,20 @@
bool nilp( struct pso_pointer p ); bool nilp( struct pso_pointer p );
struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer, struct pso_pointer lisp_nilp( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ); struct pso_pointer env );
bool not( struct pso_pointer p ); bool not( struct pso_pointer p );
struct pso_pointer lisp_not( struct pso_pointer frame_pointer, struct pso_pointer lisp_not( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ); struct pso_pointer env );
bool truep( struct pso_pointer p ); bool truep( struct pso_pointer p );
struct pso_pointer lisp_truep( struct pso_pointer frame_pointer, struct pso_pointer lisp_truep( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer env ); struct pso_pointer env );
#endif #endif

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

@ -23,12 +23,11 @@
#include "payloads/character.h" #include "payloads/character.h"
struct pso_pointer make_character( wint_t c ) { struct pso_pointer make_character( wint_t c) {
struct pso_pointer result = allocate( CHARACTERTAG, 2 ); struct pso_pointer result = allocate( CHARACTERTAG, 2 );
if ( !nilp( result ) ) { if (!nilp(result)) {
pointer_to_object( result )->payload.character.character = pointer_to_object(result)->payload.character.character = (wchar_t) c;
( wchar_t ) c;
} }
return result; return result;

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

@ -36,5 +36,5 @@ struct character_payload {
wchar_t character; wchar_t character;
}; };
struct pso_pointer make_character( wint_t c ); struct pso_pointer make_character( wint_t c);
#endif #endif

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

@ -33,8 +33,11 @@ struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ) {
struct pso_pointer result = allocate( CONSTAG, 2 ); struct pso_pointer result = allocate( 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 = car;
object->payload.cons.cdr = inc_ref( cdr ); object->payload.cons.cdr = cdr;
inc_ref( car );
inc_ref( cdr );
return result; return result;
} }
@ -70,20 +73,16 @@ struct pso_pointer cdr( struct pso_pointer p ) {
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso2 *object = pointer_to_object( result ); struct pso2 *object = pointer_to_object( result );
switch ( get_tag_value( p ) ) { switch (get_tag_value( p)) {
case CONSTV: case CONSTV : result = object->payload.cons.cdr; break;
result = object->payload.cons.cdr; case KEYTV :
break; case STRINGTV :
case KEYTV: case SYMBOLTV :
case STRINGTV: result = object->payload.string.cdr; break;
case SYMBOLTV: default :
result = object->payload.string.cdr; result = make_exception(
break; cons(c_string_to_lisp_string(L"Invalid type for cdr"), p),
default: nil, nil);
result =
make_exception( cons
( c_string_to_lisp_string
( L"Invalid type for cdr" ), p ), nil, nil );
break; break;
} }
@ -99,12 +98,11 @@ struct pso_pointer cdr( struct pso_pointer p ) {
* Lisp calling conventions; one expected arg, the pointer to the cell to * Lisp calling conventions; one expected arg, the pointer to the cell to
* be destroyed. * be destroyed.
*/ */
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 ) { 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];
dec_ref( car( p ) ); dec_ref( car( p));
dec_ref( cdr( p ) ); dec_ref( cdr( p));
} }
} }

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

@ -32,7 +32,6 @@ struct pso_pointer cdr( struct pso_pointer cons );
struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ); struct pso_pointer cons( 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 );
#endif #endif

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

@ -17,8 +17,7 @@
#include "payloads/exception.h" #include "payloads/exception.h"
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 cause) {
struct pso_pointer cause ) {
// TODO: not yet implemented // TODO: not yet implemented
return nil; return nil;
} }
@ -30,9 +29,9 @@ struct pso_pointer make_exception( struct pso_pointer message,
* be destroyed. * be destroyed.
*/ */
struct pso_pointer destroy_exception( struct pso_pointer fp, struct pso_pointer destroy_exception( struct pso_pointer fp,
struct pso_pointer env ) { struct pso_pointer env) {
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];
// TODO: decrement every pointer indicated by an exception. // TODO: decrement every pointer indicated by an exception.

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

@ -25,10 +25,9 @@ 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 cause);
struct pso_pointer cause );
struct pso_pointer destroy_exception( struct pso_pointer fp, struct pso_pointer destroy_exception( struct pso_pointer fp,
struct pso_pointer env ); struct pso_pointer env);
#endif #endif

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

@ -26,13 +26,13 @@
*/ */
struct pso_pointer make_integer( int64_t value ) { struct pso_pointer make_integer( 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( 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;
debug_print( L"make_integer: returning\n", DEBUG_ALLOC, 0 ); debug_print( L"make_integer: returning\n", DEBUG_ALLOC , 0);
debug_dump_object( result, DEBUG_ALLOC, 0 ); debug_dump_object( result, DEBUG_ALLOC, 0 );
return result; return result;

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

@ -33,12 +33,12 @@
* be destroyed. * be destroyed.
*/ */
struct pso_pointer destroy_string( struct pso_pointer fp, struct pso_pointer destroy_string( struct pso_pointer fp,
struct pso_pointer env ) { struct pso_pointer env) {
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];
dec_ref( cdr( p ) ); dec_ref( cdr(p));
} }
return nil; return nil;

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

@ -36,6 +36,6 @@ struct string_payload {
struct pso_pointer make_string( wint_t c, struct pso_pointer tail ); struct pso_pointer make_string( wint_t c, struct pso_pointer tail );
struct pso_pointer destroy_string( struct pso_pointer fp, struct pso_pointer destroy_string( struct pso_pointer fp,
struct pso_pointer env ); struct pso_pointer env);
#endif #endif

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

@ -26,7 +26,7 @@
*/ */
struct pso_pointer make_read_stream( URL_FILE *input, struct pso_pointer make_read_stream( URL_FILE *input,
struct pso_pointer metadata ) { struct pso_pointer metadata ) {
struct pso_pointer pointer = allocate( READTAG, 2 ); struct pso_pointer pointer = allocate( 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;

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

@ -29,7 +29,7 @@ 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( URL_FILE *input,
struct pso_pointer metadata ); struct pso_pointer metadata );
#endif #endif

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

@ -25,39 +25,39 @@
* *
* @return a pso_pointer to the stack frame. * @return a pso_pointer to the stack frame.
*/ */
struct pso_pointer make_frame( struct pso_pointer previous, ... ) { struct pso_pointer make_frame( struct pso_pointer previous, ...) {
va_list args; va_list args;
va_start( args, previous ); va_start(args, previous);
int count = va_arg( args, int ); int count = va_arg(args, int);
struct pso_pointer frame_pointer = allocate( STACKTAG, 4 ); struct pso_pointer frame_pointer = allocate( STACKTAG, 4);
struct pso4 *frame = ( struct pso4 * ) pointer_to_object( frame_pointer ); struct pso4* frame = (struct pso4*)pointer_to_object( frame_pointer);
frame->payload.stack_frame.previous = previous; frame->payload.stack_frame.previous = previous;
// I *think* the count starts with the number of args, so there are // I *think* the count starts with the number of args, so there are
// one fewer actual args. Need to test to verify this! // one fewer actual args. Need to test to verify this!
count--; count --;
int cursor = 0; int cursor = 0;
frame->payload.stack_frame.args = count; frame->payload.stack_frame.args = count;
for ( ; cursor < count && cursor < args_in_frame; cursor++ ) { for ( ; cursor < count && cursor < args_in_frame; cursor++) {
struct pso_pointer argument = va_arg( args, struct pso_pointer ); struct pso_pointer argument = va_arg( args, struct pso_pointer);
frame->payload.stack_frame.arg[cursor] = inc_ref( argument ); frame->payload.stack_frame.arg[cursor] = inc_ref( argument);
} }
if ( cursor < count ) { if ( cursor < count) {
struct pso_pointer more_args = nil; struct pso_pointer more_args = nil;
for ( ; cursor < count; cursor++ ) { for (; cursor < count; cursor++) {
more_args = cons( va_arg( args, struct pso_pointer ), more_args ); more_args = cons( va_arg( args, struct pso_pointer), more_args);
} }
// should be frame->payload.stack_frame.more = reverse( more_args), but // should be frame->payload.stack_frame.more = reverse( more_args), but
// we don't have reverse yet. TODO: fix. // we don't have reverse yet. TODO: fix.
frame->payload.stack_frame.more = more_args; frame->payload.stack_frame.more = more_args;
} else { } else {
for ( ; cursor < args_in_frame; cursor++ ) { for (; cursor < args_in_frame; cursor++) {
frame->payload.stack_frame.arg[cursor] = nil; frame->payload.stack_frame.arg[cursor] = nil;
} }
} }
@ -72,18 +72,18 @@ struct pso_pointer make_frame( struct pso_pointer previous, ... ) {
* be destroyed. * be destroyed.
*/ */
struct pso_pointer destroy_stack_frame( struct pso_pointer fp, struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env ) { struct pso_pointer env) {
if ( stackp( fp ) ) { if (stackp(fp)) {
struct pso4 *frame = pointer_to_pso4( fp ); struct pso4 *frame = pointer_to_pso4( fp);
struct pso4 *casualty = struct pso4 * casualty =
pointer_to_pso4( frame->payload.stack_frame.arg[0] ); pointer_to_pso4( frame->payload.stack_frame.arg[0]);
dec_ref( casualty->payload.stack_frame.previous ); dec_ref( casualty->payload.stack_frame.previous);
dec_ref( casualty->payload.stack_frame.function ); dec_ref( casualty->payload.stack_frame.function);
dec_ref( casualty->payload.stack_frame.more ); dec_ref( casualty->payload.stack_frame.more);
for ( int i = 0; i < args_in_frame; i++ ) { for (int i = 0; i < args_in_frame; i++) {
dec_ref( casualty->payload.stack_frame.arg[0] ); dec_ref( casualty->payload.stack_frame.arg[0]);
} }
casualty->payload.stack_frame.args = 0; casualty->payload.stack_frame.args = 0;

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

@ -37,9 +37,9 @@ struct stack_frame_payload {
uint32_t depth; uint32_t depth;
}; };
struct pso_pointer make_frame( struct pso_pointer previous, ... ); struct pso_pointer make_frame( struct pso_pointer previous, ...);
struct pso_pointer destroy_stack_frame( struct pso_pointer fp, struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env ); struct pso_pointer env);
#endif #endif

3
src/c/psse.c
View file

@ -101,10 +101,11 @@ int main( int argc, char *argv[] ) {
} }
} }
if ( nilp( initialise_node( 0 ) ) ) { if ( nilp( initialise_node( 0 ))) {
fputs( "Failed to initialise node\n", stderr ); fputs( "Failed to initialise node\n", stderr );
exit( 1 ); exit( 1 );
} }
// repl( ); // repl( );
exit( 0 ); exit( 0 );