diff --git a/src/arith/integer.c b/src/arith/integer.c index 7ca328f..3bb58bd 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -12,6 +12,7 @@ #include #include #include +#include /* * wide characters */ @@ -32,32 +33,10 @@ 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. + * that integers less than 61 bits are bignums of one cell only. */ -/** - * 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; - debug_print( L"Entering make_integer\n", DEBUG_ALLOC ); - - if ( integerp( more ) || nilp( more ) ) { - result = allocate_cell( INTEGERTV ); - struct cons_space_object *cell = &pointer2cell( result ); - cell->payload.integer.value = value; - cell->payload.integer.more = more; - } - - debug_print( L"make_integer: returning\n", DEBUG_ALLOC ); - debug_dump_object( result, DEBUG_ALLOC ); - return result; -} - -/** + /** * Low level integer arithmetic, do not use elsewhere. * * @param c a pointer to a cell, assumed to be an integer cell; @@ -85,6 +64,35 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { return result; } + +/** + * 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; + debug_print( L"Entering make_integer\n", DEBUG_ALLOC ); + + if ( integerp(more) && (pointer2cell( more ).payload.integer.value < 0)) + { + printf("WARNING: negative value %" PRId64 " passed as `more` to `make_integer`\n", + pointer2cell( more ).payload.integer.value); + } + + if ( integerp( more ) || nilp( more ) ) { + result = allocate_cell( INTEGERTV ); + struct cons_space_object *cell = &pointer2cell( result ); + cell->payload.integer.value = value; + cell->payload.integer.more = more; + } + + debug_print( L"make_integer: returning\n", DEBUG_ALLOC ); + debug_dump_object( result, DEBUG_ALLOC ); + return result; +} + /** * Overwrite the value field of the integer indicated by `new` with * the least significant INTEGER_BITS bits of `val`, and return the diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index e4c0b95..e9a75a6 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -484,7 +484,7 @@ struct free_payload { 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 + /** the next (more significant) cell in the chain, or `NIL` if there are no * more. */ struct cons_pointer more; }; diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 5e1db0a..fcbff31 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -155,7 +155,16 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, } } if ( frame->args > 1 ) { + if ( functionp( frame->arg[1])) { hash_fn = frame->arg[1]; + } else if ( nilp(frame->arg[1])){ + /* that's allowed */ + } else { + result = + make_exception( c_string_to_lisp_string + ( L"Second arg to `hashmap`, if passed, must " + L"be a function or `nil`.`" ), NIL ); + } } if ( nilp( result ) ) { @@ -189,26 +198,23 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, return result; } - - /** * If this `ptr` is a pointer to a hashmap, return a new identical hashmap; - * else return `NIL`. TODO: should return an exception if ptr is not a - * readable hashmap. + * else return an exception. */ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) { struct cons_pointer result = NIL; if ( truep( authorised( ptr, NIL ) ) ) { if ( hashmapp( ptr ) ) { - struct vector_space_object *from = pointer_to_vso( ptr ); + struct vector_space_object const *from = pointer_to_vso( ptr ); if ( from != NULL ) { struct hashmap_payload from_pl = from->payload.hashmap; result = make_hashmap( from_pl.n_buckets, from_pl.hash_fn, from_pl.write_acl ); - struct vector_space_object *to = pointer_to_vso( result ); + struct vector_space_object const *to = pointer_to_vso( result ); struct hashmap_payload to_pl = to->payload.hashmap; for ( int i = 0; i < to_pl.n_buckets; i++ ) { @@ -217,8 +223,12 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) { } } } + } else { + result = + make_exception( c_string_to_lisp_string + ( L"Arg to `clone_hashmap` must " + L"be a readable hashmap.`" ), NIL ); } - // TODO: else exception? return result; } diff --git a/state-of-play.md b/state-of-play.md index e96a15a..498bf60 100644 --- a/state-of-play.md +++ b/state-of-play.md @@ -1,5 +1,21 @@ # State of Play +## 20250704 + +Right, I'm getting second and subsequent integer cells with negative values, which should not happen. This is probably the cause of (at least some of) the bignum problems. I need to find out why. This is (probably) fixable. + +```lisp +:: (inspect 10000000000000000000) + + INTR (1381256777) at page 3, offset 873 count 2 + Integer cell: value 776627963145224192, count 2 + BIGNUM! More at: + INTR (1381256777) at page 3, offset 872 count 1 + Integer cell: value -8, count 1 +``` + +Also, `print` is printing bignums wrong on ploughwright, but less wrong on mason, which implies a code difference. Investigate. + ## 20250314 Thinking further about this, I think at least part of the problem is that I'm storing bignums as cons-space objects, which means that the integer representation I can store has to fit into the size of a cons pointer, which is 64 bits. Which means that to store integers larger than 64 bits I need chains of these objects.