diff --git a/src/arith/integer.c b/src/arith/integer.c index eef171b..b67ccc8 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -100,13 +100,12 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t int128_to_integer( __int128_t val, struct cons_pointer less_significant, struct cons_pointer new ) { - struct cons_pointer cursor = NIL; __int128_t carry = 0; if ( MAX_INTEGER >= val ) { carry = 0; } else { - carry = val >> 60; + carry = val >> INTEGER_BIT_SHIFT; debug_printf( DEBUG_ARITH, L"int128_to_integer: 64 bit overflow; setting carry to %ld\n", ( int64_t ) carry ); @@ -136,7 +135,7 @@ struct cons_pointer make_integer_128( __int128_t val, less_significant = make_integer( ( long int ) val & MAX_INTEGER, less_significant ); - val = val >> 60; + val = val >> INTEGER_BIT_SHIFT; } } while ( nilp( result ) ); @@ -290,7 +289,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* if xj exceeds one digit, break it into the digit dj and * the carry */ - carry = xj >> 60; + carry = xj >> INTEGER_BIT_SHIFT; struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL ); /* destructively modify ri by appending dj */ @@ -320,7 +319,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, } /** - * don't use; private to integer_to_string, and somewaht dodgy. + * don't use; private to integer_to_string, and somewhat dodgy. */ struct cons_pointer integer_to_string_add_digit( int digit, int digits, struct cons_pointer tail ) { @@ -361,7 +360,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, while ( accumulator > 0 || !nilp( next ) ) { if ( accumulator < MAX_INTEGER && !nilp( next ) ) { accumulator += - ( pointer2cell( next ).payload.integer.value << 60 ); + ( pointer2cell( next ).payload.integer.value << INTEGER_BIT_SHIFT ); next = pointer2cell( next ).payload.integer.more; } int offset = ( int ) ( accumulator % base ); diff --git a/src/arith/peano.h b/src/arith/peano.h index 3076391..84faa28 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -13,10 +13,18 @@ #define PEANO_H /** - * The maximum value we will allow in an integer cell. + * The maximum value we will allow in an integer cell: one less than 2^60: + * (let ((s (make-string-output-stream))) + * (format s "0x0~XL" (- (expt 2 60) 1)) + * (string-downcase (get-output-stream-string s))) + * "0x0fffffffffffffffl" + * + * So left shifting and right shifting by 60 bits is correct. */ #define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) +#define INTEGER_BIT_SHIFT (60) + bool zerop( struct cons_pointer arg ); struct cons_pointer negative( struct cons_pointer arg ); diff --git a/src/init.c b/src/init.c index 676964f..3f3566c 100644 --- a/src/init.c +++ b/src/init.c @@ -9,6 +9,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include #include diff --git a/src/io/print.h b/src/io/print.h index 006ef80..b72513c 100644 --- a/src/io/print.h +++ b/src/io/print.h @@ -11,6 +11,8 @@ #include #include +#include "io/fopen.h" + #ifndef __print_h #define __print_h diff --git a/src/memory/conspage.c b/src/memory/conspage.c index f438627..b30ee53 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -267,6 +267,6 @@ void initialise_cons_pages( ) { void summarise_allocation( ) { fwprintf( stderr, - L"Allocation summary: allocated %lld; deallocated %lld.\n", - total_cells_allocated, total_cells_freed ); + L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n", + total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed ); } diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 579e84b..8f9e2a8 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -9,9 +9,9 @@ */ #include +#include #include #include -#include /* * wide characters */ @@ -19,13 +19,13 @@ #include #include "authorise.h" +#include "debug.h" +#include "io/print.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" -#include "debug.h" -#include "ops/intern.h" -#include "io/print.h" #include "memory/stack.h" #include "memory/vectorspace.h" +#include "ops/intern.h" /** * True if the value of the tag on the cell at this `pointer` is this `value`, @@ -33,22 +33,22 @@ * vectorspace object indicated by the cell is this `value`, else false. */ bool check_tag( struct cons_pointer pointer, uint32_t value ) { - bool result = false; + bool result = false; - struct cons_space_object cell = pointer2cell( pointer ); - result = cell.tag.value == value; + struct cons_space_object cell = pointer2cell( pointer ); + result = cell.tag.value == value; - if ( result == false ) { - if ( cell.tag.value == VECTORPOINTTV ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( result == false ) { + if ( cell.tag.value == VECTORPOINTTV ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - if ( vec != NULL ) { - result = vec->header.tag.value == value; - } - } + if ( vec != NULL ) { + result = vec->header.tag.value == value; + } } + } - return result; + return result; } /** @@ -56,17 +56,17 @@ bool check_tag( struct cons_pointer pointer, uint32_t value ) { * * You can't roll over the reference count. Once it hits the maximum * value you cannot increment further. - * + * * Returns the `pointer`. */ struct cons_pointer inc_ref( struct cons_pointer pointer ) { - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( cell->count < MAXREFERENCE ) { - cell->count++; - } + if ( cell->count < MAXREFERENCE ) { + cell->count++; + } - return pointer; + return pointer; } /** @@ -74,49 +74,46 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) { * * If a count has reached MAXREFERENCE it cannot be decremented. * If a count is decremented to zero the cell should be freed. - * + * * Returns the `pointer`, or, if the cell has been freed, NIL. */ struct cons_pointer dec_ref( struct cons_pointer pointer ) { - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( cell->count > 0 ) { - cell->count--; + if ( cell->count > 0 ) { + cell->count--; - if ( cell->count == 0 ) { - free_cell( pointer ); - pointer = NIL; - } + if ( cell->count == 0 ) { + free_cell( pointer ); + pointer = NIL; } + } - return pointer; + return pointer; } - /** * Get the Lisp type of the single argument. * @param pointer a pointer to the object whose type is requested. * @return As a Lisp string, the tag of the object which is at that pointer. */ struct cons_pointer c_type( struct cons_pointer pointer ) { - struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( pointer ); - if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == - 0 ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = - make_string( ( wchar_t ) vec->header.tag.bytes[i], result ); - } - } else { - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( ( wchar_t ) cell.tag.bytes[i], result ); - } + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( (wchar_t)vec->header.tag.bytes[i], result ); } + } else { + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( (wchar_t)cell.tag.bytes[i], result ); + } + } - return result; + return result; } /** @@ -124,13 +121,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { * authorised to read it, does not error but returns nil. */ struct cons_pointer c_car( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { - result = pointer2cell( arg ).payload.cons.car; - } + if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.car; + } - return result; + return result; } /** @@ -138,96 +135,98 @@ struct cons_pointer c_car( struct cons_pointer arg ) { * not authorised to read it,does not error but returns nil. */ struct cons_pointer c_cdr( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) ) { - struct cons_space_object *cell = &pointer2cell( arg ); + if ( truep( authorised( arg, NIL ) ) ) { + struct cons_space_object *cell = &pointer2cell( arg ); - switch ( cell->tag.value ) { - case CONSTV: - result = cell->payload.cons.cdr; - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - result = cell->payload.string.cdr; - break; - } + switch ( cell->tag.value ) { + case CONSTV: + result = cell->payload.cons.cdr; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = cell->payload.string.cdr; + break; } + } - return result; + return result; } /** - * Implementation of `length` in C. If arg is not a cons, does not error but returns 0. + * Implementation of `length` in C. If arg is not a cons, does not error but + * returns 0. */ int c_length( struct cons_pointer arg ) { - int result = 0; + int result = 0; - for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) { - result++; - } + for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) { + result++; + } - return result; + return result; } - /** * Construct a cons cell from this pair of pointers. */ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr ) { - struct cons_pointer pointer = NIL; + struct cons_pointer pointer = NIL; - pointer = allocate_cell( CONSTV ); + pointer = allocate_cell( CONSTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( car ); - inc_ref( cdr ); - cell->payload.cons.car = car; - cell->payload.cons.cdr = cdr; + inc_ref( car ); + inc_ref( cdr ); + cell->payload.cons.car = car; + cell->payload.cons.cdr = cdr; - return pointer; + return pointer; } /** * Construct an exception cell. - * @param message should be a lisp string describing the problem, but actually any cons pointer will do; - * @param frame_pointer should be the pointer to the frame in which the exception occurred. + * @param message should be a lisp string describing the problem, but actually + * any cons pointer will do; + * @param frame_pointer should be the pointer to the frame in which the + * exception occurred. */ struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer frame_pointer ) { - struct cons_pointer result = NIL; - struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( message ); - inc_ref( frame_pointer ); - cell->payload.exception.payload = message; - cell->payload.exception.frame = frame_pointer; + inc_ref( message ); + inc_ref( frame_pointer ); + cell->payload.exception.payload = message; + cell->payload.exception.frame = frame_pointer; - result = pointer; + result = pointer; - return result; + return result; } - /** * Construct a cell which points to an executable Lisp function. */ -struct cons_pointer -make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) - ( struct stack_frame *, - struct cons_pointer, struct cons_pointer ) ) { - struct cons_pointer pointer = allocate_cell( FUNCTIONTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( meta ); +struct cons_pointer make_function( + struct cons_pointer meta, + struct cons_pointer ( *executable )( struct stack_frame *, + struct cons_pointer, + struct cons_pointer ) ) { + struct cons_pointer pointer = allocate_cell( FUNCTIONTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( meta ); - cell->payload.function.meta = meta; - cell->payload.function.executable = executable; + cell->payload.function.meta = meta; + cell->payload.function.executable = executable; - return pointer; + return pointer; } /** @@ -235,17 +234,18 @@ make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) */ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( LAMBDATV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( LAMBDATV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ + inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do + this, but if I don't the cell gets freed */ - inc_ref( args ); - inc_ref( body ); - cell->payload.lambda.args = args; - cell->payload.lambda.body = body; + inc_ref( args ); + inc_ref( body ); + cell->payload.lambda.args = args; + cell->payload.lambda.body = body; - return pointer; + return pointer; } /** @@ -254,48 +254,48 @@ struct cons_pointer make_lambda( struct cons_pointer args, */ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( NLAMBDATV ); + struct cons_pointer pointer = allocate_cell( NLAMBDATV ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ + inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do + this, but if I don't the cell gets freed */ - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( args ); - inc_ref( body ); - cell->payload.lambda.args = args; - cell->payload.lambda.body = body; + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( args ); + inc_ref( body ); + cell->payload.lambda.args = args; + cell->payload.lambda.body = body; - return pointer; + return pointer; } /** * Return a hash value for this string like thing. - * + * * What's important here is that two strings with the same characters in the * same order should have the same hash value, even if one was created using - * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function - * has that property. I doubt that it's the most efficient hash function to + * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function + * has that property. I doubt that it's the most efficient hash function to * have that property. - * + * * returns 0 for things which are not string like. */ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) { - struct cons_space_object *cell = &pointer2cell( ptr ); - uint32_t result = 0; + struct cons_space_object *cell = &pointer2cell( ptr ); + uint32_t result = 0; - switch ( cell->tag.value ) { - case KEYTV: - case STRINGTV: - case SYMBOLTV: - if ( nilp( cell->payload.string.cdr ) ) { - result = ( uint32_t ) c; - } else { - result = ( ( uint32_t ) c * - cell->payload.string.hash ) & 0xffffffff; - } - break; - } + switch ( cell->tag.value ) { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if ( nilp( cell->payload.string.cdr ) ) { + result = (uint32_t)c; + } else { + result = ( (uint32_t)c * cell->payload.string.hash ) & 0xffffffff; + } + break; + } - return result; + return result; } /** @@ -304,31 +304,31 @@ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) { * has one character and a pointer to the next; in the last cell the * pointer to next is NIL. */ -struct cons_pointer -make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { - struct cons_pointer pointer = NIL; +struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, + uint32_t tag ) { + struct cons_pointer pointer = NIL; - if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) { - pointer = allocate_cell( tag ); - struct cons_space_object *cell = &pointer2cell( pointer ); + if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) { + pointer = allocate_cell( tag ); + struct cons_space_object *cell = &pointer2cell( pointer ); - 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 - * strings are quite massively off. Fix is probably - * cell->payload.string.cdr = tail */ - cell->payload.string.cdr.offset = tail.offset; + 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 + * strings are quite massively off. Fix is probably + * cell->payload.string.cdr = tail */ + cell->payload.string.cdr.offset = tail.offset; - cell->payload.string.hash = calculate_hash( c, tail ); - } else { - // \todo should throw an exception! - debug_printf( DEBUG_ALLOC, - L"Warning: only NIL and %4.4s can be prepended to %4.4s\n", - tag, tag ); - } + cell->payload.string.hash = calculate_hash( c, tail ); + } else { + // \todo should throw an exception! + debug_printf( DEBUG_ALLOC, + L"Warning: only NIL and %4.4s can be prepended to %4.4s\n", + tag, tag ); + } - return pointer; + return pointer; } /** @@ -340,7 +340,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { * @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, STRINGTV ); + return make_string_like_thing( c, tail, STRINGTV ); } /** @@ -353,36 +353,45 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { */ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, uint32_t tag ) { - struct cons_pointer result = make_string_like_thing( c, tail, tag ); + struct cons_pointer result; + + if ( tag == SYMBOLTV || tag == KEYTV ) { + result = make_string_like_thing( c, tail, tag ); if ( tag == KEYTV ) { - struct cons_pointer r = internedp( result, oblist ); + struct cons_pointer r = internedp( result, oblist ); - if ( nilp( r ) ) { - intern( result, oblist ); - } else { - result = r; - } + if ( nilp( r ) ) { + intern( result, oblist ); + } else { + result = r; + } } + } else { + result = make_exception( + c_string_to_lisp_string( L"Unexpected tag when making symbol or key." ), + NIL); + } - return result; + return result; } /** * Construct a cell which points to an executable Lisp special form. */ -struct cons_pointer -make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) - ( struct stack_frame * frame, - struct cons_pointer, struct cons_pointer env ) ) { - struct cons_pointer pointer = allocate_cell( SPECIALTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( meta ); +struct cons_pointer make_special( + struct cons_pointer meta, + struct cons_pointer ( *executable )( struct stack_frame *frame, + struct cons_pointer, + struct cons_pointer env ) ) { + struct cons_pointer pointer = allocate_cell( SPECIALTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( meta ); - cell->payload.special.meta = meta; - cell->payload.special.executable = executable; + cell->payload.special.meta = meta; + cell->payload.special.executable = executable; - return pointer; + return pointer; } /** @@ -391,15 +400,15 @@ make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct cons_pointer make_read_stream( URL_FILE * input, +struct cons_pointer make_read_stream( URL_FILE *input, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( READTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( READTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - cell->payload.stream.stream = input; - cell->payload.stream.meta = metadata; + cell->payload.stream.stream = input; + cell->payload.stream.meta = metadata; - return pointer; + return pointer; } /** @@ -408,59 +417,59 @@ struct cons_pointer make_read_stream( URL_FILE * input, * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct cons_pointer make_write_stream( URL_FILE * output, +struct cons_pointer make_write_stream( URL_FILE *output, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( WRITETV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( WRITETV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - cell->payload.stream.stream = output; - cell->payload.stream.meta = metadata; + cell->payload.stream.stream = output; + cell->payload.stream.meta = metadata; - return pointer; + return pointer; } /** - * Return a lisp keyword representation of this wide character string. In keywords, - * I am accepting only lower case characters and numbers. + * Return a lisp keyword representation of this wide character string. In + * keywords, I am accepting only lower case characters and numbers. */ struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { - wchar_t c = towlower( symbol[i] ); + for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { + wchar_t c = towlower( symbol[i] ); - if ( iswalnum( c ) || c == L'-' ) { - result = make_keyword( c, result ); - } + if ( iswalnum( c ) || c == L'-' ) { + result = make_keyword( c, result ); } + } - return result; + return result; } /** * Return a lisp string representation of this wide character string. */ struct cons_pointer c_string_to_lisp_string( wchar_t *string ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { - if ( iswprint( string[i] ) && string[i] != '"' ) { - result = make_string( string[i], result ); - } + for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { + if ( iswprint( string[i] ) && string[i] != '"' ) { + result = make_string( string[i], result ); } + } - return result; + return result; } /** * Return a lisp symbol representation of this wide character string. */ struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( symbol ); i > 0; i-- ) { - result = make_symbol( symbol[i - 1], result ); - } + for ( int i = wcslen( symbol ); i > 0; i-- ) { + result = make_symbol( symbol[i - 1], result ); + } - return result; + return result; } diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 7c3a390..e4c0b95 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -478,6 +478,8 @@ struct free_payload { * 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. + * + * \todo Why is this 60, and not 64 bits? */ struct integer_payload { /** the value of the payload (i.e. 60 bits) of this cell. */ diff --git a/src/ops/lispops.c b/src/ops/lispops.c index f9fb95a..7d1a761 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -681,6 +681,8 @@ bool end_of_stringp( struct cons_pointer arg ) { * 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. + * + * Thus: `(cons "a" "bcd") -> "abcd"`, but `(cons "ab" "cd") -> ("ab" . "cd")` * * * (cons a b) * @@ -700,7 +702,6 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, return NIL; } else if ( stringp( car ) && stringp( cdr ) && end_of_stringp( c_cdr( car ) ) ) { - // \todo check that car is of length 1 result = make_string( pointer2cell( car ).payload.string.character, cdr ); } else {