diff --git a/src/c/io/io.c b/src/c/io/io.c index 96089fa..3d4de7c 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -167,7 +167,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) { env ); lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ), - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword ( L"url" ), c_string_to_lisp_string @@ -182,7 +182,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) { lisp_stdout = lock_object( make_write_stream ( file_to_url_file( stdout ), - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword( L"url" ), c_string_to_lisp_string ( L"::system:standard-output" ) ), @@ -195,7 +195,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) { lisp_stderr = lock_object( make_write_stream ( file_to_url_file( stderr ), - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword( L"url" ), c_string_to_lisp_string ( L"::system:standard-output" ) ), @@ -422,7 +422,7 @@ struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key, long int value ) { // todo: issue #21: must have stack frame passed in. return - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword( key ), make_integer( value ) ), meta ); } @@ -435,7 +435,7 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key, mbstowcs( buffer, value, strlen( value ) + 1 ); return - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword( key ), c_string_to_lisp_string( buffer ) ), meta ); } diff --git a/src/c/memory/memory.c b/src/c/memory/memory.c index eaeecbd..b4b84cd 100644 --- a/src/c/memory/memory.c +++ b/src/c/memory/memory.c @@ -7,18 +7,23 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include +#include +#include #include "debug.h" #include "memory/memory.h" #include "memory/node.h" +#include "memory/page.h" #include "memory/pointer.h" #include "memory/pso.h" #include "memory/pso2.h" #include "memory/tags.h" +#include "ops/truth.h" #include "payloads/exception.h" #include "ops/bind.h" @@ -29,6 +34,11 @@ */ struct pso_pointer freelists[MAX_SIZE_CLASS]; +/** + * Mutices to lock the freelists during access. + */ +pthread_mutex_t freelists_mutices[MAX_SIZE_CLASS]; + /** * @brief Flag to prevent re-initialisation. */ @@ -63,3 +73,64 @@ struct pso_pointer initialise_memory( uint32_t node ) { return t; } + +/** + * @brief Pop an object off the freelist for the specified `size_class`. + */ +struct pso_pointer pop_freelist( uint8_t size_class) { + // `t`, because if `allocate_page` fails it will be set to `nil`. + struct pso_pointer result = t; + + if ( size_class <= MAX_SIZE_CLASS ) { + if ( nilp( freelists[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 ( !exceptionp( result ) && !nilp( result ) ) { + pthread_mutex_lock( &freelists_mutices[size_class]); + result = freelists[size_class]; + struct pso2 *object = pointer_to_object( result ); + freelists[size_class] = object->payload.free.next; + pthread_mutex_unlock(&freelists_mutices[size_class]); + + /* the object ought already to have the right size class in its tag + * because it was popped off the freelist for that size class. */ + if ( object->header.tag.bytes.size_class != size_class ) { + // TODO: return an exception instead? Or warn, set it, and continue? + } + /* the objext ought to have a reference count ot zero, because it's + * on the freelist, but again we should sanity check. */ + if ( object->header.count != 0 ) { + fwprintf( stderr, + L"WARNING: Request to allocate object of size class %d, which is not implemented", + size_class); + } + } + } // TODO: else throw exception + + return result; +} + +void push_freelist( struct pso_pointer p) { + struct pso2 *obj = pointer_to_object( p ); + uint8_t size_class = ( obj->header.tag.bytes.size_class ); + + strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG, + TAGLENGTH ); + + pthread_mutex_lock( &freelists_mutices[size_class]); + + if ( size_class <= MAX_SIZE_CLASS ) { + obj->payload.free.next = freelists[size_class]; + freelists[size_class] = p; + } + + pthread_mutex_unlock(&freelists_mutices[size_class]); +} diff --git a/src/c/memory/memory.h b/src/c/memory/memory.h index 5911f2f..720bf1d 100644 --- a/src/c/memory/memory.h +++ b/src/c/memory/memory.h @@ -9,6 +9,7 @@ #ifndef __psse_memory_memory_h #define __psse_memory_memory_h +#include #include "memory/pointer.h" @@ -25,6 +26,10 @@ struct pso_pointer initialise_memory( ); +struct pso_pointer pop_freelist( uint8_t size_class); +void push_freelist( struct pso_pointer p); + extern struct pso_pointer out_of_memory_exception; extern struct pso_pointer freelists[]; +extern pthread_mutex_t freelists_mutices[]; #endif diff --git a/src/c/memory/page.c b/src/c/memory/page.c index 0b03b35..2cc12c7 100644 --- a/src/c/memory/page.c +++ b/src/c/memory/page.c @@ -319,11 +319,11 @@ struct pso_pointer allocate_page( uint8_t size_class ) { L"\nAllocated page %d for objects of size class %x.\n", npages_allocated, size_class ); + pthread_mutex_lock( &freelists_mutices[size_class]); freelists[size_class] = initialise_page( ( union page * ) pg, npages_allocated, size_class, freelists[size_class] ); - -// result = freelists[size_class]; + pthread_mutex_unlock( &freelists_mutices[size_class]); debug_printf( DEBUG_ALLOC, 0, L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n", diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index df2d4de..1a25c26 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -19,6 +19,7 @@ #include #include #include +#include #include "debug.h" @@ -35,15 +36,24 @@ /** * @brief Allocate an object of this size_class with this tag. + * + * All objects that are allocated (after completion of init)) should be linked + * onto the `locals` slot on a stack frame. This guarantees + * 1. that they get `inc_ref`ed; and that, + * 2. if nothing else hangs onto them they will be reclaimed when that stack + * frame is reclaimed. + * for some objects (e.g. those cons cells on the locals list) this isn't + * possible due to infinite recursion, but those special cases need to be + * audited carefully * + * @param stack_pointer C (NOT Lisp!) pointer to an active stack frame (or + * NULL, but only during initialisation). * @param tag The tag. Only the first three bytes will be used; * @param size_class The size class for the object to be allocated; * @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( /* struct pso4 * stack_pointer,*/ char *tag, uint8_t size_class ) { // todo: issue #21: must have stack frame passed in. - // `t`, because if `allocate_page` fails it will be set to `nil`. - struct pso_pointer result = t; #ifdef DEBUG debug_printf( DEBUG_ALLOC, 0, @@ -51,41 +61,26 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) { size_class, tag ); #endif - if ( size_class <= MAX_SIZE_CLASS ) { - if ( nilp( freelists[size_class] ) ) { - result = allocate_page( size_class ); - } + struct pso_pointer result = pop_freelist(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]; - struct pso2 *object = pointer_to_object( result ); - freelists[size_class] = object->payload.free.next; - - strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag, - 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 - * because it was popped off the freelist for that size class. */ - if ( object->header.tag.bytes.size_class != size_class ) { - // TODO: return an exception instead? Or warn, set it, and continue? - } - /* the objext ought to have a reference count ot zero, because it's - * on the freelist, but again we should sanity check. */ - if ( object->header.count != 0 ) { - // TODO: return an exception instead? Or warn, set it, and continue? - } - } - } // TODO: else throw exception + if (!nilp( result)) { + strncpy( ( char * ) ( pointer_to_object(result)->header.tag.bytes.mnemonic ), tag, + TAGLENGTH ); + + debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", + result.page, result.offset ); +// if ( stack_pointer != NULL && +// (stack_pointer->header.tag.value & 0xffffff) == STACKTV) { +// struct pso_pointer locals = make_cons(result, +// stack_pointer->payload.stack_frame.locals); +// stack_pointer->payload.stack_frame.locals = locals; +// +// } else { +// fputws( L"WARNING: No stack frame passed to `allocate`.\n", stderr); +// } + } else { + // TODO: throw exception + } #ifdef DEBUG debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC, @@ -208,19 +203,7 @@ struct pso_pointer free_object( struct pso_pointer p ) { obj->payload.words[i] = 0; } - - - strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG, - TAGLENGTH ); -#ifdef DEBUG - debug_printf( DEBUG_ALLOC, 0, - L"Freeing object of size class %d at {%d, %d, %d}", - size_class, p.node, p.page, p.offset ); -#endif - - /* TODO: obtain mutex on freelist */ - obj->payload.free.next = freelists[size_class]; - freelists[size_class] = p; + push_freelist(p); return result; } diff --git a/src/c/ops/bind.c b/src/c/ops/bind.c index b048658..e34122c 100644 --- a/src/c/ops/bind.c +++ b/src/c/ops/bind.c @@ -35,12 +35,12 @@ struct pso_pointer lisp_bind( struct pso_pointer value = fetch_arg( frame, 1 ); struct pso_pointer store = fetch_arg( frame, 2 ); - return c_cons( c_cons( key, value ), store ); + return make_cons( make_cons( key, value ), 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 c_cons( c_cons( key, value ), store ); + return make_cons( make_cons( key, value ), store ); } diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index 9333a03..819a2eb 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -84,11 +84,11 @@ struct pso_pointer eval( // break; default: result = - make_exception( c_cons + make_exception( make_cons ( c_string_to_lisp_string ( L"Can't yet evaluate things of this type: " ), result ), frame_pointer, - c_cons( c_cons + make_cons( make_cons ( c_string_to_lisp_keyword( L"tag" ), get_tag_string( result ) ), nil ), nil ); diff --git a/src/c/ops/list_ops.c b/src/c/ops/list_ops.c index 10ccc60..4e58600 100644 --- a/src/c/ops/list_ops.c +++ b/src/c/ops/list_ops.c @@ -66,7 +66,7 @@ struct pso_pointer cons( struct pso4 *frame = pointer_to_pso4( frame_pointer ); #endif - return c_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) ); + return make_cons( fetch_arg( frame, 0 ), fetch_arg( frame, 1 ) ); } #endif diff --git a/src/c/ops/repl.c b/src/c/ops/repl.c index 5af6136..c3fa5a1 100644 --- a/src/c/ops/repl.c +++ b/src/c/ops/repl.c @@ -52,7 +52,7 @@ void c_repl( bool show_prompt ) { signal( SIGINT, int_handler ); debug_print( L"Entered repl\n", DEBUG_REPL, 0 ); - struct pso_pointer env = consp( oblist ) ? oblist : c_cons( oblist, nil ); + struct pso_pointer env = consp( oblist ) ? oblist : make_cons( oblist, nil ); struct pso_pointer input_stream = c_assoc( lisp_io_in, env ); struct pso_pointer output_stream = c_assoc( lisp_io_out, env ); diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index 43ea132..4e2704b 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -44,7 +44,7 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) { struct pso2 *object = pointer_to_object( cursor ); switch ( get_tag_value( cursor ) ) { case CONSTV: - result = c_cons( c_car( cursor ), result ); + result = make_cons( c_car( cursor ), result ); break; case KEYTV: // TODO: should you be able to reverse keywords and symbols? @@ -65,7 +65,7 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) { break; default: result = - make_exception( c_cons( c_string_to_lisp_string + make_exception( make_cons( c_string_to_lisp_string ( L"Invalid object in sequence" ), cursor ), nil, nil, nil ); goto exit; diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 04e5251..8a05088 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -30,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 c_cons(struct pso_pointer car, struct pso_pointer cdr) { +struct pso_pointer make_cons(struct pso_pointer car, struct pso_pointer cdr) { // todo: issue #21: must have stack frame passed in. struct pso_pointer result = allocate( CONSTAG, 2 ); @@ -84,7 +84,7 @@ struct pso_pointer c_cdr(struct pso_pointer p) { break; default: result = - make_exception( c_cons + make_exception( make_cons ( c_string_to_lisp_string ( L"Invalid type for cdr" ), get_tag_string( p ) ), nil, nil, nil ); diff --git a/src/c/payloads/cons.h b/src/c/payloads/cons.h index 61eaf87..0192f4e 100644 --- a/src/c/payloads/cons.h +++ b/src/c/payloads/cons.h @@ -31,7 +31,7 @@ struct pso_pointer c_car( struct pso_pointer cons ); struct pso_pointer c_cdr( struct pso_pointer cons ); // todo: issue #21: must have stack frame passed in. -struct pso_pointer c_cons( struct pso_pointer car, struct pso_pointer cdr ); +struct pso_pointer make_cons( struct pso_pointer car, struct pso_pointer cdr ); struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env ); diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index d59ce85..89fb617 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -72,7 +72,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, for ( ; cursor < arg_count; cursor++ ) { more_args = - c_cons( va_arg( args, struct pso_pointer ), more_args ); + make_cons( va_arg( args, struct pso_pointer ), more_args ); } frame->payload.stack_frame.more = c_reverse( more_args ); diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index 3cbb853..ed02588 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -31,6 +31,10 @@ struct stack_frame_payload { struct pso_pointer more; /** the function to be called. */ struct pso_pointer function; + /** the execute-time environment */ + struct pso_pointer env; + /** a list of objects created in the context of this frame */ + struct pso_pointer locals; /** the number of arguments provided. */ uint32_t args; /** the depth of the stack below this frame */