Initialisation almost succeeds. nil and t are successfully instantiated.
We then go into a mess of exceptions which trigger exceptions until we run out of allocatable memory, but all those exceptions and stack frames are correctly allocated and torn down again afterwards, so.... sort of good?
This commit is contained in:
commit
ba985474f6
31 changed files with 869 additions and 199 deletions
|
|
@ -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 ) );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -33,8 +33,6 @@ struct string_payload {
|
|||
struct pso_pointer cdr;
|
||||
};
|
||||
|
||||
struct pso_pointer make_string( wint_t c, struct pso_pointer tail );
|
||||
|
||||
struct pso_pointer destroy_string( struct pso_pointer fp,
|
||||
struct pso_pointer env );
|
||||
|
||||
|
|
|
|||
|
|
@ -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,8 @@ 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
|
||||
|
|
@ -75,19 +78,17 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
|
|||
struct pso_pointer env ) {
|
||||
if ( stackp( fp ) ) {
|
||||
struct pso4 *frame = pointer_to_pso4( fp );
|
||||
struct pso4 *casualty =
|
||||
pointer_to_pso4( frame->payload.stack_frame.arg[0] );
|
||||
|
||||
dec_ref( casualty->payload.stack_frame.previous );
|
||||
dec_ref( casualty->payload.stack_frame.function );
|
||||
dec_ref( casualty->payload.stack_frame.more );
|
||||
dec_ref( frame->payload.stack_frame.previous );
|
||||
dec_ref( frame->payload.stack_frame.function );
|
||||
dec_ref( frame->payload.stack_frame.more );
|
||||
|
||||
for ( int i = 0; i < args_in_frame; i++ ) {
|
||||
dec_ref( casualty->payload.stack_frame.arg[0] );
|
||||
dec_ref( frame->payload.stack_frame.arg[i] );
|
||||
}
|
||||
|
||||
casualty->payload.stack_frame.args = 0;
|
||||
casualty->payload.stack_frame.depth = 0;
|
||||
frame->payload.stack_frame.args = 0;
|
||||
frame->payload.stack_frame.depth = 0;
|
||||
}
|
||||
|
||||
return nil;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue