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

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

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)

View file

@ -80,7 +80,8 @@ struct pso_pointer print_string_like_thing(struct pso_pointer p,
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 );
} }
@ -115,7 +116,8 @@ struct pso_pointer write_list_content(struct pso_pointer p, URL_FILE *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 { } else {
@ -144,7 +146,8 @@ struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
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,
escape );
break; break;
case CONSTV: case CONSTV:
url_fputwc( L'(', output ); url_fputwc( L'(', output );
@ -214,9 +217,10 @@ struct pso_pointer write(struct pso_pointer p, struct pso_pointer stream,
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;

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"
@ -32,4 +33,5 @@ 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

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,7 +56,8 @@
* @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,
uint8_t size_class ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
#ifdef DEBUG #ifdef DEBUG
@ -64,20 +69,23 @@ struct pso_pointer allocate( /* struct pso4 * stack_pointer,*/ char *tag, uint8_
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 ) {
fputws( L"WARNING: No stack frame passed to `allocate`.\n",
stderr );
}
} else { } else {
// TODO: throw exception // TODO: throw exception
} }

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 );

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 );
} }

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

View file

@ -52,7 +52,9 @@ void c_repl( bool show_prompt ) {
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 );

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 );
} }
} }

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

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 =

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

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,
struct pso_pointer car,
struct pso_pointer cdr ) {
// todo: issue #21: must have stack frame passed in. // todo: issue #21: must have stack frame passed in.
struct pso_pointer result = allocate( CONSTAG, 2 ); 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,7 +70,7 @@ 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 ) );
} }
} }

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 );

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 );

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;

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

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;

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;

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

View file

@ -37,8 +37,9 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
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] );

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;

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