Fixed assigning arguments to slots in the frame; also fixed a bug in bind...

But did that by switching away from using Lisp calling convention, because
that broke horribly. This is bad news and must be sorted out.
This commit is contained in:
Simon Brooke 2026-04-16 17:13:20 +01:00
parent cb3dcb352e
commit f915a9993f
14 changed files with 158 additions and 112 deletions

View file

@ -39,11 +39,13 @@
* @return struct pso_pointer a pointer to the newly allocated object
*/
struct pso_pointer allocate( char *tag, uint8_t size_class ) {
// `t`, because if `allocate_page` fails it will be set to `nil`.
// `t`, because if `allocate_page` fails it will be set to `nil`.
struct pso_pointer result = t;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, L"Allocating object of size class %d with tag `%s`... ", size_class, tag);
debug_printf( DEBUG_ALLOC, 0,
L"Allocating object of size class %d with tag `%s`... ",
size_class, tag );
#endif
if ( size_class <= MAX_SIZE_CLASS ) {
@ -51,14 +53,14 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
result = allocate_page( size_class );
}
if (nilp(result)) {
fputws( L"FATAL: Page space exhausted\n", stderr );
exit(1); // TODO: we don't want to do this! Somehow, we need to
// recover a workable environment, ideally by throwing a pre-made
// exception.
if ( nilp( result ) ) {
fputws( L"FATAL: Page space exhausted\n", stderr );
exit( 1 ); // TODO: we don't want to do this! Somehow, we need to
// recover a workable environment, ideally by throwing a pre-made
// exception.
}
if ( !exceptionp( result ) && !nilp(result)) {
if ( !exceptionp( result ) && !nilp( result ) ) {
result = freelists[size_class];
struct pso2 *object = pointer_to_object( result );
freelists[size_class] = object->payload.free.next;
@ -66,7 +68,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
TAGLENGTH );
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, result.offset);
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ",
result.page, result.offset );
/* the object ought already to have the right size class in its tag
* because it was popped off the freelist for that size class. */
@ -82,7 +85,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
} // TODO: else throw exception
#ifdef DEBUG
debug_print(exceptionp(result)? L"fail\n" : L"success\n", DEBUG_ALLOC, 0);
debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC,
0 );
#endif
return result;
@ -137,7 +141,8 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
struct pso_pointer dec_ref( struct pso_pointer pointer ) {
struct pso2 *object = pointer_to_object( pointer );
if ( !nilp(pointer) && object->header.count > 0 && object->header.count != MAXREFERENCE ) {
if ( !nilp( pointer ) && object->header.count > 0
&& object->header.count != MAXREFERENCE ) {
object->header.count--;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,