Modified make_cons and make_frame to illustrate the pattern I
want to apply generally. This does not compile!
This commit is contained in:
parent
6148d3699f
commit
aa5b34368e
6 changed files with 145 additions and 21 deletions
|
|
@ -21,6 +21,47 @@ I'm not ignoring the fact that a lot of stuff in `0.1.0` is still fundamentally
|
||||||
|
|
||||||
I think this week is going to be mostly a thinking week — partly because the weather forecast is unusually benign, and it would be sensible get some outdoor work done.
|
I think this week is going to be mostly a thinking week — partly because the weather forecast is unusually benign, and it would be sensible get some outdoor work done.
|
||||||
|
|
||||||
|
### 21:30
|
||||||
|
|
||||||
|
Right, I have spent a lot of time hauling timber out of the wood today, but I've also done a substantial amount of coding, doing a sort of hybrid not-quite-standard-lisp calling convention; and I'm now convinced all this work is wrong and needs to be backed out, and I need to go for full on Lisp calling convention.
|
||||||
|
|
||||||
|
So where I'm now calling `make_cons` as in this sample:
|
||||||
|
|
||||||
|
```c
|
||||||
|
struct pso_pointer c_reverse( struct pso4* frame, struct pso_pointer sequence ) {
|
||||||
|
struct pso_pointer result = nil;
|
||||||
|
|
||||||
|
for ( struct pso_pointer cursor = sequence; !nilp( sequence );
|
||||||
|
cursor = c_cdr( cursor ) ) {
|
||||||
|
result = make_cons( frame, c_car( cursor ), result );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
```
|
||||||
|
|
||||||
|
we would instead be doing this:
|
||||||
|
|
||||||
|
```c
|
||||||
|
struct pso_pointer reverse( struct pso_pointer frame) {
|
||||||
|
struct pso_pointer sequence = fetch_arg( frame, 0);
|
||||||
|
struct pso_pointer result = nil;
|
||||||
|
|
||||||
|
for ( struct pso_pointer cursor = sequence; !nilp( sequence );
|
||||||
|
cursor = cdr( make_frame( 1, frame, cursor ) ) {
|
||||||
|
result = cons( make_frame( 2, frame,
|
||||||
|
car( make_frame( 1, frame, cursor )),
|
||||||
|
result);
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
```
|
||||||
|
|
||||||
|
Note that instead of `c_reverse`, `c_cdr`, `c_car` this is using `reverse`, `cdr`, `car`. That's because these are actual Lisp functions, callable from Lisp, which don't have to be duplicated or wrapped in Lisp-compatible wrappers.
|
||||||
|
|
||||||
|
This *has* to be the right way to go.
|
||||||
|
|
||||||
## 20260415
|
## 20260415
|
||||||
|
|
||||||
OK, I have been diverted down a side-project on a side-project. I decided
|
OK, I have been diverted down a side-project on a side-project. I decided
|
||||||
|
|
|
||||||
|
|
@ -381,8 +381,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
|
||||||
|
|
||||||
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.
|
( pointer_to_object( c )->payload.character.
|
||||||
character.character ),
|
character ),
|
||||||
pointer_to_object( r )->payload.stream.stream ) >=
|
pointer_to_object( r )->payload.stream.stream ) >=
|
||||||
0 ) {
|
0 ) {
|
||||||
result = t;
|
result = t;
|
||||||
|
|
|
||||||
|
|
@ -69,17 +69,16 @@ struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag,
|
||||||
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.
|
strncpy( ( char * ) ( pointer_to_object( result )->header.tag.
|
||||||
mnemonic ), tag, TAGLENGTH );
|
bytes.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->
|
stack_pointer->payload.
|
||||||
payload.stack_frame.
|
stack_frame.locals );
|
||||||
locals );
|
|
||||||
stack_pointer->payload.stack_frame.locals = locals;
|
stack_pointer->payload.stack_frame.locals = locals;
|
||||||
|
|
||||||
} else if ( memory_initialised ) {
|
} else if ( memory_initialised ) {
|
||||||
|
|
|
||||||
|
|
@ -30,15 +30,17 @@
|
||||||
* @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 pso4 *frame_pointer,
|
struct pso_pointer make_cons( struct pso_pointer frame_pointer ) {
|
||||||
struct pso_pointer car,
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||||
struct pso_pointer cdr ) {
|
struct pso_pointer result = allocate( frame, CONSTAG, 2 );
|
||||||
// todo: issue #21: must have stack frame passed in.
|
|
||||||
struct pso_pointer result = allocate( frame_pointer, CONSTAG, 2 );
|
|
||||||
|
|
||||||
|
if ( stackp( frame ) ) {
|
||||||
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 =
|
||||||
object->payload.cons.cdr = inc_ref( cdr );
|
inc_ref( frame->payload.stack_frame.args[0] );
|
||||||
|
object->payload.cons.cdr =
|
||||||
|
inc_ref( frame->payload.stack_frame.args[0] );
|
||||||
|
}
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -29,13 +29,17 @@
|
||||||
* taken from the remaining arguments to this function, which should all be
|
* taken from the remaining arguments to this function, which should all be
|
||||||
* struct pso_pointer.
|
* struct pso_pointer.
|
||||||
*
|
*
|
||||||
* @return a pso_pointer to the stack frame.
|
* @param arg_count the count of arguments to the Lisp function.
|
||||||
|
* @param previous the parent stack frame.
|
||||||
|
* @param ... the arguments to the Lisp function, all of which must be of type
|
||||||
|
* `struct pso_pointer`.
|
||||||
|
* @return struct pso_pointer a pointer to a populated stack frame which may be
|
||||||
|
* passed to the Lisp function.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||||
... ) {
|
struct pso_pointer env, ... ) {
|
||||||
// todo: issue #21: must have stack frame passed in.
|
|
||||||
va_list args;
|
va_list args;
|
||||||
va_start( args, previous );
|
va_start( args, env );
|
||||||
|
|
||||||
struct pso4 *frame = pointer_to_pso4( previous );
|
struct pso4 *frame = pointer_to_pso4( previous );
|
||||||
struct pso_pointer frame_pointer =
|
struct pso_pointer frame_pointer =
|
||||||
|
|
@ -53,6 +57,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||||
if ( stackp( previous ) ) {
|
if ( stackp( previous ) ) {
|
||||||
struct pso4 *op = pointer_to_pso4( previous );
|
struct pso4 *op = pointer_to_pso4( previous );
|
||||||
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
|
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
|
||||||
|
frame->payload.stack_frame.env = op->payload.stack_frame.env;
|
||||||
} else {
|
} else {
|
||||||
frame->payload.stack_frame.depth = 0;
|
frame->payload.stack_frame.depth = 0;
|
||||||
}
|
}
|
||||||
|
|
@ -91,6 +96,81 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||||
return frame_pointer;
|
return frame_pointer;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief variant of make_frame with an explicit replacement environment, to
|
||||||
|
* be called by functions like `binding` which add bindings to their upstack
|
||||||
|
* environment.
|
||||||
|
*
|
||||||
|
* @param arg_count the count of arguments to the Lisp function.
|
||||||
|
* @param previous the parent stack frame.
|
||||||
|
* @param env the modified environment
|
||||||
|
* @param ... the arguments to the Lisp function, all of which must be of type
|
||||||
|
* `struct pso_pointer`.
|
||||||
|
* @return struct pso_pointer a pointer to a populated stack frame which may be
|
||||||
|
* passed to the Lisp function.
|
||||||
|
*/
|
||||||
|
struct pso_pointer make_frame_with_env( int arg_count,
|
||||||
|
struct pso_pointer previous,
|
||||||
|
struct pso_pointer env, ... ) {
|
||||||
|
va_list args;
|
||||||
|
va_start( args, env );
|
||||||
|
|
||||||
|
struct pso4 *frame = pointer_to_pso4( previous );
|
||||||
|
struct pso_pointer frame_pointer =
|
||||||
|
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
|
||||||
|
|
||||||
|
#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 );
|
||||||
|
#endif
|
||||||
|
|
||||||
|
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;
|
||||||
|
} else {
|
||||||
|
frame->payload.stack_frame.depth = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
||||||
|
frame->payload.stack_frame.depth );
|
||||||
|
|
||||||
|
int cursor = 0;
|
||||||
|
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 );
|
||||||
|
}
|
||||||
|
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 ),
|
||||||
|
more_args );
|
||||||
|
}
|
||||||
|
|
||||||
|
frame->payload.stack_frame.more = c_reverse( more_args );
|
||||||
|
} else {
|
||||||
|
for ( ; cursor < args_in_frame; cursor++ ) {
|
||||||
|
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 );
|
||||||
|
|
||||||
|
return frame_pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief When a stack frame is freed, all its pointers must be decremented.
|
* @brief When a stack frame is freed, all its pointers must be decremented.
|
||||||
*
|
*
|
||||||
|
|
|
||||||
|
|
@ -43,7 +43,9 @@ struct stack_frame_payload {
|
||||||
|
|
||||||
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||||
... );
|
... );
|
||||||
|
struct pso_pointer make_frame_with_env( int arg_count,
|
||||||
|
struct pso_pointer previous,
|
||||||
|
struct pso_pointer env, ... )
|
||||||
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 );
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue