Still in progress. Nothing workds.
This commit is contained in:
parent
aa5b34368e
commit
ef59563e25
14 changed files with 206 additions and 180 deletions
|
|
@ -17,6 +17,7 @@
|
|||
#include "memory/tags.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/eq.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
|
@ -100,13 +101,13 @@ struct pso_pointer assoc(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#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 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
|
||||
|
||||
return c_assoc( key, store );
|
||||
}
|
||||
|
|
@ -120,13 +121,13 @@ struct pso_pointer interned(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#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 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
|
||||
|
||||
return c_interned( key, store );
|
||||
}
|
||||
|
|
@ -140,13 +141,13 @@ struct pso_pointer internedp(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#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 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ), frame->payload.stack_frame.env));
|
||||
|
||||
return c_interned( key, store );
|
||||
return c_internedp( key, store );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -22,25 +22,19 @@
|
|||
#include "payloads/function.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
struct pso_pointer lisp_bind(
|
||||
struct pso_pointer bind(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#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 );
|
||||
struct pso_pointer binding = cons( make_frame( 2, frame_pointer, key, value));
|
||||
|
||||
return make_cons( make_cons( key, value ), store );
|
||||
return cons( make_frame( 2, frame_pointer, binding, store));
|
||||
}
|
||||
|
||||
struct pso_pointer c_bind( struct pso_pointer key,
|
||||
struct pso_pointer value,
|
||||
struct pso_pointer store ) {
|
||||
// todo: issue #21: must have stack frame passed in.
|
||||
return make_cons( make_cons( key, value ), store );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -99,8 +99,7 @@ struct pso_pointer eq(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer ) {
|
||||
#ifdef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
|
|
@ -139,8 +138,7 @@ struct pso_pointer equal(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer ) {
|
||||
#ifdef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
|
|
|
|||
|
|
@ -20,24 +20,19 @@
|
|||
|
||||
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 frame_pointer );
|
||||
|
||||
struct pso_pointer equal(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer frame_pointer);
|
||||
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -35,8 +35,7 @@ struct pso_pointer apply(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#ifdef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
#endif
|
||||
|
|
@ -54,8 +53,7 @@ struct pso_pointer eval(
|
|||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer frame_pointer) {
|
||||
#ifdef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
#endif
|
||||
|
|
@ -71,7 +69,7 @@ struct pso_pointer eval(
|
|||
// self evaluating
|
||||
break;
|
||||
case SYMBOLTV:
|
||||
result = c_assoc( result, env );
|
||||
result = c_assoc( result, fetch_env(frame_pointer) );
|
||||
break;
|
||||
// case LAMBDATV:
|
||||
// result = eval_lambda( frame, frame_pointer, env);
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/**
|
||||
* ops/list_ops.h
|
||||
* ops/list_ops.c
|
||||
*
|
||||
* Post Scarcity Software Environment: list_ops.
|
||||
*
|
||||
|
|
@ -8,65 +8,22 @@
|
|||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_ops_list_ops_h
|
||||
#define __psse_ops_list_ops_h
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer car(
|
||||
#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_car( fetch_arg( frame, 0 ) );
|
||||
struct pso_pointer length( struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer list = fetch_arg( frame_pointer, 0);
|
||||
int count = 0;
|
||||
|
||||
for ( struct pso_pointer cursor = list; !nilp( cursor);
|
||||
cursor = cdr( make_frame( 1, frame_pointer, list))) {
|
||||
count++;
|
||||
}
|
||||
|
||||
return make_integer( pointer_to_pso4(frame_pointer), count);
|
||||
}
|
||||
|
||||
struct pso_pointer cdr(
|
||||
#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_cdr( frame, fetch_arg( frame, 0 ) );
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief allocate a cons cell from the first two args in this frame, and
|
||||
* return a pointer to it.
|
||||
*
|
||||
* Lisp calling conventions.
|
||||
*
|
||||
* @return struct pso_pointer a pointer to the newly allocated cons cell.
|
||||
*/
|
||||
|
||||
struct pso_pointer cons(
|
||||
#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 make_cons( frame, fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) );
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -17,25 +17,5 @@
|
|||
|
||||
#include "payloads/function.h"
|
||||
|
||||
struct pso_pointer car(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
struct pso_pointer cdr(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
struct pso_pointer cons(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
struct pso_pointer length( struct pso_pointer frame_pointer);
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
#include "memory/node.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
/**
|
||||
|
|
@ -21,6 +22,8 @@ uint32_t stack_limit = 0;
|
|||
|
||||
/**
|
||||
* Fetch a pointer to the value of the local variable at this index.
|
||||
*
|
||||
* TODO: I think the first argument would be better as a pso_pointer.
|
||||
*/
|
||||
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
|
@ -40,3 +43,15 @@ struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ) {
|
|||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Return the environment from the stack frame identified by this
|
||||
* `frame_pointer`
|
||||
*
|
||||
* @param frame_pointer a pointer to a stack frame.
|
||||
*/
|
||||
struct pso_pointer fetch_env( struct pso_pointer frame_pointer) {
|
||||
return stackp(frame_pointer) ?
|
||||
pointer_to_pso4(frame_pointer)->payload.stack_frame.env :
|
||||
nil;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -27,4 +27,6 @@ extern uint32_t stack_limit;
|
|||
|
||||
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index );
|
||||
|
||||
struct pso_pointer fetch_env( struct pso_pointer frame_pointer);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -26,11 +26,12 @@
|
|||
* @brief allocate a cons cell with this car and this cdr, and return a pointer
|
||||
* to it.
|
||||
*
|
||||
* @param car the pointer which should form the car of this cons cell;
|
||||
* @param cdr the pointer which should form the cdr of this cons cell.
|
||||
* (cons object object)
|
||||
*
|
||||
* @param frame_pointer a pointer to a stack frame.
|
||||
* @return struct pso_pointer a pointer to the newly allocated cons cell.
|
||||
*/
|
||||
struct pso_pointer make_cons( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer cons( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = allocate( frame, CONSTAG, 2 );
|
||||
|
||||
|
|
@ -49,18 +50,28 @@ struct pso_pointer make_cons( struct pso_pointer frame_pointer ) {
|
|||
/**
|
||||
* @brief return the car of this cons cell.
|
||||
*
|
||||
* @param cons a pointer to the cell.
|
||||
* (car cell)
|
||||
*
|
||||
* @param frame_pointer a pointer to a stack frame.
|
||||
* @return the car of the indicated cell.
|
||||
* @exception if the pointer does not indicate a cons cell.
|
||||
*/
|
||||
struct pso_pointer c_car( struct pso_pointer cons ) {
|
||||
struct pso_pointer car( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer cons = fetch_arg( pointer_to_pso4( frame_pointer), 0);
|
||||
struct pso2 *object = pointer_to_object( cons );
|
||||
|
||||
if ( consp( cons ) ) {
|
||||
result = object->payload.cons.car;
|
||||
} else {
|
||||
result =
|
||||
make_exception( make_frame( 2, frame_pointer,
|
||||
c_string_to_lisp_string( frame_pointer, L"Invalid type for car" ),
|
||||
make_cons(
|
||||
make_cons( frame_pointer,
|
||||
c_string_to_lisp_keyword( frame_pointer, L"type" ),
|
||||
get_tag_string( cons )), nil)));
|
||||
}
|
||||
// TODO: else throw an exception
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -68,14 +79,17 @@ struct pso_pointer c_car( struct pso_pointer cons ) {
|
|||
/**
|
||||
* @brief return the cdr of this cons (or other sequence) cell.
|
||||
*
|
||||
* @param cons a pointer to the cell.
|
||||
* (cdr cell)
|
||||
*
|
||||
* @param frame_pointer a pointer to a stack frame.
|
||||
* @return the cdr of the indicated cell.
|
||||
* @exception if the pointer does not indicate a cons cell.
|
||||
*/
|
||||
struct pso_pointer c_cdr( struct pso4 *stack_pointer, struct pso_pointer p ) {
|
||||
// todo: issue #21: must have stack frame passed in.
|
||||
struct pso_pointer cdr( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
struct pso4 *sp = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer cons = fetch_arg(sp, 0);
|
||||
struct pso2 *object = pointer_to_object( cons );
|
||||
|
||||
switch ( get_tag_value( p ) ) {
|
||||
case CONSTV:
|
||||
|
|
@ -88,15 +102,15 @@ struct pso_pointer c_cdr( struct pso4 *stack_pointer, struct pso_pointer p ) {
|
|||
break;
|
||||
default:
|
||||
result =
|
||||
make_exception( make_cons
|
||||
( stack_pointer, c_string_to_lisp_string
|
||||
( stack_pointer, L"Invalid type for cdr" ),
|
||||
get_tag_string( p ) ), nil, nil, nil );
|
||||
make_exception( make_frame( 2, frame_pointer,
|
||||
c_string_to_lisp_string( frame_pointer, L"Invalid type for cdr" ),
|
||||
make_cons(
|
||||
make_cons( frame_pointer,
|
||||
c_string_to_lisp_keyword( frame_pointer, L"type" ),
|
||||
get_tag_string( cons )), nil)));
|
||||
break;
|
||||
}
|
||||
|
||||
// TODO: else throw an exception
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -27,14 +27,11 @@ struct cons_payload {
|
|||
struct pso_pointer cdr;
|
||||
};
|
||||
|
||||
struct pso_pointer c_car( struct pso_pointer cons );
|
||||
struct pso_pointer car( struct pso_pointer frame_pointer );
|
||||
|
||||
struct pso_pointer c_cdr( struct pso4 *stack_pointer,
|
||||
struct pso_pointer cons );
|
||||
struct pso_pointer cdr( struct pso_pointer frame_pointer );
|
||||
|
||||
// todo: issue #21: must have stack frame passed in.
|
||||
struct pso_pointer make_cons( struct pso4 *stack_pointer,
|
||||
struct pso_pointer car, struct pso_pointer cdr );
|
||||
struct pso_pointer cons( struct pso_pointer frame_pointer );
|
||||
|
||||
struct pso_pointer destroy_cons( struct pso_pointer fp,
|
||||
struct pso_pointer env );
|
||||
|
|
|
|||
|
|
@ -23,6 +23,8 @@
|
|||
* @brief allocate an exception object, and, if successful, return a pointer
|
||||
* to it.
|
||||
*
|
||||
* (exception message meta cause)
|
||||
*
|
||||
* Throwing an exception while generating an exception is meaningless. If
|
||||
* allocation fails utterly (i.e. out of heap, out of page space) this will
|
||||
* have to return `nil`, which might give rise to hard to trace bugs. But
|
||||
|
|
@ -34,10 +36,13 @@
|
|||
* or `nil`
|
||||
* @param cause the exception that caused this exception to be `thrown`.
|
||||
*/
|
||||
struct pso_pointer make_exception( struct pso_pointer message,
|
||||
struct pso_pointer frame,
|
||||
struct pso_pointer meta,
|
||||
struct pso_pointer cause ) {
|
||||
struct pso_pointer make_exception( struct pso_pointer frame_pointer) {
|
||||
struct pso4* frame = pointer_to_pso4( frame_pointer);
|
||||
struct pso_pointer message = fetch_arg(frame, 0);
|
||||
struct pso_pointer previous = frame->payload.stack_frame.previous;
|
||||
struct pso_pointer meta = fetch_arg( frame, 1);
|
||||
struct pso_pointer cause = fetch_arg( frame, 2);
|
||||
|
||||
struct pso_pointer result =
|
||||
allocate( pointer_to_pso4( frame ), EXCEPTIONTAG, 3 );
|
||||
|
||||
|
|
|
|||
|
|
@ -37,8 +37,7 @@ struct function_payload {
|
|||
* to the Lisp function are assumed to be loaded into the frame before
|
||||
* invocation.
|
||||
*/
|
||||
struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer );
|
||||
#else
|
||||
/**
|
||||
* pointer to a C function which takes an unmanaged pointer to a stack frame,
|
||||
|
|
@ -47,8 +46,7 @@ struct function_payload {
|
|||
* loaded into the frame before invocation.
|
||||
*/
|
||||
struct pso_pointer ( *executable ) ( struct pso4 * frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer frame_pointer );
|
||||
#endif
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -37,63 +37,63 @@
|
|||
* passed to the Lisp function.
|
||||
*/
|
||||
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||
struct pso_pointer env, ... ) {
|
||||
... ) {
|
||||
va_list args;
|
||||
va_start( args, env );
|
||||
va_start( args, previous );
|
||||
|
||||
struct pso4 *frame = pointer_to_pso4( previous );
|
||||
struct pso_pointer frame_pointer =
|
||||
struct pso4 *prev_frame = pointer_to_pso4( previous );
|
||||
struct pso_pointer new_pointer =
|
||||
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
|
||||
struct pso4* new_frame = pointer_to_pso4(new_pointer);
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"\nAllocating stack frame with %d arguments at page %d, "
|
||||
L"offset %d...\n",
|
||||
arg_count, frame_pointer.page, frame_pointer.offset );
|
||||
arg_count, new_pointer.page, new_pointer.offset );
|
||||
#endif
|
||||
|
||||
frame->payload.stack_frame.previous = previous;
|
||||
prev_frame->payload.stack_frame.previous = previous;
|
||||
|
||||
if ( stackp( previous ) ) {
|
||||
struct pso4 *op = pointer_to_pso4( previous );
|
||||
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
|
||||
frame->payload.stack_frame.env = op->payload.stack_frame.env;
|
||||
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
|
||||
new_frame->payload.stack_frame.env = prev_frame->payload.stack_frame.env;
|
||||
} else {
|
||||
frame->payload.stack_frame.depth = 0;
|
||||
new_frame->payload.stack_frame.depth = 0;
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
||||
frame->payload.stack_frame.depth );
|
||||
new_frame->payload.stack_frame.depth );
|
||||
|
||||
int cursor = 0;
|
||||
frame->payload.stack_frame.args = arg_count;
|
||||
new_frame->payload.stack_frame.args = arg_count;
|
||||
|
||||
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
|
||||
struct pso_pointer argument = va_arg( args, struct pso_pointer );
|
||||
|
||||
frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
|
||||
new_frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
|
||||
}
|
||||
if ( cursor < arg_count ) {
|
||||
struct pso_pointer more_args = nil;
|
||||
|
||||
for ( ; cursor < arg_count; cursor++ ) {
|
||||
more_args =
|
||||
make_cons( frame, va_arg( args, struct pso_pointer ),
|
||||
make_cons( prev_frame, va_arg( args, struct pso_pointer ),
|
||||
more_args );
|
||||
}
|
||||
|
||||
frame->payload.stack_frame.more = c_reverse( more_args );
|
||||
new_frame->payload.stack_frame.more = c_reverse( more_args );
|
||||
} else {
|
||||
for ( ; cursor < args_in_frame; cursor++ ) {
|
||||
frame->payload.stack_frame.arg[cursor] = nil;
|
||||
new_frame->payload.stack_frame.arg[cursor] = nil;
|
||||
}
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1,
|
||||
L"Allocation of frame at page %d, offset %d completed.\n",
|
||||
frame_pointer.page, frame_pointer.offset );
|
||||
L"Allocation of stack frame at page %d, offset %d completed.\n",
|
||||
new_pointer.page, new_pointer.offset );
|
||||
|
||||
return frame_pointer;
|
||||
return new_pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -115,59 +115,131 @@ struct pso_pointer make_frame_with_env( int arg_count,
|
|||
va_list args;
|
||||
va_start( args, env );
|
||||
|
||||
struct pso4 *frame = pointer_to_pso4( previous );
|
||||
struct pso_pointer frame_pointer =
|
||||
struct pso4 *prev_frame = pointer_to_pso4( previous );
|
||||
struct pso_pointer new_pointer =
|
||||
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
|
||||
struct pso4* new_frame = pointer_to_pso4(new_pointer);
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"\nAllocating stack frame with %d arguments at page %d, "
|
||||
L"offset %d...\n",
|
||||
arg_count, frame_pointer.page, frame_pointer.offset );
|
||||
arg_count, new_pointer.page, new_pointer.offset );
|
||||
#endif
|
||||
|
||||
frame->payload.stack_frame.previous = previous;
|
||||
prev_frame->payload.stack_frame.previous = previous;
|
||||
|
||||
if ( stackp( previous ) ) {
|
||||
struct pso4 *op = pointer_to_pso4( previous );
|
||||
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
|
||||
frame->payload.stack_frame.env = env;
|
||||
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
|
||||
new_frame->payload.stack_frame.env = env;
|
||||
} else {
|
||||
frame->payload.stack_frame.depth = 0;
|
||||
new_frame->payload.stack_frame.depth = 0;
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
||||
frame->payload.stack_frame.depth );
|
||||
new_frame->payload.stack_frame.depth );
|
||||
|
||||
int cursor = 0;
|
||||
frame->payload.stack_frame.args = arg_count;
|
||||
new_frame->payload.stack_frame.args = arg_count;
|
||||
|
||||
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
|
||||
struct pso_pointer argument = va_arg( args, struct pso_pointer );
|
||||
|
||||
frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
|
||||
new_frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
|
||||
}
|
||||
if ( cursor < arg_count ) {
|
||||
struct pso_pointer more_args = nil;
|
||||
|
||||
for ( ; cursor < arg_count; cursor++ ) {
|
||||
more_args =
|
||||
make_cons( frame, va_arg( args, struct pso_pointer ),
|
||||
make_cons( prev_frame, va_arg( args, struct pso_pointer ),
|
||||
more_args );
|
||||
}
|
||||
|
||||
frame->payload.stack_frame.more = c_reverse( more_args );
|
||||
new_frame->payload.stack_frame.more = c_reverse( more_args );
|
||||
} else {
|
||||
for ( ; cursor < args_in_frame; cursor++ ) {
|
||||
frame->payload.stack_frame.arg[cursor] = nil;
|
||||
new_frame->payload.stack_frame.arg[cursor] = nil;
|
||||
}
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1,
|
||||
L"Allocation of frame at page %d, offset %d completed.\n",
|
||||
frame_pointer.page, frame_pointer.offset );
|
||||
L"Allocation of stack frame at page %d, offset %d completed.\n",
|
||||
new_pointer.page, new_pointer.offset );
|
||||
|
||||
return frame_pointer;
|
||||
return new_pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief variant make_frame where arg values are available as a Lisp list,
|
||||
* and an explicit (because modified) environment is to be passed..
|
||||
*
|
||||
* @param previous pointer to the previous stack frame.
|
||||
* @param argvalues values for the arguments to be placed in the frame.
|
||||
* @param end the environment to be linked in the new frame.
|
||||
*
|
||||
* @return pointer to the new frame.
|
||||
*/
|
||||
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous, struct pso_pointer argvalues,
|
||||
struct pso_pointer env) {
|
||||
struct pso4 *prev_frame = pointer_to_pso4( previous );
|
||||
struct pso_pointer new_pointer =
|
||||
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
|
||||
struct pso4* new_frame = pointer_to_pso4(new_pointer);
|
||||
int arg_count = c_length(argvalues);
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"\nAllocating stack frame with %d arguments at page %d, "
|
||||
L"offset %d...\n",
|
||||
arg_count, new_pointer.page, new_pointer.offset );
|
||||
#endif
|
||||
|
||||
prev_frame->payload.stack_frame.previous = previous;
|
||||
|
||||
if ( stackp( previous ) ) {
|
||||
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
|
||||
new_frame->payload.stack_frame.env = inc_ref( prev_frame->payload.stack_frame.env);
|
||||
} else {
|
||||
new_frame->payload.stack_frame.depth = 0;
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
||||
new_frame->payload.stack_frame.depth );
|
||||
|
||||
int cursor = 0;
|
||||
new_frame->payload.stack_frame.args = arg_count;
|
||||
|
||||
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
|
||||
|
||||
new_frame->payload.stack_frame.arg[cursor] = inc_ref( make_frame( 1, previous, car(argvalues)));
|
||||
argvalues = cdr( make_frame( 1, previous, argvalues));
|
||||
}
|
||||
if ( cursor < arg_count ) {
|
||||
new_frame->payload.stack_frame.more = inc_ref( cursor);
|
||||
} else {
|
||||
for ( ; cursor < args_in_frame; cursor++ ) {
|
||||
new_frame->payload.stack_frame.arg[cursor] = nil;
|
||||
}
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ALLOC, 1,
|
||||
L"Allocation of stack frame at page %d, offset %d completed.\n",
|
||||
new_pointer.page, new_pointer.offset );
|
||||
|
||||
return new_pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief variant make_frame where arg values are available as a Lisp list.
|
||||
*
|
||||
* @param previous pointer to the previous stack frame.
|
||||
* @param argvalues values for the arguments to be placed in the frame.
|
||||
*
|
||||
* @return pointer to the new frame.
|
||||
*/
|
||||
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous, struct pso_pointer argvalues) {
|
||||
return make_frame_with_arglist_and_env( previous, argvalues, pointer_to_pso4(previous)->payload.stack_frame.env);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue