diff --git a/docs/Compiler.md b/docs/Compiler.md index e6c8c3e..2894e4f 100644 --- a/docs/Compiler.md +++ b/docs/Compiler.md @@ -67,7 +67,7 @@ That's the list of things I've found so far that look useful to me. If I find ot ### Tag location -Objects in Lisp have to know that they are. This is what makes it possible to compute with an 'untyped' language: the type is not encoded in the program but in the data. In most conventional Lisp systems, things are typed by having a tag. Back in the day, when we had hardware specially built to run Lisp, Lisp specific hardware often had a word size — and thus registers, and a data bus — wider than the address bus, wider by the number of bits in the tag, and stored the tag on the pointer. +Objects in Lisp have to know what they are. This is what makes it possible to compute with an 'untyped' language: the type is not encoded in the program but in the data. In most conventional Lisp systems, things are typed by having a tag. Back in the day, when we had hardware specially built to run Lisp, Lisp specific hardware often had a word size — and thus registers, and a data bus — wider than the address bus, wider by the number of bits in the tag, and stored the tag on the pointer. Modern Lisps still, I think, mostly store the tag on the pointer, but they run on commodity hardware which doesn't have those extra bits in the word size. That means that the size of an integer, or the precision of a real, that you can store in one word of memory is much less. It also means either that they can address much less memory than other programming languages on the same hardware, because for every bit you steal out of the address bus you halve the amount of memory you can address; or else that they bit shift up every address before they fetch it. diff --git a/docs/State-of-play.md b/docs/State-of-play.md index 45d553d..f6985aa 100644 --- a/docs/State-of-play.md +++ b/docs/State-of-play.md @@ -1,5 +1,81 @@ # State of Play +## 20260415 + +OK, I have been diverted down a side-project on a side-project. I decided +that since Post Scarcity definitely needs a compiler, I should learn to write +a compiler, and so I should start by writing one for a simpler Lisp than Post +Scarcity. So I started to write +[one in Guile Scheme for Beowulf](https://git.journeyman.cc/simon/naegling). +This is started but a long way from finished. I'm also not very enamoured of +Guile Scheme, and am starting to wonder whether in fact I should be writing +if in [Beowulf](https://git.journeyman.cc/simon/beowulf) for Beowulf. + +I do believe I can complete the Naegling/Beowulf compiler, and that having +written it, I can write a Post Scarcity compiler in Post Scarcity. But to do +that I still need to have to have at least all of + +* apply +* assoc +* bind! (or put! or set!, but I *think* I prefer `bind!`) +* car +* cdr +* cons +* cond +* eq? +* equal? +* eval +* λ +* nil +* print +* read +* t + +and, essentially, have all the parts of a working REPL. + +My brain is not working very well at present; I can't do more than a very few +hours of focussed work a day, and jumping between Naegling and Post Scarcity +is probably not a good plan; but in periods when I need to do thinking about +where I'm going with Naegling I may switch to Post Scarcity (and vice versa). + +### Standard signature for compiled functions + +While I'm on this, I'm wondering whether I've got the standard signature for +compiled functions right. What we've inherited from the `0.0.X` branch is +documented as: + +```c + /** + * pointer to a function which takes a cons pointer (representing + * its argument list) and a cons pointer (representing its environment) and a + * stack frame (representing the previous stack frame) as arguments and returns + * a cons pointer (representing its result). + * \todo check this documentation is current! + */ + struct cons_pointer ( *executable ) ( struct stack_frame *, + struct cons_pointer, + struct cons_pointer ); +``` + +But actually the documentation here is wrong, because what we actually pass +is a C pointer to a stack frame object (which in `0.0.X` is in vector space), +a cons pointer to the cons space object which is the vector pointer to that +stack frame, and a cons pointer to the environment. + +We definitely don't need to pass a pointer to the argument list (and in fact +we didn't before, the documentation is *wrong*); we also don't need to pass +both a C pointer and a cons pointer to the frame, since the frame is now in +paged space, so passing our managed pointer is enough. + +It *might be* that passing both an unmanaged and a managed pointer is worth +doing, since recovering the managed pointer from the unmanaged pointer is +very expensive, and while recovering the unmanaged pointer from the +managed pointer is cheap, it isn't free. + +But it's worth thinking about. + + + ## 20260331 Substrate layer `print` is written; all the building blocks for substrate diff --git a/src/c/io/io.c b/src/c/io/io.c index e9b40e1..3f31d2c 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -114,7 +114,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) { if ( stringp( s ) || symbolp( s ) ) { int len = 0; - for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) { + for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) { len++; } @@ -123,7 +123,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) { result = calloc( ( len * 4 ) + 1, sizeof( char ) ); int i = 0; - for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) { + for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) { buffer[i++] = pointer_to_object( c )->payload.string.character; } @@ -286,8 +286,8 @@ struct pso_pointer push_back_character( struct pso_pointer c, if ( characterp( c ) && readp( r ) ) { if ( url_ungetwc( ( wint_t ) - ( pointer_to_object( c )->payload.character. - character ), + ( pointer_to_object( c )->payload. + character.character ), pointer_to_object( r )->payload.stream.stream ) >= 0 ) { result = t; @@ -315,8 +315,8 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) { if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) { if ( url_fclose - ( pointer_to_object( fetch_arg( frame, 0 ) )->payload. - stream.stream ) + ( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream. + stream ) == 0 ) { result = t; } @@ -328,8 +328,7 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) { struct pso_pointer add_meta_integer( struct pso_pointer meta, wchar_t *key, long int value ) { return - cons( cons - ( c_string_to_lisp_keyword( key ), + c_cons( c_cons( c_string_to_lisp_keyword( key ), make_integer( value ) ), meta ); } @@ -339,7 +338,7 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key, wchar_t buffer[strlen( value ) + 1]; mbstowcs( buffer, value, strlen( value ) + 1 ); - return cons( cons( c_string_to_lisp_keyword( key ), + return c_cons( c_cons( c_string_to_lisp_keyword( key ), c_string_to_lisp_string( buffer ) ), meta ); } @@ -570,8 +569,8 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) { if ( readp( fetch_arg( frame, 0 ) ) ) { result = make_string( url_fgetwc - ( pointer_to_object( fetch_arg( frame, 0 ) )->payload. - stream.stream ), nil ); + ( pointer_to_object( fetch_arg( frame, 0 ) )-> + payload.stream.stream ), nil ); } return result; diff --git a/src/c/io/print.c b/src/c/io/print.c index e56babf..e22d48b 100644 --- a/src/c/io/print.c +++ b/src/c/io/print.c @@ -42,7 +42,7 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) struct pso_pointer result = nil; if ( consp( p ) ) { - for ( ; consp( p ); p = cdr( p ) ) { + for ( ; consp( p ); p = c_cdr( p ) ) { struct pso2 *object = pointer_to_object( p ); result = in_print( object->payload.cons.car, output ); diff --git a/src/c/io/read.c b/src/c/io/read.c index 71c96f8..f49368d 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -185,7 +185,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer, character = get_character( stream ); } - struct pso_pointer readmacro = assoc( character, readtable ); + struct pso_pointer readmacro = c_assoc( character, readtable ); if ( !nilp( readmacro ) ) { // invoke the read macro on the stream diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c index b1d6acb..004fa3e 100644 --- a/src/c/ops/assoc.c +++ b/src/c/ops/assoc.c @@ -19,6 +19,7 @@ #include "payloads/cons.h" #include "ops/eq.h" +#include "ops/stack_ops.h" #include "ops/truth.h" /** @@ -40,12 +41,12 @@ struct pso_pointer search( struct pso_pointer key, if ( consp( store ) ) { for ( struct pso_pointer cursor = store; - consp( store ) && found == false; cursor = cdr( cursor ) ) { - struct pso_pointer pair = car( cursor ); + consp( store ) && found == false; cursor = c_cdr( cursor ) ) { + struct pso_pointer pair = c_car( cursor ); - if ( consp( pair ) && c_equal( car( pair ), key ) ) { + if ( consp( pair ) && c_equal( c_car( pair ), key ) ) { found = true; - result = return_key ? car( pair ) : cdr( pair ); + result = return_key ? c_car( pair ) : c_cdr( pair ); } } } @@ -61,7 +62,7 @@ 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 */ -struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ) { +struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store ) { return search( key, store, false ); } @@ -73,7 +74,7 @@ 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. */ -struct pso_pointer interned( struct pso_pointer key, struct pso_pointer store ) { +struct pso_pointer c_interned( struct pso_pointer key, struct pso_pointer store ) { return search( key, store, true ); } @@ -85,6 +86,63 @@ struct pso_pointer interned( struct pso_pointer key, struct pso_pointer store ) * * @return `true` if a pointer the key was found in the store.. */ -bool internedp( struct pso_pointer key, struct pso_pointer store ) { +bool c_internedp( struct pso_pointer key, struct pso_pointer store ) { return !nilp( search( key, store, true ) ); } + +/** + * @prief: bootstap layer assoc; Lisp calling signature. + * + * @return a pointer to the value of the key in the store, or nil if not found + */ +struct pso_pointer assoc( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY + struct pso4 *frame = pointer_to_pso4( frame_pointer ); +#endif + struct pso_pointer key = fetch_arg( frame, 0 ); + struct pso_pointer store = fetch_arg( frame, 1 ); + + return c_assoc( key, store ); +} + +/** + * @prief: bootstap layer interned; Lisp calling signature. + * + * @return a pointer to the copy of the key in the store, or nil if not found. + */ +struct pso_pointer interned( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY + struct pso4 *frame = pointer_to_pso4( frame_pointer ); +#endif + struct pso_pointer key = fetch_arg( frame, 0 ); + struct pso_pointer store = fetch_arg( frame, 1 ); + + return c_interned( key, store ); +} + +/** + * @prief: bootstap layer interned?; Lisp calling signature. + * + * @return `t` if a pointer to a copy of `key` is found in the store, or `nil` if not found. + */ +struct pso_pointer internedp( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY + struct pso4 *frame = pointer_to_pso4( frame_pointer ); +#endif + struct pso_pointer key = fetch_arg( frame, 0 ); + struct pso_pointer store = fetch_arg( frame, 1 ); + + return c_interned( key, store ); +} \ No newline at end of file diff --git a/src/c/ops/assoc.h b/src/c/ops/assoc.h index 52d8d08..ab59c40 100644 --- a/src/c/ops/assoc.h +++ b/src/c/ops/assoc.h @@ -16,13 +16,13 @@ #include "memory/pointer.h" -struct cons_pointer search( struct pso_pointer key, +struct pso_pointer search( struct pso_pointer key, struct pso_pointer store, bool return_key ); -struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store ); +struct pso_pointer c_assoc( struct pso_pointer key, struct pso_pointer store ); -struct pso_pointer interned( struct pso_pointer key, +struct pso_pointer c_interned( struct pso_pointer key, struct pso_pointer store ); -bool internedp( struct pso_pointer key, struct pso_pointer store ); +bool c_internedp( struct pso_pointer key, struct pso_pointer store ); #endif diff --git a/src/c/ops/bind.c b/src/c/ops/bind.c index f812c43..75aa476 100644 --- a/src/c/ops/bind.c +++ b/src/c/ops/bind.c @@ -21,14 +21,19 @@ #include "payloads/cons.h" #include "payloads/stack.h" -struct pso_pointer bind( struct pso_pointer frame_pointer, - struct pso_pointer env ) { +struct pso_pointer bind( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY struct pso4 *frame = pointer_to_pso4( frame_pointer ); +#endif 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 ); + return c_cons( c_cons( key, value ), store ); } struct pso_pointer c_bind( struct pso_pointer key, @@ -37,7 +42,11 @@ struct pso_pointer c_bind( struct pso_pointer key, struct pso_pointer result = nil; struct pso_pointer next = make_frame( nil, key, value, store ); inc_ref( next ); - result = bind( next, nil ); + result = bind( +#ifndef MANAGED_POINTER_ONLY + pointer_to_pso4( next), +#endif + next, nil ); dec_ref( next ); return result; diff --git a/src/c/ops/bind.h b/src/c/ops/bind.h index d7cdf42..e8e6839 100644 --- a/src/c/ops/bind.h +++ b/src/c/ops/bind.h @@ -15,11 +15,16 @@ #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 ); +struct pso_pointer bind( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, + struct pso_pointer env +); + #endif diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index b3789e5..ab8702c 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -16,6 +16,7 @@ #include "memory/tags.h" #include "payloads/cons.h" +#include "payloads/function.h" #include "payloads/integer.h" #include "payloads/stack.h" #include "ops/stack_ops.h" @@ -26,6 +27,8 @@ * * Shallow, cheap equality. * + * Bootstrap function: only knows about character, cons, integer, and + * string-like-thing equality. * TODO: if either of these pointers points to a cache cell, then what * we need to check is the cached value, which is not so cheap. Ouch! * @@ -53,8 +56,8 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { ob->payload.character.character ); break; case CONSTV: - result = ( c_equal( car( a ), car( b ) ) - && c_equal( cdr( a ), cdr( b ) ) ); + result = ( c_equal( c_car( a ), c_car( b ) ) + && c_equal( c_cdr( a ), c_cdr( b ) ) ); break; case INTEGERTV: result = ( oa->payload.integer.value @@ -63,11 +66,11 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { case KEYTV: case STRINGTV: case SYMBOLTV: - while ( result == false && !nilp( a ) && !nilp( b ) ) { + while ( !nilp( a ) && !nilp( b ) ) { if ( pointer_to_object( a )->payload.string.character == pointer_to_object( b )->payload.string.character ) { - a = cdr( a ); - b = cdr( b ); + a = c_cdr( a ); + b = c_cdr( b ); } } result = nilp( a ) && nilp( b ); @@ -86,14 +89,17 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { * * * (eq? args...) * - * @param frame my stack_frame. - * @param frame_pointer a pointer to my stack_frame. - * @param env my environment (ignored). * @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 env ) { +struct pso_pointer eq( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY struct pso4 *frame = pointer_to_pso4( frame_pointer ); + +#endif struct pso_pointer result = t; @@ -108,3 +114,30 @@ struct pso_pointer eq( struct pso_pointer frame_pointer, return result; } + + +/** + * Function; do all arguments to this finction point to the same object? + * + * Deep, expensive equality. Bootstrap version: only knows + * * cons cells + * * integers + * * keywords + * * symbols + * * strings + * + * * (equal? arg1 qrg2) + * + * @return `t` if all args are pointers to the same object, else `nil`; + */ +struct pso_pointer equal( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, struct pso_pointer env) { +#ifdef MANAGED_POINTER_ONLY + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + +#endif + return c_equal( fetch_arg( frame, 0), fetch_arg( frame, 1)) ? t : nil; +} diff --git a/src/c/ops/eq.h b/src/c/ops/eq.h index 854e40c..90885c5 100644 --- a/src/c/ops/eq.h +++ b/src/c/ops/eq.h @@ -16,10 +16,30 @@ #include "memory/pointer.h" #include "memory/pso4.h" +#include "payloads/function.h" + bool c_eq( struct pso_pointer a, struct pso_pointer b ); struct pso_pointer eq( struct pso_pointer frame_pointer, struct pso_pointer env ); bool c_equal( struct pso_pointer a, struct pso_pointer b ); + +struct pso_pointer eq( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, + struct pso_pointer env +); + +struct pso_pointer equal( +#ifndef MANAGED_POINTER_ONLY + struct pso4 * frame, +#endif + struct pso_pointer frame_pointer, + struct pso_pointer env +); + + #endif diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index 5f59004..f4385e5 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -39,13 +39,14 @@ struct pso_pointer reverse( struct pso_pointer sequence ) { struct pso_pointer result = nil; for ( struct pso_pointer cursor = sequence; !nilp( sequence ); - cursor = cdr( cursor ) ) { + cursor = c_cdr( cursor ) ) { struct pso2 *object = pointer_to_object( cursor ); switch ( get_tag_value( cursor ) ) { case CONSTV: - result = cons( car( cursor ), result ); + result = c_cons( c_car( cursor ), result ); break; case KEYTV: + // TODO: should you be able to reverse keywords and symbols? result = make_string_like_thing( object->payload.string.character, result, KEYTAG ); @@ -56,6 +57,7 @@ struct pso_pointer reverse( struct pso_pointer sequence ) { result, STRINGTAG ); break; case SYMBOLTV: + // TODO: should you be able to reverse keywords and symbols? result = make_string_like_thing( object->payload.string.character, result, SYMBOLTAG ); diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 607cca4..5e8a4ea 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -19,6 +19,7 @@ #include "payloads/cons.h" #include "payloads/exception.h" +#include "ops/stack_ops.h" #include "ops/string_ops.h" /** @@ -29,7 +30,7 @@ * @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. */ -struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ) { +struct pso_pointer c_cons( struct pso_pointer car, struct pso_pointer cdr ) { struct pso_pointer result = allocate( CONSTAG, 2 ); struct pso2 *object = pointer_to_object( result ); @@ -47,7 +48,7 @@ struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ) { * @return the car of the indicated cell. * @exception if the pointer does not indicate a cons cell. */ -struct pso_pointer car( struct pso_pointer cons ) { +struct pso_pointer c_car( struct pso_pointer cons ) { struct pso_pointer result = nil; struct pso2 *object = pointer_to_object( result ); @@ -66,7 +67,7 @@ struct pso_pointer car( struct pso_pointer cons ) { * @return the cdr of the indicated cell. * @exception if the pointer does not indicate a cons cell. */ -struct pso_pointer cdr( struct pso_pointer p ) { +struct pso_pointer c_cdr( struct pso_pointer p ) { struct pso_pointer result = nil; struct pso2 *object = pointer_to_object( result ); @@ -81,7 +82,7 @@ struct pso_pointer cdr( struct pso_pointer p ) { break; default: result = - make_exception( cons + make_exception( c_cons ( c_string_to_lisp_string ( L"Invalid type for cdr" ), p ), nil, nil ); break; @@ -104,7 +105,7 @@ struct pso_pointer destroy_cons( struct pso_pointer fp, if ( stackp( fp ) ) { struct pso4 *frame = pointer_to_pso4( fp ); struct pso_pointer p = frame->payload.stack_frame.arg[0]; - dec_ref( car( p ) ); - dec_ref( cdr( p ) ); + dec_ref( c_car( p ) ); + dec_ref( c_cdr( p ) ); } } diff --git a/src/c/payloads/cons.h b/src/c/payloads/cons.h index 9ba768f..c7dd21c 100644 --- a/src/c/payloads/cons.h +++ b/src/c/payloads/cons.h @@ -26,11 +26,11 @@ struct cons_payload { struct pso_pointer cdr; }; -struct pso_pointer car( struct pso_pointer cons ); +struct pso_pointer c_car( struct pso_pointer cons ); -struct pso_pointer cdr( struct pso_pointer cons ); +struct pso_pointer c_cdr( struct pso_pointer cons ); -struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ); +struct pso_pointer c_cons( struct pso_pointer car, struct pso_pointer cdr ); struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env ); diff --git a/src/c/payloads/function.h b/src/c/payloads/function.h index ea54051..94bbb61 100644 --- a/src/c/payloads/function.h +++ b/src/c/payloads/function.h @@ -13,29 +13,43 @@ #include "memory/pointer.h" #include "memory/pso4.h" +/** + * I don't think it's necessary to pass both an unmanaged and a managed + * frame pointer into a function, but it may prove to be more efficient to do + * so. For the present we'll assume not. See state of play for 15042026. + */ +#define MANAGED_POINTER_ONLY TRUE + /** * @brief Payload of a function cell. - * `source` points to the source from which the function was compiled, or NIL - * if it is a primitive. - * `executable` points to a function which takes a pointer to a stack frame - * (representing its stack frame) and a cons pointer (representing its - * environment) as arguments and returns a cons pointer (representing its - * result). */ struct function_payload { /** - * pointer to metadata (e.g. the source from which the function was compiled). + * pointer to metadata (e.g. the source from which the function was compiled, + * something to help estimate the cost of the function?). */ struct pso_pointer meta; - /** pointer to a function which takes a cons pointer (representing - * its argument list) and a cons pointer (representing its environment) and a - * stack frame (representing the previous stack frame) as arguments and returns - * a cons pointer (representing its result). - * \todo check this documentation is current! + +#ifdef MANAGED_POINTER_ONLY + /** + * pointer to a C function which takes a managed pointer to the same stack + * frame and a managed pointer to the environment as arguments. Arguments + * to the Lisp function are assumed to be loaded into the frame before + * invocation. */ - struct pso_pointer ( *executable ) ( struct pso4 *, - struct pso_pointer, - struct pso_pointer ); + struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer, + struct pso_pointer env ); +#else + /** + * pointer to a C function which takes an unmanaged pointer to a stack frame, + * a managed pointer to the same stack frame, and a managed pointer to the + * environment as arguments. Arguments to the Lisp function are assumed to be + * loaded into the frame before invocation. + */ + struct pso_pointer ( *executable ) ( struct pso4 * frame, + struct pso_pointer frame_pointer, + struct pso_pointer env ); +#endif }; #endif diff --git a/src/c/payloads/psse_string.c b/src/c/payloads/psse_string.c index a75037b..8a4bdbe 100644 --- a/src/c/payloads/psse_string.c +++ b/src/c/payloads/psse_string.c @@ -38,7 +38,7 @@ struct pso_pointer destroy_string( struct pso_pointer fp, struct pso4 *frame = pointer_to_pso4( fp ); struct pso_pointer p = frame->payload.stack_frame.arg[0]; - dec_ref( cdr( p ) ); + dec_ref( c_cdr( p ) ); } return nil; diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index a0591ab..70abaa3 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -18,6 +18,8 @@ #include "memory/pso4.h" #include "memory/tags.h" +#include "payloads/cons.h" + /** * @brief Construct a stack frame with this `previous` pointer, and arguments * taken from the remaining arguments to this function, which should all be @@ -50,7 +52,7 @@ struct pso_pointer make_frame( struct pso_pointer previous, ... ) { struct pso_pointer more_args = nil; for ( ; cursor < count; cursor++ ) { - more_args = cons( va_arg( args, struct pso_pointer ), more_args ); + more_args = c_cons( va_arg( args, struct pso_pointer ), more_args ); } // should be frame->payload.stack_frame.more = reverse( more_args), but @@ -83,7 +85,7 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp, dec_ref( casualty->payload.stack_frame.more ); for ( int i = 0; i < args_in_frame; i++ ) { - dec_ref( casualty->payload.stack_frame.arg[0] ); + dec_ref( casualty->payload.stack_frame.arg[i] ); } casualty->payload.stack_frame.args = 0;