From 22fa7314d6b429aae7bb41d23bc7ca56ba0bc337 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 20 Jan 2019 19:44:56 +0000 Subject: [PATCH] Mostly fixing and standardising documentation. --- Doxyfile | 14 +- src/arith/integer.c | 43 +++-- src/arith/integer.h | 5 +- src/arith/peano.c | 46 +++-- src/arith/peano.h | 6 +- src/arith/ratio.c | 37 ++-- src/init.c | 22 ++- src/memory/conspage.c | 130 +++++++------ src/memory/conspage.h | 26 --- src/memory/consspaceobject.c | 26 ++- src/memory/consspaceobject.h | 359 ++++++++++++++++++++-------------- src/memory/dump.c | 1 - src/memory/dump.h | 5 +- src/memory/stack.c | 25 +-- src/memory/stack.h | 8 +- src/memory/vectorspace.c | 31 ++- src/memory/vectorspace.h | 46 +++-- src/ops/intern.c | 3 +- src/ops/intern.h | 29 +-- src/ops/lispops.c | 361 +++++++++++++++++++++++------------ src/ops/lispops.h | 5 +- src/ops/print.c | 12 +- src/ops/read.c | 8 +- unit-tests/string-cons.sh | 25 +++ 24 files changed, 770 insertions(+), 503 deletions(-) create mode 100644 unit-tests/string-cons.sh diff --git a/Doxyfile b/Doxyfile index 955cb32..e283f9a 100644 --- a/Doxyfile +++ b/Doxyfile @@ -135,7 +135,7 @@ ABBREVIATE_BRIEF = "The $name class" \ # description. # The default value is: NO. -ALWAYS_DETAILED_SEC = NO +ALWAYS_DETAILED_SEC = YES # If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all # inherited members of a class in the documentation of that class as if those @@ -162,7 +162,7 @@ FULL_PATH_NAMES = YES # will be relative from the directory where doxygen is started. # This tag requires that the tag FULL_PATH_NAMES is set to YES. -STRIP_FROM_PATH = +STRIP_FROM_PATH = src/ # The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the # path mentioned in the documentation of a class, which tells the reader which @@ -187,7 +187,7 @@ SHORT_NAMES = NO # description.) # The default value is: NO. -JAVADOC_AUTOBRIEF = NO +JAVADOC_AUTOBRIEF = YES # If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first # line (until the first dot) of a Qt-style comment as the brief description. If @@ -397,7 +397,7 @@ INLINE_GROUPED_CLASSES = NO # Man pages) or section (for LaTeX and RTF). # The default value is: NO. -INLINE_SIMPLE_STRUCTS = NO +INLINE_SIMPLE_STRUCTS = YES # When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or # enum is documented as struct, union, or enum with the name of the typedef. So @@ -578,7 +578,7 @@ SORT_MEMBER_DOCS = YES # this will also influence the order of the classes in the class list. # The default value is: NO. -SORT_BRIEF_DOCS = NO +SORT_BRIEF_DOCS = YES # If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the # (brief and detailed) documentation of class members so that constructors and @@ -790,7 +790,7 @@ WARN_LOGFILE = doxy.log # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. -INPUT = src src/arith src/memory src/ops +INPUT = src # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses @@ -864,7 +864,7 @@ FILE_PATTERNS = *.c \ # be searched for input files as well. # The default value is: NO. -RECURSIVE = NO +RECURSIVE = YES # The EXCLUDE tag can be used to specify files and/or directories that should be # excluded from the INPUT source files. This way you can easily exclude a diff --git a/src/arith/integer.c b/src/arith/integer.c index b5ed859..c51bc56 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -41,13 +41,12 @@ const char *hex_digits = "0123456789ABCDEF"; /* * Doctrine from here on in is that ALL integers are bignums, it's just * that integers less than 65 bits are bignums of one cell only. - * - * TODO: I have no idea at all how I'm going to print bignums! */ /** - * return the numeric value of this cell, as a C primitive double, not - * as a cons-space object. Cell may in principle be any kind of number. + * return the numeric value of the cell indicated by this `pointer`, as a C + * primitive double, not as a cons_space_object. The indicated cell may in + * principle be any kind of number; if it is not a number, will return `NAN`. */ long double numeric_value( struct cons_pointer pointer ) { long double result = NAN; @@ -75,7 +74,10 @@ long double numeric_value( struct cons_pointer pointer ) { } /** - * Allocate an integer cell representing this value and return a cons pointer to it. + * Allocate an integer cell representing this `value` and return a cons_pointer to it. + * @param value an integer value; + * @param more `NIL`, or a pointer to the more significant cell(s) of this number. + * *NOTE* that if `more` is not `NIL`, `value` *must not* exceed `MAX_INTEGER`. */ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) { struct cons_pointer result = NIL; @@ -94,7 +96,13 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) { return result; } - +/** + * Internal to `operate_on_integers`, do not use. + * @param c a pointer to a cell, assumed to be an integer cell; + * @param op a character representing the operation: expectedto be either + * '+' or '*'; behaviour with other values is undefined. + * \see operate_on_integers + */ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { long int val = nilp( c ) ? 0 : pointer2cell( c ).payload.integer.value; long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 ); @@ -115,8 +123,15 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { * possibly, later, other operations. Apply the operator `op` to the * integer arguments `a` and `b`, and return a pointer to the result. If * either `a` or `b` is not an integer, returns `NIL`. + * + * @param a a pointer to a cell, assumed to be an integer cell; + * @param b a pointer to a cell, assumed to be an integer cell; + * @param op a character representing the operation: expected to be either + * '+' or '*'; behaviour with other values is undefined. + * \see add_integers + * \see multiply_integers */ -/* TODO: there is a significant bug here, which manifests in multiply but +/* \todo there is a significant bug here, which manifests in multiply but * may not manifest in add. The value in the least significant cell ends * up significantly WRONG, but the value in the more significant cell * ends up correct. */ @@ -148,7 +163,7 @@ struct cons_pointer operate_on_integers( struct cons_pointer a, switch ( op ) { case '*': - rv = av * bv * ( ( carry == 0 ) ? 1 : carry ); + rv = av * ( bv + carry ); break; case '+': rv = av + bv + carry; @@ -170,7 +185,7 @@ struct cons_pointer operate_on_integers( struct cons_pointer a, if ( MAX_INTEGER >= rv ) { carry = 0; } else { - // TODO: we're correctly detecting overflow, but not yet correctly + // \todo we're correctly detecting overflow, but not yet correctly // handling it. carry = rv >> 60; debug_printf( DEBUG_ARITH, @@ -210,8 +225,8 @@ struct cons_pointer operate_on_integers( struct cons_pointer a, } /** - * Return the sum of the integers pointed to by `a` and `b`. If either isn't - * an integer, will return nil. + * Return a pointer to an integer representing the sum of the integers + * pointed to by `a` and `b`. If either isn't an integer, will return nil. */ struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer b ) { @@ -220,8 +235,8 @@ struct cons_pointer add_integers( struct cons_pointer a, } /** - * Return the product of the integers pointed to by `a` and `b`. If either isn't - * an integer, will return nil. + * Return a pointer to an integer representing the product of the integers + * pointed to by `a` and `b`. If either isn't an integer, will return nil. */ struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b ) { @@ -253,7 +268,7 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits, * to be looking to the next. H'mmmm. */ /* - * TODO: this blows up when printing three-cell integers, but works fine + * \todo this blows up when printing three-cell integers, but works fine * for two-cell. What's happening is that when we cross the barrier we * SHOULD print 2^120, but what we actually print is 2^117. H'mmm. */ diff --git a/src/arith/integer.h b/src/arith/integer.h index 1eda28f..f9eba33 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -1,4 +1,4 @@ -/** +/* * integer.h * * functions for integer cells. @@ -13,9 +13,6 @@ long double numeric_value( struct cons_pointer pointer ); -/** - * Allocate an integer cell representing this value and return a cons pointer to it. - */ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ); struct cons_pointer add_integers( struct cons_pointer a, diff --git a/src/arith/peano.c b/src/arith/peano.c index 0dc2ed0..6666d0e 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -34,7 +34,9 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1, struct cons_pointer arg2 ); - +/** + * return true if this `arg` points to a number whose value is zero. + */ bool zerop( struct cons_pointer arg ) { bool result = false; struct cons_space_object cell = pointer2cell( arg ); @@ -56,7 +58,13 @@ bool zerop( struct cons_pointer arg ) { } /** - * TODO: cannot throw an exception out of here, which is a problem + * Return the closest possible `binary64` representation to the value of + * this `arg`, expected to be an integer, ratio or real, or `NAN` if `arg` + * is not any of these. + * + * @arg a pointer to an integer, ratio or real. + * + * \todo cannot throw an exception out of here, which is a problem * if a ratio may legally have zero as a divisor, or something which is * not a number is passed in. */ @@ -97,7 +105,13 @@ long double to_long_double( struct cons_pointer arg ) { /** - * TODO: cannot throw an exception out of here, which is a problem + * Return the closest possible `int64_t` representation to the value of + * this `arg`, expected to be an integer, ratio or real, or `NAN` if `arg` + * is not any of these. + * + * @arg a pointer to an integer, ratio or real. + * + * \todo cannot throw an exception out of here, which is a problem * if a ratio may legally have zero as a divisor, or something which is * not a number (or is a big number) is passed in. */ @@ -106,7 +120,7 @@ int64_t to_long_int( struct cons_pointer arg ) { struct cons_space_object cell = pointer2cell( arg ); switch ( cell.tag.value ) { case INTEGERTV: - /* TODO: if (integerp(cell.payload.integer.more)) { + /* \todo if (integerp(cell.payload.integer.more)) { * throw an exception! * } */ result = cell.payload.integer.value; @@ -123,9 +137,9 @@ int64_t to_long_int( struct cons_pointer arg ) { /** -* return a cons_pointer indicating a number which is the sum of -* the numbers indicated by `arg1` and `arg2`. -*/ + * return a cons_pointer indicating a number which is the sum of + * the numbers indicated by `arg1` and `arg2`. + */ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer arg1, @@ -222,7 +236,8 @@ struct cons_pointer add_2( struct stack_frame *frame, * Add an indefinite number of numbers together * @param env the evaluation environment - ignored; * @param frame the stack frame. - * @return a pointer to an integer or real. + * @return a pointer to an integer, ratio or real. + * @exception if any argument is not a number, returns an exception. */ struct cons_pointer lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct @@ -356,7 +371,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame, * Multiply an indefinite number of numbers together * @param env the evaluation environment - ignored; * @param frame the stack frame. - * @return a pointer to an integer or real. + * @return a pointer to an integer, ratio or real. + * @exception if any argument is not a number, returns an exception. */ struct cons_pointer lisp_multiply( struct stack_frame @@ -431,7 +447,7 @@ struct cons_pointer negative( struct cons_pointer frame, /** * return a cons_pointer indicating a number which is the result of - * subtracting the numbers indicated by `arg2` from that indicated by `arg1`, + * subtracting the number indicated by `arg2` from that indicated by `arg1`, * in the context of this `frame`. */ struct cons_pointer subtract_2( struct stack_frame *frame, @@ -526,10 +542,12 @@ struct cons_pointer subtract_2( struct stack_frame *frame, } /** - * Subtract one number from another. + * Subtract one number from another. If more than two arguments are passed + * in the frame, the additional arguments are ignored. * @param env the evaluation environment - ignored; * @param frame the stack frame. - * @return a pointer to an integer or real. + * @return a pointer to an integer, ratio or real. + * @exception if either argument is not a number, returns an exception. */ struct cons_pointer lisp_subtract( struct stack_frame @@ -539,10 +557,12 @@ struct cons_pointer lisp_subtract( struct } /** - * Divide one number by another. + * Divide one number by another. If more than two arguments are passed + * in the frame, the additional arguments are ignored. * @param env the evaluation environment - ignored; * @param frame the stack frame. * @return a pointer to an integer or real. + * @exception if either argument is not a number, returns an exception. */ struct cons_pointer lisp_divide( struct stack_frame diff --git a/src/arith/peano.h b/src/arith/peano.h index 0bd09d5..816b147 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -1,4 +1,4 @@ -/** +/* * peano.h * * Basic peano arithmetic @@ -18,7 +18,7 @@ struct cons_pointer negative( struct cons_pointer frame, struct cons_pointer arg ); /** - * TODO: cannot throw an exception out of here, which is a problem + * \todo cannot throw an exception out of here, which is a problem. * if a ratio may legally have zero as a divisor, or something which is * not a number is passed in. */ @@ -35,7 +35,7 @@ lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); /** - * Multiply an indefinite number of numbers together + * Multiply an indefinite number of numbers together. * @param env the evaluation environment - ignored; * @param frame the stack frame. * @return a pointer to an integer or real. diff --git a/src/arith/ratio.c b/src/arith/ratio.c index f9dd0f4..784e71e 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -46,8 +46,8 @@ int64_t least_common_multiple( int64_t m, int64_t n ) { /** * return a cons_pointer indicating a number which is of the * same value as the ratio indicated by `arg`, but which may - * be in a simplified representation. If `arg` isn't a ratio, - * will throw exception. + * be in a simplified representation. + * @exception If `arg` isn't a ratio, will return an exception. */ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg ) { @@ -83,8 +83,9 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, /** * return a cons_pointer indicating a number which is the sum of - * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios, - * this is going to break horribly. + * the ratios indicated by `arg1` and `arg2`. + * @exception will return an exception if either `arg1` or `arg2` is not a + * rational number. */ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, @@ -100,7 +101,6 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, if ( ratiop( arg1 ) && ratiop( arg2 ) ) { struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); - // TODO: to be entirely reworked for bignums. All vars must be lisp integers. int64_t dd1v = pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value, dd2v = @@ -160,7 +160,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, /** * return a cons_pointer indicating a number which is the sum of * the intger indicated by `intarg` and the ratio indicated by - * `ratarg`. If you pass other types, this is going to break horribly. + * `ratarg`. + * @exception if either `intarg` or `ratarg` is not of the expected type. */ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer intarg, @@ -190,8 +191,9 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, /** * return a cons_pointer to a ratio which represents the value of the ratio - * indicated by `arg1` divided by the ratio indicated by `arg2`. If either - * of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT. + * indicated by `arg1` divided by the ratio indicated by `arg2`. + * @exception will return an exception if either `arg1` or `arg2` is not a + * rational number. */ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, @@ -210,8 +212,9 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, /** * return a cons_pointer indicating a number which is the product of - * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios, - * this is going to break horribly. + * the ratios indicated by `arg1` and `arg2`. + * @exception will return an exception if either `arg1` or `arg2` is not a + * rational number. */ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct @@ -258,7 +261,8 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str /** * return a cons_pointer indicating a number which is the product of * the intger indicated by `intarg` and the ratio indicated by - * `ratarg`. If you pass other types, this is going to break horribly. + * `ratarg`. + * @exception if either `intarg` or `ratarg` is not of the expected type. */ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer intarg, @@ -285,8 +289,9 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, /** * return a cons_pointer indicating a number which is the difference of - * the ratios indicated by `arg1` and `arg2`. If you pass non-ratios, - * this is going to break horribly. + * the ratios indicated by `arg1` and `arg2`. + * @exception will return an exception if either `arg1` or `arg2` is not a + * rational number. */ struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, @@ -301,8 +306,10 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, /** - * Construct a ratio frame from these two pointers, expected to be integers - * or (later) bignums, in the context of this stack_frame. + * Construct a ratio frame from this `dividend` and `divisor`, expected to + * be integers, in the context of the stack_frame indicated by this + * `frame_pointer`. + * @exception if either `dividend` or `divisor` is not an integer. */ struct cons_pointer make_ratio( struct cons_pointer frame_pointer, struct cons_pointer dividend, diff --git a/src/init.c b/src/init.c index 1edb586..7fdad2d 100644 --- a/src/init.c +++ b/src/init.c @@ -27,20 +27,28 @@ // extern char *optarg; /* defined in unistd.h */ +/** + * Bind this compiled `executable` function, as a Lisp function, to + * this name in the `oblist`. + * \todo where a function is not compiled from source, we could cache + * the name on the source pointer. Would make stack frames potentially + * more readable and aid debugging generally. + */ void bind_function( wchar_t *name, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer n = c_string_to_lisp_symbol( name ); inc_ref( n ); - /* TODO: where a function is not compiled from source, we could cache - * the name on the source pointer. Would make stack frames potentially - * more readable and aid debugging generally. */ deep_bind( n, make_function( NIL, executable ) ); dec_ref( n ); } +/** + * Bind this compiled `executable` function, as a Lisp special form, to + * this `name` in the `oblist`. + */ void bind_special( wchar_t *name, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ) { @@ -52,6 +60,9 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable ) dec_ref( n ); } +/** + * Bind this `value` to this `name` in the `oblist`. + */ void bind_value( wchar_t *name, struct cons_pointer value ) { struct cons_pointer n = c_string_to_lisp_symbol( name ); inc_ref( n ); @@ -61,6 +72,10 @@ void bind_value( wchar_t *name, struct cons_pointer value ) { dec_ref( n ); } +/** + * main entry point; parse command line arguments, initialise the environment, + * and enter the read-eval-print loop. + */ int main( int argc, char *argv[] ) { int option; bool dump_at_end = false; @@ -179,7 +194,6 @@ int main( int argc, char *argv[] ) { dec_ref( oblist ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); - if ( dump_at_end ) { dump_pages( stdout ); } diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 2aa8dce..f3c1760 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -45,9 +45,12 @@ struct cons_pointer freelist = NIL; struct cons_page *conspages[NCONSPAGES]; /** - * Make a cons page whose serial number (i.e. index in the conspages directory) is pageno. - * Initialise all cells and prepend each to the freelist; if pageno is zero, do not prepend - * cells 0 and 1 to the freelist but initialise them as NIL and T respectively. + * Make a cons page. Initialise all cells and prepend each to the freelist; + * if `initialised_cons_pages` is zero, do not prepend cells 0 and 1 to the + * freelist but initialise them as NIL and T respectively. + * \todo we ought to handle cons space exhaustion more gracefully than just + * crashing; should probably return an exception instead, although obviously + * that exception would have to have been pre-built. */ void make_cons_page( ) { struct cons_page *result = malloc( sizeof( struct cons_page ) ); @@ -110,7 +113,7 @@ void make_cons_page( ) { } /** - * dump the allocated pages to this output stream. + * dump the allocated pages to this `output` stream. */ void dump_pages( FILE * output ) { for ( int i = 0; i < initialised_cons_pages; i++ ) { @@ -125,8 +128,9 @@ void dump_pages( FILE * output ) { } /** - * Frees the cell at the specified pointer. Dangerous, primitive, low - * level. + * Frees the cell at the specified `pointer`; for all the types of cons-space + * object which point to other cons-space objects, cascade the decrement. + * Dangerous, primitive, low level. * * @pointer the cell to free */ @@ -136,63 +140,62 @@ void free_cell( struct cons_pointer pointer ) { debug_printf( DEBUG_ALLOC, L"Freeing cell " ); debug_dump_object( pointer, DEBUG_ALLOC ); - switch ( cell->tag.value ) { - /* for all the types of cons-space object which point to other - * cons-space objects, cascade the decrement. */ - case CONSTV: - dec_ref( cell->payload.cons.car ); - dec_ref( cell->payload.cons.cdr ); - break; - case EXCEPTIONTV: - dec_ref( cell->payload.exception.message ); - dec_ref( cell->payload.exception.frame ); - break; - case FUNCTIONTV: - dec_ref( cell->payload.function.source ); - break; - case INTEGERTV: - dec_ref( cell->payload.integer.more ); - break; - case LAMBDATV: - case NLAMBDATV: - dec_ref( cell->payload.lambda.args ); - dec_ref( cell->payload.lambda.body ); - break; - case RATIOTV: - dec_ref( cell->payload.ratio.dividend ); - dec_ref( cell->payload.ratio.divisor ); - break; - case SPECIALTV: - dec_ref( cell->payload.special.source ); - break; - case STRINGTV: - case SYMBOLTV: - dec_ref( cell->payload.string.cdr ); - break; - case VECTORPOINTTV: - /* for vector space pointers, free the actual vector-space - * object. Dangerous! */ - debug_printf( DEBUG_ALLOC, - L"About to free vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); - struct vector_space_object *vso = cell->payload.vectorp.address; - - switch ( vso->header.tag.value ) { - case STACKFRAMETV: - free_stack_frame( get_stack_frame( pointer ) ); - break; - } - - free( ( void * ) cell->payload.vectorp.address ); - debug_printf( DEBUG_ALLOC, - L"Freed vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); - break; - - } - if ( !check_tag( pointer, FREETAG ) ) { if ( cell->count == 0 ) { + switch ( cell->tag.value ) { + case CONSTV: + dec_ref( cell->payload.cons.car ); + dec_ref( cell->payload.cons.cdr ); + break; + case EXCEPTIONTV: + dec_ref( cell->payload.exception.message ); + dec_ref( cell->payload.exception.frame ); + break; + case FUNCTIONTV: + dec_ref( cell->payload.function.source ); + break; + case INTEGERTV: + dec_ref( cell->payload.integer.more ); + break; + case LAMBDATV: + case NLAMBDATV: + dec_ref( cell->payload.lambda.args ); + dec_ref( cell->payload.lambda.body ); + break; + case RATIOTV: + dec_ref( cell->payload.ratio.dividend ); + dec_ref( cell->payload.ratio.divisor ); + break; + case SPECIALTV: + dec_ref( cell->payload.special.source ); + break; + case STRINGTV: + case SYMBOLTV: + dec_ref( cell->payload.string.cdr ); + break; + case VECTORPOINTTV: + /* for vector space pointers, free the actual vector-space + * object. Dangerous! */ + debug_printf( DEBUG_ALLOC, + L"About to free vector-space object at 0x%lx\n", + cell->payload.vectorp.address ); + struct vector_space_object *vso = + cell->payload.vectorp.address; + + switch ( vso->header.tag.value ) { + case STACKFRAMETV: + free_stack_frame( get_stack_frame( pointer ) ); + break; + } + + free( ( void * ) cell->payload.vectorp.address ); + debug_printf( DEBUG_ALLOC, + L"Freed vector-space object at 0x%lx\n", + cell->payload.vectorp.address ); + break; + + } + strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH ); cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; @@ -210,11 +213,14 @@ void free_cell( struct cons_pointer pointer ) { } /** - * Allocates a cell with the specified tag. Dangerous, primitive, low + * Allocates a cell with the specified `tag`. Dangerous, primitive, low * level. * * @param tag the tag of the cell to allocate - must be a valid cons space tag. * @return the cons pointer which refers to the cell allocated. + * \todo handle the case where another cons_page cannot be allocated; + * return an exception. Which, as we cannot create such an exception when + * cons space is exhausted, means we must construct it at init time. */ struct cons_pointer allocate_cell( char *tag ) { struct cons_pointer result = freelist; diff --git a/src/memory/conspage.h b/src/memory/conspage.h index aff6f40..ab04d6d 100644 --- a/src/memory/conspage.h +++ b/src/memory/conspage.h @@ -37,42 +37,16 @@ struct cons_page { struct cons_space_object cell[CONSPAGESIZE]; }; -/** - * The (global) pointer to the (global) freelist. Not sure whether this ultimately - * belongs in this file. - */ extern struct cons_pointer freelist; -/** - * An array of pointers to cons pages. - */ extern struct cons_page *conspages[NCONSPAGES]; -/** - * Frees the cell at the specified pointer. Dangerous, primitive, low - * level. - * - * @pointer the cell to free - */ void free_cell( struct cons_pointer pointer ); -/** - * Allocates a cell with the specified tag. Dangerous, primitive, low - * level. - * - * @param tag the tag of the cell to allocate - must be a valid cons space tag. - * @return the cons pointer which refers to the cell allocated. - */ struct cons_pointer allocate_cell( char *tag ); -/** - * initialise the cons page system; to be called exactly once during startup. - */ void initialise_cons_pages( ); -/** - * dump the allocated pages to this output stream. - */ void dump_pages( FILE * output ); #endif diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 6f89742..6a7e2bd 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -25,9 +25,9 @@ #include "stack.h" /** - * Check that the tag on the cell at this pointer is this tag + * True if the tag on the cell at this `pointer` is this `tag`, else false. */ -int check_tag( struct cons_pointer pointer, char *tag ) { +bool check_tag( struct cons_pointer pointer, char *tag ) { struct cons_space_object cell = pointer2cell( pointer ); return strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; } @@ -178,12 +178,12 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { inc_ref( tail ); cell->payload.string.character = c; cell->payload.string.cdr.page = tail.page; - /* TODO: There's a problem here. Sometimes the offsets on + /* \todo There's a problem here. Sometimes the offsets on * strings are quite massively off. Fix is probably * cell->payload.string.cdr = tsil */ cell->payload.string.cdr.offset = tail.offset; } else { - // TODO: should throw an exception! + // \todo should throw an exception! debug_printf( DEBUG_ALLOC, L"Warning: only NIL and %s can be prepended to %s\n", tag, tag ); @@ -193,17 +193,23 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { } /** - * Construct a string from this character and - * this tail. A string is implemented as a flat list of cells each of which - * has one character and a pointer to the next; in the last cell the - * pointer to next is NIL. + * Construct a string from the character `c` and this `tail`. A string is + * implemented as a flat list of cells each of which has one character and a + * pointer to the next; in the last cell the pointer to next is NIL. + * + * @param c the character to add (prepend); + * @param tail the string which is being built. */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { return make_string_like_thing( c, tail, STRINGTAG ); } /** - * Construct a symbol from this character and this tail. + * Construct a symbol from the character `c` and this `tail`. A symbol is + * internally identical to a string except for having a different tag. + * + * @param c the character to add (prepend); + * @param tail the symbol which is being built. */ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) { return make_string_like_thing( c, tail, SYMBOLTAG ); @@ -239,7 +245,7 @@ struct cons_pointer make_read_stream( FILE * input ) { } /** - * Construct a cell which points to a stream open for writeing. + * Construct a cell which points to a stream open for writing. * @param output the C stream to wrap. */ struct cons_pointer make_write_stream( FILE * output ) { diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 0cf44a7..acc36df 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -1,4 +1,4 @@ -/** +/* * consspaceobject.h * * Declarations common to all cons space objects. @@ -25,113 +25,189 @@ */ #define TAGLENGTH 4 -/** - * tag values, all of which must be 4 bytes. Must not collide with vector space tag values +/* + * tag values, all of which must be 4 bytes. Must not collide with vector space + * tag values */ /** - * An ordinary cons cell: 1397641027 + * An ordinary cons cell: */ #define CONSTAG "CONS" + +/** + * The string `CONS`, considered as an `unsigned int`. + */ #define CONSTV 1397641027 /** * An exception. */ #define EXCEPTIONTAG "EXEP" + +/** + * The string `EXEP`, considered as an `unsigned int`. + */ #define EXCEPTIONTV 1346721861 /** * An unallocated cell on the free list - should never be encountered by a Lisp - * function. 1162170950 + * function. */ #define FREETAG "FREE" + +/** + * The string `FREE`, considered as an `unsigned int`. + */ #define FREETV 1162170950 /** - * An ordinary Lisp function - one whose arguments are pre-evaluated and passed as - * a stack frame. 1129207110 + * An ordinary Lisp function - one whose arguments are pre-evaluated. + * \see LAMBDATAG for interpretable functions. + * \see SPECIALTAG for functions whose arguments are not pre-evaluated. */ #define FUNCTIONTAG "FUNC" -#define FUNCTIONTV 1129207110 + /** - * An integer number. 1381256777 + * The string `FUNC`, considered as an `unsigned int`. + */ +#define FUNCTIONTV 1129207110 + +/** + * An integer number (bignums are integers). */ #define INTEGERTAG "INTR" + +/** + * The string `INTR`, considered as an `unsigned int`. + */ #define INTEGERTV 1381256777 /** - * A lambda cell. + * A lambda cell. Lambdas are the interpretable (source) versions of functions. + * \see FUNCTIONTAG. */ #define LAMBDATAG "LMDA" + +/** + * The string `LMDA`, considered as an `unsigned int`. + */ #define LAMBDATV 1094995276 /** - * The special cons cell at address {0,0} whose car and cdr both point to itself. - * 541870414 + * The special cons cell at address {0,0} whose car and cdr both point to + * itself. */ #define NILTAG "NIL " + +/** + * The string `NIL `, considered as an `unsigned int`. + */ #define NILTV 541870414 /** - * An nlambda cell. + * An nlambda cell. NLambdas are the interpretable (source) versions of special + * forms. \see SPECIALTAG. */ #define NLAMBDATAG "NLMD" + +/** + * The string `NLMD`, considered as an `unsigned int`. + */ #define NLAMBDATV 1145916494 +/** + * A rational number, stored as pointers two integers representing dividend + * and divisor respectively. + */ +#define RATIOTAG "RTIO" + +/** + * The string `RTIO`, considered as an `unsigned int`. + */ +#define RATIOTV 1330205778 + /** * An open read stream. */ #define READTAG "READ" + +/** + * The string `READ`, considered as an `unsigned int`. + */ #define READTV 1145128274 /** - * A real number. + * A real number, represented internally as an IEEE 754-2008 `binary64`. */ #define REALTAG "REAL" + +/** + * The string `REAL`, considered as an `unsigned int`. + */ #define REALTV 1279346002 /** - * A ratio. - */ -#define RATIOTAG "RTIO" -#define RATIOTV 1330205778 - -/** - * A special form - one whose arguments are not pre-evaluated but passed as a - * s-expression. 1296453715 + * A special form - one whose arguments are not pre-evaluated but passed as + * provided. + * \see NLAMBDATAG. */ #define SPECIALTAG "SPFM" + +/** + * The string `SPFM`, considered as an `unsigned int`. + */ #define SPECIALTV 1296453715 /** - * A string of characters, organised as a linked list. 1196577875 + * A string of characters, organised as a linked list. */ #define STRINGTAG "STRG" + +/** + * The string `STRG`, considered as an `unsigned int`. + */ #define STRINGTV 1196577875 /** - * A symbol is just like a string except not self-evaluating. 1112365395 + * A symbol is just like a string except not self-evaluating. */ #define SYMBOLTAG "SYMB" + +/** + * The string `SYMB`, considered as an `unsigned int`. + */ #define SYMBOLTV 1112365395 /** - * The special cons cell at address {0,1} which is canonically different from NIL. - * 1163219540 + * The special cons cell at address {0,1} which is canonically different + * from NIL. */ #define TRUETAG "TRUE" + +/** + * The string `TRUE`, considered as an `unsigned int`. + */ #define TRUETV 1163219540 /** * A pointer to an object in vector space. */ #define VECTORPOINTTAG "VECP" + +/** + * The string `VECP`, considered as an `unsigned int`. + */ #define VECTORPOINTTV 1346585942 + /** * An open write stream. */ #define WRITETAG "WRIT" + +/** + * The string `WRIT`, considered as an `unsigned int`. + */ #define WRITETV 1414091351 /** @@ -154,96 +230,103 @@ */ #define tag2uint(tag) ((uint32_t)*tag) +/** + * given a cons_pointer as argument, return the cell. + */ #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset])) /** - * true if conspointer points to the special cell NIL, else false + * true if `conspoint` points to the special cell NIL, else false * (there should only be one of these so it's slightly redundant). */ #define nilp(conspoint) (check_tag(conspoint,NILTAG)) /** - * true if conspointer points to a cons cell, else false + * true if `conspoint` points to a cons cell, else false */ #define consp(conspoint) (check_tag(conspoint,CONSTAG)) /** - * true if conspointer points to an exception, else false + * true if `conspoint` points to an exception, else false */ #define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTAG)) /** - * true if conspointer points to a function cell, else false + * true if `conspoint` points to a function cell, else false */ #define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG)) /** - * true if conspointer points to a special Lambda cell, else false + * true if `conspoint` points to a special Lambda cell, else false */ #define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG)) /** - * true if conspointer points to a special form cell, else false + * true if `conspoint` points to a special form cell, else false */ #define specialp(conspoint) (check_tag(conspoint,SPECIALTAG)) /** - * true if conspointer points to a string cell, else false + * true if `conspoint` points to a string cell, else false */ #define stringp(conspoint) (check_tag(conspoint,STRINGTAG)) /** - * true if conspointer points to a symbol cell, else false + * true if `conspoint` points to a symbol cell, else false */ #define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG)) /** - * true if conspointer points to an integer cell, else false + * true if `conspoint` points to an integer cell, else false */ #define integerp(conspoint) (check_tag(conspoint,INTEGERTAG)) /** - * true if conspointer points to a rational number cell, else false + * true if `conspoint` points to a rational number cell, else false */ #define ratiop(conspoint) (check_tag(conspoint,RATIOTAG)) /** - * true if conspointer points to a read stream cell, else false + * true if `conspoint` points to a read stream cell, else false */ #define readp(conspoint) (check_tag(conspoint,READTAG)) /** - * true if conspointer points to a real number cell, else false + * true if `conspoint` points to a real number cell, else false */ #define realp(conspoint) (check_tag(conspoint,REALTAG)) /** - * true if conspointer points to some sort of a number cell, + * true if `conspoint` points to some sort of a number cell, * else false */ #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG)) +/** + * true if `conspoint` points to a sequence (list, string or, later, vector), + * else false. + */ #define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG)) /** - * true if thr conspointer points to a vector pointer. + * true if `conspoint` points to a vector pointer, else false. */ #define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTAG)) /** - * true if conspointer points to a write stream cell, else false. + * true if `conspoint` points to a write stream cell, else false. */ #define writep(conspoint) (check_tag(conspoint,WRITETAG)) /** - * true if conspointer points to a true cell, else false + * true if `conspoint` points to a true cell, else false * (there should only be one of these so it's slightly redundant). * Also note that anything that is not NIL is truthy. */ #define tp(conspoint) (checktag(conspoint,TRUETAG)) /** - * true if conspoint points to something that is truthy, i.e. + * true if `conspoint` points to something that is truthy, i.e. * anything but NIL. */ #define truep(conspoint) (!checktag(conspoint,NILTAG)) @@ -265,16 +348,18 @@ struct cons_pointer { /** * A stack frame. Yes, I know it isn't a cons-space object, but it's defined - * here to avoid circularity. TODO: refactor. + * here to avoid circularity. \todo refactor. */ struct stack_frame { - struct cons_pointer previous; /* the previous frame */ + /** the previous frame. */ + struct cons_pointer previous; + /** first 8 arument bindings. */ struct cons_pointer arg[args_in_frame]; - /* - * first 8 arument bindings - */ - struct cons_pointer more; /* list of any further argument bindings */ - struct cons_pointer function; /* the function to be called */ + /** list of any further argument bindings. */ + struct cons_pointer more; + /** the function to be called. */ + struct cons_pointer function; + /** the number of arguments provided. */ int args; }; @@ -282,7 +367,9 @@ struct stack_frame { * payload of a cons cell. */ struct cons_payload { + /** Contents of the Address Register, naturally. */ struct cons_pointer car; + /** Contents of the Decrement Register, naturally. */ struct cons_pointer cdr; }; @@ -291,7 +378,9 @@ struct cons_payload { * Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame. */ struct exception_payload { + /** The message: should be a Lisp string but in practice anything printable will do. */ struct cons_pointer message; + /** pointer to the (unfreed) stack frame in which the exception was thrown. */ struct cons_pointer frame; }; @@ -305,7 +394,17 @@ struct exception_payload { * result). */ struct function_payload { + /** + * pointer to the source from which the function was compiled, or NIL + * if it is a primitive. + */ struct cons_pointer source; + /** pointer to a function which takes a cons pointer (representing + * its argument list) and a cons pointer (representing its environment) and a + * stack frame (representing the previous stack frame) as arguments and returns + * a cons pointer (representing its result). + * \todo check this documentation is current! + */ struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ); @@ -321,28 +420,37 @@ struct free_payload { }; /** - * payload of an integer cell. For the time being just a signed integer; - * later might be a signed 128 bit integer, or might have some flag to point to an - * optional bignum object. + * payload of an integer cell. An integer is in principle a sequence of cells; + * only 60 bits (+ sign bit) are actually used in each cell. If the value + * exceeds 60 bits, the least significant 60 bits are stored in the first cell + * in the chain, the next 60 in the next cell, and so on. Only the value of the + * first cell in any chain should be negative. */ struct integer_payload { + /** the value of the payload (i.e. 60 bits) of this cell. */ int64_t value; + /** the next (more significant) cell in the chain, ir `NIL` if there are no + * more. */ struct cons_pointer more; }; /** - * payload for lambda and nlambda cells + * payload for lambda and nlambda cells. */ struct lambda_payload { + /** the arument list */ struct cons_pointer args; + /** the body of the function to be applied to the arguments. */ struct cons_pointer body; }; /** - * payload for ratio cells. Both dividend and divisor must point to integer (or, later, bignum) cells. + * payload for ratio cells. Both `dividend` and `divisor` must point to integer cells. */ struct ratio_payload { + /** a pointer to an integer representing the dividend */ struct cons_pointer dividend; + /** a pointer to an integer representing the divisor. */ struct cons_pointer divisor; }; @@ -351,20 +459,25 @@ struct ratio_payload { * precision, but I'm not sure of the detail. */ struct real_payload { + /** the value of the number */ long double value; }; /** - * Payload of a special form cell. - * source points to the source from which the function was compiled, or NIL - * if it is a primitive. - * executable points to a function which takes a cons pointer (representing - * its argument list) and a cons pointer (representing its environment) and a - * stack frame (representing the previous stack frame) as arguments and returns - * a cons pointer (representing its result). + * Payload of a special form cell. Currently identical to the payload of a + * function cell. + * \see function_payload */ struct special_payload { + /** + * pointer to the source from which the special form was compiled, or NIL + * if it is a primitive. + */ struct cons_pointer source; + /** pointer to a function which takes a cons pointer (representing + * its argument list) and a cons pointer (representing its environment) and a + * stack frame (representing the previous stack frame) as arguments and returns + * a cons pointer (representing its result). */ struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ); @@ -374,6 +487,7 @@ struct special_payload { * payload of a read or write stream cell. */ struct stream_payload { + /** the stream to read from or write to. */ FILE *stream; }; @@ -384,8 +498,11 @@ struct stream_payload { * payload of a string cell. */ struct string_payload { - wint_t character; /* the actual character stored in this cell */ - uint32_t padding; /* unused padding to word-align the cdr */ + /** the actual character stored in this cell */ + wint_t character; + /** unused padding to word-align the cdr */ + uint32_t padding; + /** the remainder of the string following this character. */ struct cons_pointer cdr; }; @@ -393,19 +510,21 @@ struct string_payload { * payload of a vector pointer cell. */ struct vectorp_payload { + /** the tag of the vector-space object. NOTE that the vector space object + * should itself have the identical tag. */ union { - char bytes[TAGLENGTH]; /* the tag (type) of the - * vector-space object this cell - * points to, considered as bytes. - * NOTE that the vector space object - * should itself have the identical - * tag. */ - uint32_t value; /* the tag considered as a number */ + /** the tag (type) of the vector-space object this cell + * points to, considered as bytes. */ + char bytes[TAGLENGTH]; + /** the tag considered as a number */ + uint32_t value; } tag; - void *address; - /* the address of the actual vector space - * object (TODO: will change when I actually + /** unused padding to word-align the address */ + uint32_t padding; + /** the address of the actual vector space + * object (\todo will change when I actually * implement vector space) */ + void *address; }; /** @@ -413,87 +532,80 @@ struct vectorp_payload { */ struct cons_space_object { union { - char bytes[TAGLENGTH]; /* the tag (type) of this cell, - * considered as bytes */ - uint32_t value; /* the tag considered as a number */ + /** the tag (type) of this cell, + * considered as bytes */ + char bytes[TAGLENGTH]; + /** the tag considered as a number */ + uint32_t value; } tag; - uint32_t count; /* the count of the number of references to - * this cell */ - struct cons_pointer access; /* cons pointer to the access control list of - * this cell */ + /** the count of the number of references to this cell */ + uint32_t count; + /** cons pointer to the access control list of this cell */ + struct cons_pointer access; union { - /* + /** * if tag == CONSTAG */ struct cons_payload cons; - /* + /** * if tag == EXCEPTIONTAG */ struct exception_payload exception; - /* + /** * if tag == FREETAG */ struct free_payload free; - /* + /** * if tag == FUNCTIONTAG */ struct function_payload function; - /* + /** * if tag == INTEGERTAG */ struct integer_payload integer; - /* + /** * if tag == LAMBDATAG or NLAMBDATAG */ struct lambda_payload lambda; - /* + /** * if tag == NILTAG; we'll treat the special cell NIL as just a cons */ struct cons_payload nil; - /* + /** * if tag == RATIOTAG */ struct ratio_payload ratio; - /* + /** * if tag == READTAG || tag == WRITETAG */ struct stream_payload stream; - /* + /** * if tag == REALTAG */ struct real_payload real; - /* + /** * if tag == SPECIALTAG */ struct special_payload special; - /* + /** * if tag == STRINGTAG || tag == SYMBOLTAG */ struct string_payload string; - /* + /** * if tag == TRUETAG; we'll treat the special cell T as just a cons */ struct cons_payload t; - /* + /** * if tag == VECTORPTAG */ struct vectorp_payload vectorp; } payload; }; -/** - * Check that the tag on the cell at this pointer is this tag - */ -int check_tag( struct cons_pointer pointer, char *tag ); +bool check_tag( struct cons_pointer pointer, char *tag ); -/** - * increment the reference count of the object at this cons pointer - */ void inc_ref( struct cons_pointer pointer ); -/** - * decrement the reference count of the object at this cons pointer - */ void dec_ref( struct cons_pointer pointer ); struct cons_pointer make_cons( struct cons_pointer car, @@ -502,71 +614,34 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer frame_pointer ); -/** - * Construct a cell which points to an executable Lisp special form. - */ struct cons_pointer make_function( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); -/** - * Construct a lambda (interpretable source) cell - */ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ); -/** - * Construct an nlambda (interpretable source) cell; to a - * lambda as a special form is to a function. - */ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ); -/** - * Construct a cell which points to an executable Lisp special form. - */ struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); -/** - * Construct a string from this character and this tail. A string is - * implemented as a flat list of cells each of which has one character and a - * pointer to the next; in the last cell the pointer to next is NIL. - */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); -/** - * Construct a symbol from this character and this tail. A symbol is identical - * to a string except for having a different tag. - */ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ); -/** - * Construct a cell which points to a stream open for reading. - * @param input the C stream to wrap. - */ struct cons_pointer make_read_stream( FILE * input ); -/** - * Construct a cell which points to a stream open for writeing. - * @param output the C stream to wrap. - */ struct cons_pointer make_write_stream( FILE * output ); - -/** - * Return a lisp string representation of this old skool ASCII string. - */ struct cons_pointer c_string_to_lisp_string( wchar_t *string ); -/** - * Return a lisp symbol representation of this old skool ASCII string. - */ struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ); #endif diff --git a/src/memory/dump.c b/src/memory/dump.c index fc9175d..7ec2631 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -151,4 +151,3 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { break; } } - diff --git a/src/memory/dump.h b/src/memory/dump.h index 2293189..ec8928e 100644 --- a/src/memory/dump.h +++ b/src/memory/dump.h @@ -1,4 +1,4 @@ -/** +/* * dump.h * * Dump representations of both cons space and vector space objects. @@ -20,9 +20,6 @@ #define __dump_h -/** - * dump the object at this cons_pointer to this output stream. - */ void dump_object( FILE * output, struct cons_pointer pointer ); #endif diff --git a/src/memory/stack.c b/src/memory/stack.c index a1026b4..cf68701 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -26,14 +26,22 @@ #include "stack.h" #include "vectorspace.h" +/** + * set a register in a stack frame. Alwaye use this to do so, + * because that way we can be sure the inc_ref happens! + */ void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) { debug_printf( DEBUG_STACK, L"Setting register %d to ", reg ); debug_print_object( value, DEBUG_STACK ); debug_println( DEBUG_STACK ); - frame->arg[reg++] = value; + dec_ref(frame->arg[reg]); /* if there was anything in that slot + * previously other than NIL, we need to decrement it; + * NIL won't be decremented as it is locked. */ + frame->arg[reg] = value; inc_ref( value ); - if ( reg > frame->args ) { - frame->args = reg; + + if ( reg == frame->args ) { + frame->args++; } } @@ -71,15 +79,10 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { debug_dump_object( result, DEBUG_ALLOC ); -// debug_printf( DEBUG_STACK, -// L"make_empty_frame: got vector_space_object with size %lu, tag %4.4s\n", -// pointer_to_vso( result )->header.size, -// &pointer_to_vso( result )->header.tag.bytes ); - if ( !nilp( result ) ) { struct stack_frame *frame = get_stack_frame( result ); /* - * TODO: later, pop a frame off a free-list of stack frames + * \todo later, pop a frame off a free-list of stack frames */ frame->previous = previous; @@ -131,7 +134,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, struct cons_space_object cell = pointer2cell( args ); /* - * TODO: if we were running on real massively parallel hardware, + * \todo if we were running on real massively parallel hardware, * each arg except the first should be handed off to another * processor to be evaled in parallel; but see notes here: * https://github.com/simon-brooke/post-scarcity/wiki/parallelism @@ -220,7 +223,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous, */ void free_stack_frame( struct stack_frame *frame ) { /* - * TODO: later, push it back on the stack-frame freelist + * \todo later, push it back on the stack-frame freelist */ debug_print( L"Entering free_stack_frame\n", DEBUG_ALLOC ); for ( int i = 0; i < args_in_frame; i++ ) { diff --git a/src/memory/stack.h b/src/memory/stack.h index 189ff6b..11763b2 100644 --- a/src/memory/stack.h +++ b/src/memory/stack.h @@ -35,12 +35,6 @@ */ #define stackframep(vso)(((struct vector_space_object *)vso)->header.tag.value == STACKFRAMETV) -/** - * set a register in a stack frame. Alwaye use this macro to do so, - • because that way we can be sure the inc_ref happens! - */ -//#define set_reg(frame,register,value){frame->arg[register]=value; inc_ref(value);} - void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ); struct stack_frame *get_stack_frame( struct cons_pointer pointer ); @@ -65,7 +59,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous, /* * struct stack_frame is defined in consspaceobject.h to break circularity - * TODO: refactor. + * \todo refactor. */ #endif diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 5ec14a8..9d98a77 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -26,19 +26,28 @@ /** - * make a cons-space object which points to the vector space object + * Make a cons_space_object which points to the vector_space_object * with this `tag` at this `address`. - * NOTE that `tag` should be the vector-space tag of the particular type of - * vector-space object, NOT `VECTORPOINTTAG`. + * + * @address the address of the vector_space_object to point to. + * @tag the vector-space tag of the particular type of vector-space object, + * NOT `VECTORPOINTTAG`. + * + * @return a cons_pointer to the object, or NIL if the object could not be + * allocated due to memory exhaustion. */ -struct cons_pointer make_vec_pointer( struct vector_space_object *address ) { +struct cons_pointer make_vec_pointer( struct vector_space_object *address, char *tag ) { debug_print( L"Entered make_vec_pointer\n", DEBUG_ALLOC ); struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); + debug_printf( DEBUG_ALLOC, L"make_vec_pointer: tag written, about to set pointer address to %p\n", address ); + cell->payload.vectorp.address = address; + strncpy(&cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH); + debug_printf( DEBUG_ALLOC, L"make_vec_pointer: all good, returning pointer to %p\n", cell->payload.vectorp.address ); @@ -49,11 +58,15 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address ) { } /** - * allocate a vector space object with this `payload_size` and `tag`, + * Allocate a vector space object with this `payload_size` and `tag`, * and return a `cons_pointer` which points to an object whigh points to it. - * NOTE that `tag` should be the vector-space tag of the particular type of - * vector-space object, NOT `VECTORPOINTTAG`. - * Returns NIL if the vector could not be allocated due to memory exhaustion. + * + * @tag the vector-space tag of the particular type of vector-space object, + * NOT `VECTORPOINTTAG`. + * @payload_size the size of the payload required, in bytes. + * + * @return a cons_pointer to the object, or NIL if the object could not be + * allocated due to memory exhaustion. */ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { debug_print( L"Entered make_vso\n", DEBUG_ALLOC ); @@ -72,7 +85,7 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { L"make_vso: about to write tag '%s' into vso at %p\n", tag, vso ); strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH ); - result = make_vec_pointer( vso ); + result = make_vec_pointer( vso, tag ); debug_dump_object( result, DEBUG_ALLOC ); vso->header.vecp = result; // memcpy(vso->header.vecp, result, sizeof(struct cons_pointer)); diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 1438d37..22b0d88 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -40,32 +40,48 @@ #define VECTORTAG "VECT" #define VECTORTV 0 +/** + * given a pointer to a vector space object, return the object. + */ #define pointer_to_vso(pointer)((vectorpointp(pointer)? (struct vector_space_object *) pointer2cell(pointer).payload.vectorp.address : (struct vector_space_object *) NULL)) -#define vso_get_vecp(vso)((vso->header.vecp)) + +/** + * given a vector space object, return its canonical pointer. + */ +#define vso_get_vecp(vso)((((vector_space_object)vso)->header.vecp)) struct cons_pointer make_vso( char *tag, uint64_t payload_size ); +/** + * the header which forms the start of every vector space object. + */ struct vector_space_header { + /** the tag (type) of this vector-space object. */ union { - char bytes[TAGLENGTH]; /* the tag (type) of the - * vector-space object this cell - * points to, considered as bytes. - * NOTE that the vector space object - * should itself have the identical - * tag. */ - uint32_t value; /* the tag considered as a number */ + /** the tag considered as bytes. */ + char bytes[TAGLENGTH]; + /** the tag considered as a number */ + uint32_t value; } tag; - struct cons_pointer vecp; /* back pointer to the vector pointer - * which uniquely points to this vso */ - uint64_t size; /* the size of my payload, in bytes */ + /** back pointer to the vector pointer which uniquely points to this vso */ + struct cons_pointer vecp; + /** the size of my payload, in bytes */ + uint64_t size; }; +/** a vector_space_object is just a vector_space_header followed by a + * lump of bytes; what we deem to be in there is a function of the tag, + * and at this stage we don't have a good picture of what these may be. + * + * \see stack_frame for an example payload; + * \see make_empty_frame for an example of how to initialise and use one. + */ struct vector_space_object { + /** the header of this object */ struct vector_space_header header; - char payload; /* we'll malloc `size` bytes for payload, - * `payload` is just the first of these. - * TODO: this is almost certainly not - * idiomatic C. */ + /** we'll malloc `size` bytes for payload, `payload` is just the first of these. + * \todo this is almost certainly not idiomatic C. */ + char payload; }; #endif diff --git a/src/ops/intern.c b/src/ops/intern.c index 9d2387c..1e32a36 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -27,7 +27,8 @@ #include "print.h" /** - * The object list. What is added to this during system setup is 'global', that is, + * The global object list/or, to put it differently, the root namespace. + * What is added to this during system setup is 'global', that is, * visible to all sessions/threads. What is added during a session/thread is local to * that session/thread (because shallow binding). There must be some way for a user to * make the contents of their own environment persistent between threads but I don't diff --git a/src/ops/intern.h b/src/ops/intern.h index e940daa..b261242 100644 --- a/src/ops/intern.h +++ b/src/ops/intern.h @@ -1,14 +1,14 @@ -/** +/* * intern.h * * For now this implements an oblist and shallow binding; local environments can * be consed onto the front of the oblist. Later, this won't do; bindings will happen * in namespaces, which will probably be implemented as hash tables. - * + * * Doctrine is that cons cells are immutable, and life is a lot more simple if they are; * so when a symbol is rebound in the master oblist, what in fact we do is construct * a new oblist without the previous binding but with the new binding. Anything which, - * prior to this action, held a pointer to the old oblist (as all current threads' + * prior to this action, held a pointer to the old oblist (as all current threads' * environments must do) continues to hold a pointer to the old oblist, and consequently * doesn't see the change. This is probably good but does mean you cannot use bindings * on the oblist to signal between threads. @@ -22,42 +22,19 @@ extern struct cons_pointer oblist; -/** - * return the value associated with this key in this store. In the current - * implementation a store is just an assoc list, but in future it might be a - * namespace, a regularity or a homogeneity. - */ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store ); -/** - * Return true if this key is present as a key in this enviroment, defaulting to - * the oblist if no environment is passed. - */ struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer environment ); -/** - * Return a new key/value store containing all the key/value pairs in this store - * with this key/value pair added to the front. - */ struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value, struct cons_pointer store ); -/** - * Binds this key to this value in the global oblist, but doesn't affect the - * current environment. May not be useful except in bootstrapping (and even - * there it may not be especially useful). - */ struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value ); -/** - * Ensure that a canonical copy of this key is bound in this environment, and - * return that canonical copy. If there is currently no such binding, create one - * with the value NIL. - */ struct cons_pointer intern( struct cons_pointer key, struct cons_pointer environment ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 298ae1a..775f3b4 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -39,9 +39,9 @@ /* * also to create in this section: * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); + * struct stack_frame* frame); * struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); + * struct stack_frame* frame); * * and others I haven't thought of yet. */ @@ -109,9 +109,13 @@ struct cons_pointer eval_form( struct stack_frame *parent, } /** - * eval all the forms in this `list` in the context of this stack `frame` + * Evaluate all the forms in this `list` in the context of this stack `frame` * and this `env`, and return a list of their values. If the arg passed as - * `list` is not in fact a list, return nil. + * `list` is not in fact a list, return NIL. + * @param frame the stack frame. + * @param list the list of forms to be evaluated. + * @param env the evaluation environment. + * @return a list of the the results of evaluating the forms. */ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -140,9 +144,8 @@ lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, return oblist; } - /** - * used to construct the body for `lambda` and `nlambda` expressions. + * Used to construct the body for `lambda` and `nlambda` expressions. */ struct cons_pointer compose_body( struct stack_frame *frame ) { struct cons_pointer body = frame->more; @@ -164,6 +167,8 @@ struct cons_pointer compose_body( struct stack_frame *frame ) { /** * Construct an interpretable function. * + * (lambda args body) + * * @param frame the stack frame in which the expression is to be interpreted; * @param env the environment in which it is to be intepreted. */ @@ -176,6 +181,8 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, /** * Construct an interpretable special form. * + * (nlambda args body) + * * @param frame the stack frame in which the expression is to be interpreted; * @param env the environment in which it is to be intepreted. */ @@ -220,11 +227,11 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, } inc_ref( new_env ); - /* TODO: if there's more than `args_in_frame` arguments, bind those too. */ + /* \todo if there's more than `args_in_frame` arguments, bind those too. */ } else if ( symbolp( names ) ) { /* if `names` is a symbol, rather than a list of symbols, * then bind a list of the values of args to that symbol. */ - /* TODO: eval all the things in frame->more */ + /* \todo eval all the things in frame->more */ struct cons_pointer vals = eval_forms( frame, frame_pointer, frame->more, env ); @@ -412,17 +419,24 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { /** - * (eval s_expr) + * Function; evaluate the expression which is the first argument in the frame; + * further arguments are ignored. * - * function. - * If s_expr is a number, NIL, or T, returns s_expr. - * If s_expr is an unprotected string, returns the value that s_expr is bound - * to in the evaluation environment (env). - * If s_expr is a list, expects the car to be something that evaluates to a - * function or special form. - * If a function, evaluates all the other top level elements in s_expr and - * passes them in a stack frame as arguments to the function. - * If a special form, passes the cdr of s_expr to the special form as argument. + * * (eval expression) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return + * * If `expression` is a number, string, `nil`, or `t`, returns `expression`. + * * If `expression` is a symbol, returns the value that expression is bound + * to in the evaluation environment (`env`). + * * If `expression` is a list, expects the car to be something that evaluates to a + * function or special form: + * * If a function, evaluates all the other top level elements in `expression` and + * passes them in a stack frame as arguments to the function; + * * If a special form, passes the cdr of expression to the special form as argument. + * @exception if `expression` is a symbol which is not bound in `env`. */ struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -457,12 +471,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, } break; /* - * TODO: + * \todo * the Clojure practice of having a map serve in the function place of - * an s-expression is a good one and I should adopt it; also if the - * object is a consp it could be interpretable source code but in the - * long run I don't want an interpreter, and if I can get away without - * so much the better. + * an s-expression is a good one and I should adopt it; */ default: result = frame->arg[0]; @@ -477,11 +488,16 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * (apply fn args) - * - * function. Apply the function which is the result of evaluating the - * first argoment to the list of arguments which is the result of evaluating + * Function; apply the function which is the result of evaluating the + * first argument to the list of values which is the result of evaluating * the second argument + * + * * (apply fn args) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return the result of applying `fn` to `args`. */ struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -502,11 +518,16 @@ lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * (quote a) - * - * Special form - * Returns its argument (strictly first argument - only one is expected but + * Special form; + * returns its argument (strictly first argument - only one is expected but * this isn't at this stage checked) unevaluated. + * + * * (quote a) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return `a`, unevaluated, */ struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -516,13 +537,19 @@ lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * (set name value) - * (set name value namespace) - * - * Function. + * Function; + * binds the value of `name` in the `namespace` to value of `value`, altering + * the namespace in so doing. Retuns `value`. * `namespace` defaults to the oblist. - * Binds the value of `name` in the `namespace` to value of `value`, altering - * the namespace in so doing. `namespace` defaults to the value of `oblist`. + * \todo doesn't actually work yet for namespaces which are not the oblist. + * + * * (set name value) + * * (set name value namespace) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return `value` */ struct cons_pointer lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -548,20 +575,25 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * (set! symbol value) - * (set! symbol value namespace) + * Special form; + * binds `symbol` in the `namespace` to value of `value`, altering + * the namespace in so doing, and returns value. `namespace` defaults to + * the value of `oblist`. + * \todo doesn't actually work yet for namespaces which are not the oblist. * - * Special form. - * `namespace` defaults to the oblist. - * Binds `symbol` in the `namespace` to value of `value`, altering - * the namespace in so doing. `namespace` defaults to the value of `oblist`. + * * (set! symbol value) + * * (set! symbol value namespace) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return `value` */ struct cons_pointer lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; - struct cons_pointer namespace = - nilp( frame->arg[2] ) ? oblist : frame->arg[2]; + struct cons_pointer namespace = frame->arg[2]; if ( symbolp( frame->arg[0] ) ) { struct cons_pointer val = @@ -581,12 +613,17 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (cons a b) - * - * Function. - * Returns a cell constructed from a and b. If a is of type string but its + * Function; + * returns a cell constructed from a and b. If a is of type string but its * cdr is nill, and b is of type string, then returns a new string cell; * otherwise returns a new cons cell. + * + * * (cons a b) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return a new cons cell whose `car` is `a` and whose `cdr` is `b`. */ struct cons_pointer lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -597,8 +634,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( nilp( car ) && nilp( cdr ) ) { return NIL; - } else if ( stringp( car ) && stringp( cdr ) && - nilp( pointer2cell( car ).payload.string.cdr ) ) { + } else if ( stringp( car ) && stringp( cdr )) { + // \todo check that car is of length 1 result = make_string( pointer2cell( car ).payload.string.character, cdr ); } else { @@ -609,9 +646,17 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (car s_expr) - * Returns the first item (head) of a sequence. Valid for cons cells, - * strings, and TODO read streams and other things which can be considered as sequences. + * Function; + * returns the first item (head) of a sequence. Valid for cons cells, + * strings, read streams and TODO other things which can be considered as sequences. + * + * * (car expression) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return the first item (head) of `expression`. + * @exception if `expression` is not a sequence. */ struct cons_pointer lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -626,11 +671,11 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, case READTV: result = make_string( fgetwc( cell.payload.stream.stream ), NIL ); break; + case NILTV: + break; case STRINGTV: result = make_string( cell.payload.string.character, NIL ); break; - case NILTV: - break; default: result = throw_exception( c_string_to_lisp_string @@ -642,11 +687,19 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (cdr s_expr) - * Returns the remainder of a sequence when the head is removed. Valid for cons cells, - * strings, and TODO read streams and other things which can be considered as sequences. - * NOTE that if the argument is an input stream, the first character is removed AND + * Function; + * returns the remainder of a sequence when the head is removed. Valid for cons cells, + * strings, read streams and TODO other things which can be considered as sequences. + * *NOTE* that if the argument is an input stream, the first character is removed AND * DISCARDED. + * + * * (cdr expression) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return the remainder of `expression` when the head is removed. + * @exception if `expression` is not a sequence. */ struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -678,8 +731,14 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (assoc key store) - * Returns the value associated with key in store, or NIL if not found. + * Function; look up the value of a `key` in a `store`. + * + * * (assoc key store) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return the value associated with `key` in `store`, or `nil` if not found. */ struct cons_pointer lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -688,8 +747,14 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (eq a b) - * Returns T if a and b are pointers to the same object, else NIL + * Function; are these two objects the same object? Shallow, cheap equality. + * + * * (eq a b) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return `t` if `a` and `b` are pointers to the same object, else `nil`; */ struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -698,8 +763,14 @@ struct cons_pointer lisp_eq( struct stack_frame *frame, } /** - * (eq a b) - * Returns T if a and b are pointers to structurally identical objects, else NIL + * Function; are these two arguments identical? Deep, expensive equality. + * + * * (equal a b) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return `t` if `a` and `b` are recursively identical, else `nil`. */ struct cons_pointer lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -728,10 +799,17 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) { /** - * (read) - * (read read-stream) - * Read one complete lisp form and return it. If read-stream is specified and - * is a read stream, then read from that stream, else stdin. + * Function; read one complete lisp form and return it. If read-stream is specified and + * is a read stream, then read from that stream, else the stream which is the value of + * `*in*` in the environment. + * + * * (read) + * * (read read-stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return the expression read. */ struct cons_pointer lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -788,8 +866,14 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) { /** - * (reverse sequence) - * Return a sequence like this sequence but with the members in the reverse order. + * Function; reverse the order of members in s sequence. + * + * * (reverse sequence) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return a sequence like this `sequence` but with the members in the reverse order. */ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -799,10 +883,17 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, /** - * (print expr) - * (print expr write-stream) - * Print one complete lisp form and return NIL. If write-stream is specified and - * is a write stream, then print to that stream, else stdout. + * Function; print one complete lisp expression and return NIL. If write-stream is specified and + * is a write stream, then print to that stream, else the stream which is the value of + * `*out*` in the environment. + * + * * (print expr) + * * (print expr write-stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return the value of `expr`. */ struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -837,10 +928,14 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * Function: Get the Lisp type of the single argument. - * @param frame My stack frame. - * @param env My environment (ignored). - * @return As a Lisp string, the tag of the object which is the argument. + * Function: get the Lisp type of the single argument. + * + * * (type expression) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return As a Lisp string, the tag of `expression`. */ struct cons_pointer lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -849,21 +944,21 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * Evaluate each of these forms in this `env`ironment over this `frame`, + * Evaluate each of these expressions in this `env`ironment over this `frame`, * returning only the value of the last. */ struct cons_pointer c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer forms, struct cons_pointer env ) { + struct cons_pointer expressions, struct cons_pointer env ) { struct cons_pointer result = NIL; - while ( consp( forms ) ) { + while ( consp( expressions ) ) { struct cons_pointer r = result; inc_ref( r ); - result = eval_form( frame, frame_pointer, c_car( forms ), env ); + result = eval_form( frame, frame_pointer, c_car( expressions ), env ); dec_ref( r ); - forms = c_cdr( forms ); + expressions = c_cdr( expressions ); } return result; @@ -871,15 +966,16 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * (progn forms...) - * - * Special form; evaluate the forms which are listed in my arguments + * Special form; evaluate the expressions which are listed in my arguments * sequentially and return the value of the last. This function is called 'do' * in some dialects of Lisp. * - * @param frame My stack frame. - * @param env My environment (ignored). - * @return the value of the last form on the sequence which is my single + * * (progn expressions...) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment in which expressions are evaluated. + * @return the value of the last `expression` of the sequence which is my single * argument. */ struct cons_pointer @@ -904,16 +1000,20 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * Special form: conditional. Each arg is expected to be a list; if the first + * Special form: conditional. Each `clause` is expected to be a list; if the first * item in such a list evaluates to non-NIL, the remaining items in that list - * are evaluated in turn and the value of the last returned. If no arg (clause) + * are evaluated in turn and the value of the last returned. If no arg `clause` * has a first element which evaluates to non NIL, then NIL is returned. - * @param frame My stack frame. - * @param env My environment (ignored). - * @return the value of the last form of the first successful clause. + * + * * (cond clauses...) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment in which arguments will be evaluated. + * @return the value of the last expression of the first successful `clause`. */ struct cons_pointer -lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, + lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; bool done = false; @@ -943,7 +1043,7 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, frame_pointer ); } } - /* TODO: if there are more than 8 clauses we need to continue into the + /* \todo if there are more than 8 clauses we need to continue into the * remainder */ return result; @@ -978,9 +1078,18 @@ throw_exception( struct cons_pointer message, } /** - * (exception ) + * Function; create an exception. Exceptions are special in as much as if an + * exception is created in the binding of the arguments of any function, the + * function will return the exception rather than whatever else it would + * normally return. A function which detects a problem it cannot resolve + * *should* return an exception. * - * Function. Returns an exception whose message is this `message`, and whose + * * (exception ) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment in which arguments will be evaluated. + * @return areturns an exception whose message is this `message`, and whose * stack frame is the parent stack frame when the function is invoked. * `message` does not have to be a string but should be something intelligible * which can be read. @@ -995,19 +1104,23 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, } /** - * (repl) - * (repl prompt) - * (repl prompt input_stream output_stream) + * Function: the read/eval/print loop. * - * Function: the read/eval/print loop. Returns the value of the last expression - * entered. + * * (repl) + * * (repl prompt) + * * (repl prompt input_stream output_stream) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment in which epressions will be evaluated. + * @return the value of the last expression read. */ struct cons_pointer lisp_repl( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer expr = NIL; - /* TODO: bind *prompt*, *input*, *output* in the environment to the values + /* \todo bind *prompt*, *input*, *output* in the environment to the values * of arguments 0, 1, and 2 respectively, but in each case only if the * argument is not nil */ @@ -1023,7 +1136,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, inc_ref( output ); inc_ref( prompt_name ); - /* TODO: this is subtly wrong. If we were evaluating + /* \todo this is subtly wrong. If we were evaluating * (print (eval (read))) * then the stack frame for read would have the stack frame for * eval as parent, and it in turn would have the stack frame for @@ -1035,7 +1148,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, * bound in the oblist subsequent to this function being invoked isn't in the * environment. So, for example, changes to *prompt* or *log* made in the oblist * are not visible. So copy changes made in the oblist into the enviroment. - * TODO: the whole process of resolving symbol values needs to be revisited + * \todo the whole process of resolving symbol values needs to be revisited * when we get onto namespaces. */ if ( !eq( oblist, old_oblist ) ) { struct cons_pointer cursor = oblist; @@ -1089,11 +1202,16 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, } /** - * (source object) + * Function. return the source code of the object which is its first argument, + * if it is an executable and has source code. * - * Function. - * Return the source code of the object, if it is an executable - * and has source code. + * * (source object) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment (ignored). + * @return the source of the `object` indicated, if it is a function, a lambda, + * an nlambda, or a spcial form; else `nil`. */ struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -1119,7 +1237,7 @@ struct cons_pointer lisp_source( struct stack_frame *frame, cell.payload.lambda.body ) ); break; } - // TODO: suffers from premature GC, and I can't see why! + // \todo suffers from premature GC, and I can't see why! inc_ref( result ); return result; @@ -1127,11 +1245,20 @@ struct cons_pointer lisp_source( struct stack_frame *frame, /** - * Print the internal representation of the object indicated by `frame->arg[0]` to the - * (optional, defaults to `stdout`) stream indicated by `frame->arg[1]`. + * Function; print the internal representation of the object indicated by `frame->arg[0]` to the + * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. + * + * * (inspect expression) + * * (inspect expression ) + * + * @param frame my stack frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment. + * @return the value of the first argument - `expression`. */ -struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { +struct cons_pointer lisp_inspect( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { debug_print( L"Entering print\n", DEBUG_IO ); FILE *output = stdout; struct cons_pointer out_stream = writep( frame->arg[1] ) ? diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 7d7d395..1aff486 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -202,5 +202,6 @@ struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_inspect( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); diff --git a/src/ops/print.c b/src/ops/print.c index 3feeb21..604c07c 100644 --- a/src/ops/print.c +++ b/src/ops/print.c @@ -25,7 +25,7 @@ /** * Whether or not we colorise output. - * TODO: this should be a Lisp symbol binding, not a C variable. + * \todo this should be a Lisp symbol binding, not a C variable. */ int print_use_colours = 0; @@ -122,7 +122,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { dump_stack_trace( output, pointer ); break; case FUNCTIONTV: - fwprintf( output, L"(Function)" ); + fwprintf( output, L"" ); break; case INTEGERTV:{ struct cons_pointer s = integer_to_string( pointer, 10 ); @@ -167,10 +167,10 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { print( output, cell.payload.ratio.divisor ); break; case READTV: - fwprintf( output, L"(Input stream)" ); + fwprintf( output, L"" ); break; case REALTV: - /* TODO: using the C heap is a bad plan because it will fragment. + /* \todo using the C heap is a bad plan because it will fragment. * As soon as I have working vector space I'll use a special purpose * vector space object */ buffer = ( char * ) malloc( 24 ); @@ -201,13 +201,13 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { print_string_contents( output, pointer ); break; case SPECIALTV: - fwprintf( output, L"(Special form)" ); + fwprintf( output, L"" ); break; case TRUETV: fwprintf( output, L"t" ); break; case WRITETV: - fwprintf( output, L"(Output stream)" ); + fwprintf( output, L"" ); break; default: fwprintf( stderr, diff --git a/src/ops/read.c b/src/ops/read.c index 6e2a07f..4006c99 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -119,7 +119,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, read_number( frame, frame_pointer, input, c, true ); } else if ( iswblank( next ) ) { - /* dotted pair. TODO: this isn't right, we + /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ result = read_continuation( frame, frame_pointer, input, @@ -153,7 +153,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, /** * read a number from this input stream, given this initial character. - * TODO: Need to do a lot of inc_ref and dec_ref, to make sure the + * \todo Need to do a lot of inc_ref and dec_ref, to make sure the * garbage is collected. */ struct cons_pointer read_number( struct stack_frame *frame, @@ -163,7 +163,7 @@ struct cons_pointer read_number( struct stack_frame *frame, debug_print( L"entering read_number\n", DEBUG_IO ); struct cons_pointer result = make_integer( 0, NIL ); - /* TODO: we really need to be getting `base` from a privileged Lisp name - + /* \todo we really need to be getting `base` from a privileged Lisp name - * and it should be the same privileged name we use when writing numbers */ struct cons_pointer base = make_integer( 10, NIL ); struct cons_pointer dividend = NIL; @@ -298,7 +298,7 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) { struct cons_pointer result; switch ( initial ) { case '\0': - result = make_string( initial, NIL ); + result = NIL; break; case '"': /* making a string of the null character means we can have an empty diff --git a/unit-tests/string-cons.sh b/unit-tests/string-cons.sh new file mode 100644 index 0000000..0ea0a71 --- /dev/null +++ b/unit-tests/string-cons.sh @@ -0,0 +1,25 @@ +#!/bin/bash + +# We should be able to cons a single character string onto the front of a string +expected='"Test"' +actual=`echo '(cons "T" "est")' | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +# But if the first argument has more than one character, we should get a dotted pair +expected='("Test" . "pass")' +actual=`echo '(cons "Test" "pass")' | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi