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/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.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 {