simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

This isn't working, but it's VERY promising.

Browse source
This commit is contained in:
Simon Brooke 2019-01-01 15:04:44 +00:00
parent 87007362f3
commit 4295b6e57f
5 changed files with 84 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -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)

2
lisp/fact.lisp
View file

@ -4,4 +4,4 @@
(cond ((= n 1) 1)
(t (* n (fact (- n 1)))))))
(fact 20)
(fact 21)

7
notes/bignums.md Normal file
View file

@ -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.

96
src/arith/integer.c
View file

@ -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 );

12
src/arith/peano.c
View file

@ -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;