From 4295b6e57f54128c201e7f0f27e489eb2bfc44ee Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 1 Jan 2019 15:04:44 +0000 Subject: [PATCH] This isn't working, but it's VERY promising. --- Makefile | 2 + lisp/fact.lisp | 2 +- notes/bignums.md | 7 ++++ src/arith/integer.c | 96 ++++++++++++++++++++++++++++++++------------- src/arith/peano.c | 12 +++--- 5 files changed, 84 insertions(+), 35 deletions(-) create mode 100644 notes/bignums.md diff --git a/Makefile b/Makefile index 4fe322f..7179c91 100644 --- a/Makefile +++ b/Makefile @@ -18,6 +18,8 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG LDFLAGS := -lm +all: $(TARGET) + $(TARGET): $(OBJS) Makefile $(CC) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) diff --git a/lisp/fact.lisp b/lisp/fact.lisp index 968ea73..7df7246 100644 --- a/lisp/fact.lisp +++ b/lisp/fact.lisp @@ -4,4 +4,4 @@ (cond ((= n 1) 1) (t (* n (fact (- n 1))))))) -(fact 20) +(fact 21) diff --git a/notes/bignums.md b/notes/bignums.md new file mode 100644 index 0000000..ea4b0b3 --- /dev/null +++ b/notes/bignums.md @@ -0,0 +1,7 @@ +# All integers are potentially bignums + +Each integer comprises at least one cell of type INTR, holding a signed 64 bit integer with a value in the range 0 ... MAX-INTEGER, where the actual value of MAX-INTEGER does not need to be the same as the C language LONG\_MAX, provided that it is less than this. It seems to me that a convenient number would be the largest number less than LONG\_MAX which has all bits set + +LONG\_MAX is 0x7FFFFFFFFFFFFFFF, so the number we're looking for is 0xFFFFFFFFFFFFFFF, which is 1,152,921,504,606,846,975, which is 2^60 - 1. This means we can use bit masking with 0xFFFFFFFFFFFFFFF to extract the part of **int64_t** which will fit in a single cell. + +It also means that if we multiply two **int64_t**s into an **__int128_t**, we can then right-shift by 60 places to get the carry. \ No newline at end of file diff --git a/src/arith/integer.c b/src/arith/integer.c index ec242bd..f7bb77d 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -28,6 +28,11 @@ #include "consspaceobject.h" #include "debug.h" +/* + * The maximum value we will allow in an integer cell. + */ +#define MAX_INTEGER ((__int128_t)0xFFFFFFFFFFFFFFF) + /** * hexadecimal digits for printing numbers. */ @@ -98,36 +103,48 @@ struct cons_pointer add_integers( struct cons_pointer a, debug_print( L"Entering add_integers\n", DEBUG_ARITH ); struct cons_pointer result = NIL; - int64_t carry = 0; + struct cons_pointer cursor = NIL; + __int128_t carry = 0; if ( integerp( a ) && integerp( b ) ) { + debug_print( L"add_integers: ", DEBUG_ARITH ); + debug_print_object( a, DEBUG_ARITH ); + debug_print( L" x ", DEBUG_ARITH ); + debug_print_object( b, DEBUG_ARITH ); + debug_printf( DEBUG_ARITH, L"; carry = %ld\n", carry ); + while ( !nilp( a ) || !nilp( b ) || carry != 0 ) { - debug_print( L"add_integers: ", DEBUG_ARITH ); - debug_print_object( a, DEBUG_ARITH ); - debug_print( L" x ", DEBUG_ARITH ); - debug_print_object( b, DEBUG_ARITH ); - debug_printf( DEBUG_ARITH, L"; carry = %ld\n", carry ); + __int128_t av = + (__int128_t)integerp( a ) ? pointer2cell( a ).payload.integer.value : 0; + __int128_t bv = + (__int128_t)integerp( b ) ? pointer2cell( b ).payload.integer.value : 0; - int64_t av = - integerp( a ) ? pointer2cell( a ).payload.integer.value : 0; - int64_t bv = - integerp( b ) ? pointer2cell( b ).payload.integer.value : 0; + __int128_t rv = av + bv + carry; - int64_t rv = 0; - - if ( safe_add( &rv, av, bv ) ) { + if ( MAX_INTEGER >= rv ) { carry = 0; } else { // TODO: we're correctly detecting overflow, but not yet correctly // handling it. + carry = rv >> 60; debug_printf( DEBUG_ARITH, L"add_integers: 64 bit overflow; setting carry to %ld\n", - carry ); - carry = llabs( rv / LONG_MAX ); - rv = rv % LONG_MAX; + (int64_t)carry ); + rv = rv & MAX_INTEGER; + } + + struct cons_pointer tail = make_integer( (int64_t)(rv << 64), NIL); + + if (nilp(cursor)) { + cursor = tail; + } else { + inc_ref(tail); + /* yes, this is a destructive change - but the integer has not yet been released + * into the wild */ + struct cons_space_object * c = &pointer2cell(cursor); + c->payload.integer.more = tail; } - result = make_integer( rv, result ); a = pointer2cell( a ).payload.integer.more; b = pointer2cell( b ).payload.integer.more; } @@ -146,7 +163,8 @@ struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b ) { struct cons_pointer result = NIL; - int64_t carry = 0; + struct cons_pointer cursor = NIL; + __int128_t carry = 0; if ( integerp( a ) && integerp( b ) ) { debug_print( L"multiply_integers: ", DEBUG_ARITH ); @@ -156,30 +174,52 @@ struct cons_pointer multiply_integers( struct cons_pointer a, debug_println( DEBUG_ARITH ); while ( !nilp( a ) || !nilp( b ) || carry != 0 ) { - int64_t av = - integerp( a ) ? pointer2cell( a ).payload.integer.value : 1; - int64_t bv = - integerp( b ) ? pointer2cell( b ).payload.integer.value : 1; + __int128_t av = + (__int128_t)integerp( a ) ? pointer2cell( a ).payload.integer.value : 0; + __int128_t bv = + (__int128_t)integerp( b ) ? pointer2cell( b ).payload.integer.value : 0; - int64_t rv = 0; + /* slightly dodgy. `MAX_INTEGER` is substantially smaller than `LONG_MAX`, and + * `LONG_MAX * LONG_MAX` =~ the maximum value for `__int128_t`. So if the carry + * is very large (which I'm not certain whether it can be and am not + * intellectually up to proving it this morning) adding the carry might + * overflow `__int128_t`. Edge-case testing required. + */ + __int128_t rv = (av * bv) + carry; - if ( safe_mul( &rv, av, bv ) ) { + if ( MAX_INTEGER >= rv ) { carry = 0; } else { // TODO: we're correctly detecting overflow, but not yet correctly // handling it. + carry = rv >> 60; debug_printf( DEBUG_ARITH, L"multiply_integers: 64 bit overflow; setting carry to %ld\n", - carry ); - carry = llabs( rv / LONG_MAX ); - rv = rv % LONG_MAX; + (int64_t)carry ); + rv = rv & MAX_INTEGER; + } + + struct cons_pointer tail = make_integer( (int64_t)(rv << 64), NIL); + + if (nilp(cursor)) { + cursor = tail; + } else { + inc_ref(tail); + /* yes, this is a destructive change - but the integer has not yet been released + * into the wild */ + struct cons_space_object * c = &pointer2cell(cursor); + c->payload.integer.more = tail; + } + + if ( nilp(result) ) { + result = cursor; } - result = make_integer( rv, result ); a = pointer2cell( a ).payload.integer.more; b = pointer2cell( b ).payload.integer.more; } } + debug_print( L"multiply_integers returning: ", DEBUG_ARITH ); debug_print_object( result, DEBUG_ARITH ); debug_println( DEBUG_ARITH ); diff --git a/src/arith/peano.c b/src/arith/peano.c index 3a24ed1..f34d632 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -284,10 +284,10 @@ struct cons_pointer multiply_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV: - result = - make_integer( cell1.payload.integer.value * - cell2.payload.integer.value, NIL ); - //result = multiply_integers( arg1, arg2 ); +// result = +// make_integer( cell1.payload.integer.value * +// cell2.payload.integer.value, NIL ); + result = multiply_integers( arg1, arg2 ); break; case RATIOTV: result = @@ -301,7 +301,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame, break; default: result = throw_exception( c_string_to_lisp_string - ( L"Cannot multiply: not a number" ), + ( L"Cannot multiply: argument 2 is not a number" ), frame_pointer ); break; } @@ -327,7 +327,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame, break; default: result = throw_exception( c_string_to_lisp_string - ( L"Cannot multiply: not a number" ), + ( L"Cannot multiply: argument 1 is not a number" ), frame_pointer ); } break;