Just poking around and trying to remember where the problems are.
This commit is contained in:
parent
fae4a4d444
commit
7ab1640a34
|
@ -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 );
|
||||
|
|
|
@ -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 );
|
||||
|
|
|
@ -9,6 +9,7 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <getopt.h>
|
||||
#include <locale.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
|
|
|
@ -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 );
|
||||
}
|
||||
|
|
|
@ -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. */
|
||||
|
|
|
@ -682,6 +682,8 @@ bool end_of_stringp( struct cons_pointer arg ) {
|
|||
* 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)
|
||||
*
|
||||
* @param frame my stack_frame.
|
||||
|
@ -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 {
|
||||
|
|
Loading…
Reference in a new issue