Compare commits
3 commits
04aa32bd5a
...
cb3dcb352e
| Author | SHA1 | Date | |
|---|---|---|---|
| cb3dcb352e | |||
| ba985474f6 | |||
| b5a2e09763 |
9 changed files with 232 additions and 52 deletions
|
|
@ -123,7 +123,6 @@ void debug_printf( int level, int indent, wchar_t *format, ... ) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
if ( level & verbosity ) {
|
if ( level & verbosity ) {
|
||||||
fwide( stderr, 1 );
|
fwide( stderr, 1 );
|
||||||
fputws( L"\n", stderr );
|
|
||||||
for ( int i = 0; i < indent; i++ ) {
|
for ( int i = 0; i < indent; i++ ) {
|
||||||
fputws( L" ", stderr );
|
fputws( L" ", stderr );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -25,6 +25,8 @@
|
||||||
#include "payloads/exception.h"
|
#include "payloads/exception.h"
|
||||||
#include "payloads/psse_string.h"
|
#include "payloads/psse_string.h"
|
||||||
|
|
||||||
|
#include "ops/truth.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief Flag to prevent re-initialisation.
|
* @brief Flag to prevent re-initialisation.
|
||||||
*/
|
*/
|
||||||
|
|
@ -40,7 +42,7 @@ bool environment_initialised = false;
|
||||||
struct pso_pointer initialise_environment( uint32_t node ) {
|
struct pso_pointer initialise_environment( uint32_t node ) {
|
||||||
struct pso_pointer result = initialise_memory( node );
|
struct pso_pointer result = initialise_memory( node );
|
||||||
|
|
||||||
if ( !exceptionp( result ) ) {
|
if ( truep( result ) ) {
|
||||||
debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0);
|
debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0);
|
||||||
struct pso_pointer n = allocate( NILTAG, 2 );
|
struct pso_pointer n = allocate( NILTAG, 2 );
|
||||||
|
|
||||||
|
|
@ -50,6 +52,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
||||||
object->payload.cons.cdr = nil;
|
object->payload.cons.cdr = nil;
|
||||||
|
|
||||||
nil = n;
|
nil = n;
|
||||||
|
lock_object( nil);
|
||||||
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
|
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
|
||||||
} else {
|
} else {
|
||||||
result =
|
result =
|
||||||
|
|
@ -63,12 +66,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
||||||
debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0);
|
debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0);
|
||||||
struct pso_pointer n = allocate( TRUETAG, 2 );
|
struct pso_pointer n = allocate( TRUETAG, 2 );
|
||||||
|
|
||||||
if ( ( n.page == 0 ) && ( n.offset == 1 ) ) {
|
// offset is in words, and size of a pso2 is four words
|
||||||
|
if ( ( n.page == 0 ) && ( n.offset == 4 ) ) {
|
||||||
struct pso2 *object = pointer_to_object( n );
|
struct pso2 *object = pointer_to_object( n );
|
||||||
object->payload.string.character = L't';
|
object->payload.string.character = L't';
|
||||||
object->payload.cons.cdr = t;
|
object->payload.cons.cdr = t;
|
||||||
|
|
||||||
t = n;
|
t = n;
|
||||||
|
lock_object(t);
|
||||||
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
|
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
|
||||||
} else {
|
} else {
|
||||||
result =
|
result =
|
||||||
|
|
@ -83,6 +88,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
||||||
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
|
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
|
||||||
|
|
||||||
environment_initialised = true;
|
environment_initialised = true;
|
||||||
|
debug_print( L"\nEnvironment initialised successfully.\n", DEBUG_BOOTSTRAP, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
|
|
|
||||||
|
|
@ -41,9 +41,10 @@ struct pso_pointer nil = ( struct pso_pointer ) { 0, 0, 0 };
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief the canonical `t` (true) pointer.
|
* @brief the canonical `t` (true) pointer.
|
||||||
*
|
* Offset 4, because `t` should be the second pso2 allocated, the offset is
|
||||||
|
* given in words, and the size of a pso2 should be four words.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 1 };
|
struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 };
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
|
||||||
|
|
@ -36,6 +36,8 @@
|
||||||
|
|
||||||
#include "payloads/free.h"
|
#include "payloads/free.h"
|
||||||
|
|
||||||
|
#include "ops/truth.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief The pages which have so far been initialised.
|
* @brief The pages which have so far been initialised.
|
||||||
*
|
*
|
||||||
|
|
@ -51,6 +53,178 @@ union page *pages[NPAGES];
|
||||||
*/
|
*/
|
||||||
uint32_t npages_allocated = 0;
|
uint32_t npages_allocated = 0;
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 2.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso2_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
// we do this backwards (i--) so that object {0, 0, 0} will be first on the
|
||||||
|
// freelist when the first page is initiated, so we can grab that one for
|
||||||
|
// `nil` and the next on for `t`.
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso2 *object =
|
||||||
|
( struct pso2 * ) &page_addr->pso2s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 3.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso3_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso3 *object =
|
||||||
|
( struct pso3 * ) &page_addr->pso3s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 4.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso4_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso4 *object =
|
||||||
|
( struct pso4 * ) &page_addr->pso4s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 5.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso5_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso5 *object =
|
||||||
|
( struct pso5 * ) &page_addr->pso5s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 6.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso6_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso6 *object =
|
||||||
|
( struct pso6 * ) &page_addr->pso6s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Initialise arrays for objects of different size classes, in this case class 7.
|
||||||
|
* This is boilerplate code and there must be some way of doing it better, but I don't
|
||||||
|
* know it. Macro?
|
||||||
|
*/
|
||||||
|
struct pso_pointer initialise_pso7_array(union page *page_addr, uint16_t page_index,
|
||||||
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
|
struct pso_pointer result = freelist;
|
||||||
|
int obj_size = pow( 2, size_class );
|
||||||
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
||||||
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
|
struct pso7 *object =
|
||||||
|
( struct pso7 * ) &page_addr->pso7s[i];
|
||||||
|
object->header.tag.bytes.size_class = size_class;
|
||||||
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
|
object->payload.free.next = result;
|
||||||
|
|
||||||
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief private to allocate_page; do not use.
|
* @brief private to allocate_page; do not use.
|
||||||
*
|
*
|
||||||
|
|
@ -63,7 +237,7 @@ uint32_t npages_allocated = 0;
|
||||||
struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
|
struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
|
||||||
uint8_t size_class,
|
uint8_t size_class,
|
||||||
struct pso_pointer freelist ) {
|
struct pso_pointer freelist ) {
|
||||||
struct pso_pointer result = freelist;
|
struct pso_pointer result = nil;
|
||||||
int obj_size = pow( 2, size_class );
|
int obj_size = pow( 2, size_class );
|
||||||
int obj_bytes = obj_size * sizeof( uint64_t );
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
int objs_in_page = PAGE_BYTES / obj_bytes;
|
int objs_in_page = PAGE_BYTES / obj_bytes;
|
||||||
|
|
@ -72,25 +246,18 @@ struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
|
||||||
L"Initialising page %d for objects of size class %d...",
|
L"Initialising page %d for objects of size class %d...",
|
||||||
page_index, size_class);
|
page_index, size_class);
|
||||||
|
|
||||||
// we do this backwards (i--) so that object {0, 0, 0} will be first on the
|
switch (size_class) {
|
||||||
// freelist when the first page is initiated, so we can grab that one for
|
case 2: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
// `nil` and the next on for `t`.
|
case 3: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
case 4: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
// it should be safe to cast any pso object to a pso2
|
case 5: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
struct pso2 *object =
|
case 6: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
( struct pso2 * ) ( page_addr + ( i * obj_bytes ) );
|
case 7: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
|
||||||
|
default:
|
||||||
object->header.tag.bytes.size_class = size_class;
|
result = nil;
|
||||||
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
|
||||||
TAGLENGTH );
|
|
||||||
object->payload.free.next = result;
|
|
||||||
|
|
||||||
result =
|
|
||||||
make_pointer( node_index, page_index,
|
|
||||||
( uint16_t ) ( i * obj_size ) );
|
|
||||||
}
|
}
|
||||||
|
|
||||||
debug_print( L"page allocated.\n", DEBUG_ALLOC, 0);
|
debug_print( nilp(result)? L"fail.\n" : L"success.\n", DEBUG_ALLOC, 0);
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
@ -120,22 +287,19 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
|
||||||
memset( pg, 0, sizeof( union page ) );
|
memset( pg, 0, sizeof( union page ) );
|
||||||
pages[npages_allocated] = pg;
|
pages[npages_allocated] = pg;
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"Allocated page %d for objects of size class %x.\n",
|
L"\nAllocated page %d for objects of size class %x.\n",
|
||||||
npages_allocated, size_class );
|
npages_allocated, size_class );
|
||||||
|
|
||||||
freelists[size_class] =
|
freelists[size_class] =
|
||||||
initialise_page( ( union page * ) pg, npages_allocated,
|
initialise_page( ( union page * ) pg, npages_allocated,
|
||||||
size_class, freelists[size_class] );
|
size_class, freelists[size_class] );
|
||||||
|
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
// result = freelists[size_class];
|
||||||
L"Initialised page %d; freelist for size class %x updated.\n",
|
|
||||||
npages_allocated, size_class );
|
|
||||||
|
|
||||||
if ( npages_allocated == 0 ) {
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
// first page allocated; initialise nil and t
|
L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n",
|
||||||
nil = lock_object( allocate( NILTAG, 2 ) );
|
npages_allocated, size_class,
|
||||||
t = lock_object( allocate( TRUETAG, 2 ) );
|
freelists[size_class].page, freelists[size_class].offset);
|
||||||
}
|
|
||||||
|
|
||||||
npages_allocated++;
|
npages_allocated++;
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
|
|
@ -15,6 +15,7 @@
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <stdbool.h>
|
#include <stdbool.h>
|
||||||
|
#include <stdlib.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
#include "debug.h"
|
#include "debug.h"
|
||||||
|
|
@ -38,7 +39,8 @@
|
||||||
* @return struct pso_pointer a pointer to the newly allocated object
|
* @return struct pso_pointer a pointer to the newly allocated object
|
||||||
*/
|
*/
|
||||||
struct pso_pointer allocate( char *tag, uint8_t size_class ) {
|
struct pso_pointer allocate( char *tag, uint8_t size_class ) {
|
||||||
struct pso_pointer result = nil;
|
// `t`, because if `allocate_page` fails it will be set to `nil`.
|
||||||
|
struct pso_pointer result = t;
|
||||||
|
|
||||||
#ifdef DEBUG
|
#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);
|
||||||
|
|
@ -49,7 +51,14 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
|
||||||
result = allocate_page( size_class );
|
result = allocate_page( size_class );
|
||||||
}
|
}
|
||||||
|
|
||||||
if ( !exceptionp( result ) && not( freelists[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 ( !exceptionp( result ) && !nilp(result)) {
|
||||||
result = freelists[size_class];
|
result = freelists[size_class];
|
||||||
struct pso2 *object = pointer_to_object( result );
|
struct pso2 *object = pointer_to_object( result );
|
||||||
freelists[size_class] = object->payload.free.next;
|
freelists[size_class] = object->payload.free.next;
|
||||||
|
|
@ -57,6 +66,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
|
||||||
strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
|
strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
|
||||||
TAGLENGTH );
|
TAGLENGTH );
|
||||||
|
|
||||||
|
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
|
/* the object ought already to have the right size class in its tag
|
||||||
* because it was popped off the freelist for that size class. */
|
* because it was popped off the freelist for that size class. */
|
||||||
if ( object->header.tag.bytes.size_class != size_class ) {
|
if ( object->header.tag.bytes.size_class != size_class ) {
|
||||||
|
|
@ -67,7 +78,6 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
|
||||||
if ( object->header.count != 0 ) {
|
if ( object->header.count != 0 ) {
|
||||||
// TODO: return an exception instead? Or warn, set it, and continue?
|
// TODO: return an exception instead? Or warn, set it, and continue?
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
} // TODO: else throw exception
|
} // TODO: else throw exception
|
||||||
|
|
||||||
|
|
@ -127,11 +137,11 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
|
||||||
struct pso_pointer dec_ref( struct pso_pointer pointer ) {
|
struct pso_pointer dec_ref( struct pso_pointer pointer ) {
|
||||||
struct pso2 *object = pointer_to_object( pointer );
|
struct pso2 *object = pointer_to_object( pointer );
|
||||||
|
|
||||||
if ( object->header.count > 0 && object->header.count != MAXREFERENCE ) {
|
if ( !nilp(pointer) && object->header.count > 0 && object->header.count != MAXREFERENCE ) {
|
||||||
object->header.count--;
|
object->header.count--;
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"\nDecremented object of type %4.4s at page %d, offset %d to count %d",
|
L"\nDecremented object of type %3.3s at page %d, offset %d to count %d",
|
||||||
( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
|
( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
|
||||||
pointer.page, pointer.offset, object->header.count );
|
pointer.page, pointer.offset, object->header.count );
|
||||||
if ( vectorpointp( pointer ) ) {
|
if ( vectorpointp( pointer ) ) {
|
||||||
|
|
|
||||||
|
|
@ -73,7 +73,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
||||||
char *tag ) {
|
char *tag ) {
|
||||||
struct pso_pointer pointer = nil;
|
struct pso_pointer pointer = nil;
|
||||||
|
|
||||||
if ( check_type( tail, tag ) || check_tag( tail, NILTV ) ) {
|
if ( check_type( tail, tag ) || nilp(tail) ) {
|
||||||
pointer = allocate( tag, CONS_SIZE_CLASS );
|
pointer = allocate( tag, CONS_SIZE_CLASS );
|
||||||
struct pso2 *cell = pointer_to_object( pointer );
|
struct pso2 *cell = pointer_to_object( pointer );
|
||||||
|
|
||||||
|
|
@ -85,9 +85,10 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
||||||
debug_println( DEBUG_ALLOC );
|
debug_println( DEBUG_ALLOC );
|
||||||
} else {
|
} else {
|
||||||
// \todo should throw an exception!
|
// \todo should throw an exception!
|
||||||
|
struct pso2* tobj = pointer_to_object( tail);
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"Warning: only %4.4s can be prepended to %4.4s\n",
|
L"Warning: %3.3s cannot be prepended to %3.3s\n",
|
||||||
tag, tag );
|
tag, tobj->header.tag.bytes.mnemonic );
|
||||||
}
|
}
|
||||||
|
|
||||||
return pointer;
|
return pointer;
|
||||||
|
|
@ -126,7 +127,7 @@ struct pso_pointer make_keyword( wint_t c, struct pso_pointer tail ) {
|
||||||
* @param tail the symbol which is being built.
|
* @param tail the symbol which is being built.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer make_symbol( wint_t c, struct pso_pointer tail ) {
|
struct pso_pointer make_symbol( wint_t c, struct pso_pointer tail ) {
|
||||||
return make_string_like_thing( c, tail, STRINGTAG );
|
return make_string_like_thing( c, tail, SYMBOLTAG );
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -49,12 +49,15 @@ bool not( struct pso_pointer p ) {
|
||||||
* each is considered equivalent. So we don't check the node when considering
|
* each is considered equivalent. So we don't check the node when considering
|
||||||
* whether `nil` really is `nil`, or `t` really is `t`.
|
* whether `nil` really is `nil`, or `t` really is `t`.
|
||||||
*
|
*
|
||||||
|
* Note that the offset is 4 because `t` should be the second pso2 allocated,
|
||||||
|
* the offset is given in words, and the size of a pso2 should be four words
|
||||||
|
*
|
||||||
* @param p a pointer
|
* @param p a pointer
|
||||||
* @return true if `p` points to `t`.
|
* @return true if `p` points to `t`.
|
||||||
* @return false otherwise.
|
* @return false otherwise.
|
||||||
*/
|
*/
|
||||||
bool truep( struct pso_pointer p ) {
|
bool truep( struct pso_pointer p ) {
|
||||||
return ( p.page == 0 && p.offset == 1 );
|
return ( p.page == 0 && p.offset == 4 );
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
|
||||||
|
|
@ -33,8 +33,6 @@ struct string_payload {
|
||||||
struct pso_pointer cdr;
|
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 destroy_string( struct pso_pointer fp,
|
||||||
struct pso_pointer env );
|
struct pso_pointer env );
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -78,19 +78,17 @@ struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
|
||||||
struct pso_pointer env ) {
|
struct pso_pointer env ) {
|
||||||
if ( stackp( fp ) ) {
|
if ( stackp( fp ) ) {
|
||||||
struct pso4 *frame = pointer_to_pso4( 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( frame->payload.stack_frame.previous );
|
||||||
dec_ref( casualty->payload.stack_frame.function );
|
dec_ref( frame->payload.stack_frame.function );
|
||||||
dec_ref( casualty->payload.stack_frame.more );
|
dec_ref( frame->payload.stack_frame.more );
|
||||||
|
|
||||||
for ( int i = 0; i < args_in_frame; i++ ) {
|
for ( int i = 0; i < args_in_frame; i++ ) {
|
||||||
dec_ref( casualty->payload.stack_frame.arg[i] );
|
dec_ref( frame->payload.stack_frame.arg[i] );
|
||||||
}
|
}
|
||||||
|
|
||||||
casualty->payload.stack_frame.args = 0;
|
frame->payload.stack_frame.args = 0;
|
||||||
casualty->payload.stack_frame.depth = 0;
|
frame->payload.stack_frame.depth = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
return nil;
|
return nil;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue