diff --git a/src/arith/bignum.c b/src/arith/bignum.c deleted file mode 100644 index a21a7df..0000000 --- a/src/arith/bignum.c +++ /dev/null @@ -1,14 +0,0 @@ -/* - * bignum.c - * - * Allocation of and operations on arbitrary precision integers. - * - * (c) 2018 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -/* - * Bignums generally follow Knuth, vol 2, 4.3. The word size is 64 bits, - * and words are stored in individual cons-space objects, comprising the - * word itself and a pointer to the next word in the number. - */ diff --git a/src/arith/bignum.h b/src/arith/bignum.h deleted file mode 100644 index 05c9073..0000000 --- a/src/arith/bignum.h +++ /dev/null @@ -1,16 +0,0 @@ -/** - * bignum.h - * - * functions for bignum cells. - * - * - * (c) 2017 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#ifndef __bignum_h -#define __bignum_h - - - -#endif diff --git a/src/arith/integer.c b/src/arith/integer.c index 5239746..7b14d22 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -8,8 +8,10 @@ */ #define _GNU_SOURCE +#include #include #include +#include #include "conspage.h" #include "consspaceobject.h" @@ -17,31 +19,109 @@ /** * return the numeric value of this cell, as a C primitive double, not - * as a cons-space object. Cell may in principle be any kind of number, - * but only integers and reals are so far implemented. + * as a cons-space object. Cell may in principle be any kind of number. */ long double numeric_value( struct cons_pointer pointer ) { - long double result = NAN; - struct cons_space_object *cell = &pointer2cell( pointer ); + long double result = NAN; + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( integerp( pointer ) ) { - result = cell->payload.integer.value * 1.0; - } else if ( realp( pointer ) ) { - result = cell->payload.real.value; + switch (cell->tag.value) { + case INTEGERTV: + result = 1.0; + while (cell->tag.value == INTEGERTV) { + result = (result * LONG_MAX * cell->payload.integer.value); + cell = &pointer2cell(cell->payload.integer.more); } + break; + case RATIOTV: + result = numeric_value(cell->payload.ratio.dividend) / + numeric_value(cell->payload.ratio.divisor); + break; + case REALTV: + result = cell->payload.real.value; + break; + // default is NAN + } - return result; + return result; } /** * Allocate an integer cell representing this value and return a cons pointer to it. */ -struct cons_pointer make_integer( int64_t value ) { - struct cons_pointer result = allocate_cell( INTEGERTAG ); +struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) { + struct cons_pointer result = NIL; + + if (integerp(more) || nilp(more)) { + result = allocate_cell( INTEGERTAG ); struct cons_space_object *cell = &pointer2cell( result ); cell->payload.integer.value = value; + cell->payload.integer.more = more; debug_dump_object( result, DEBUG_ARITH ); + } - return result; + return result; +} + +/** + * Return the sum of the integers pointed to by `a` and `b`. If either isn't + * an integer, will return nil. + */ +struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer b) { + struct cons_pointer result = NIL; + int64_t carry = 0; + + if (integerp(a) && integerp(b)) { + while (!nilp(a) || !nilp(b) || carry != 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; + + if (rv > LONG_MAX || rv < LONG_MIN) { + carry = llabs(rv / LONG_MAX); + rv = rv % LONG_MAX; + } else { + carry = 0; + } + + result = make_integer( rv, result); + a = pointer2cell(a).payload.integer.more; + b = pointer2cell(b).payload.integer.more; + } + } + + return result; +} + +/** + * Return the product of the integers pointed to by `a` and `b`. If either isn't + * an integer, will return nil. + */ +struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b) { + struct cons_pointer result = NIL; + int64_t carry = 0; + + if (integerp(a) && integerp(b)) { + 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 rv = (av * bv) + carry; + + if (rv > LONG_MAX || rv < LONG_MIN) { + carry = llabs(rv / LONG_MAX); + rv = rv % LONG_MAX; + } else { + carry = 0; + } + + result = make_integer( rv, result); + a = pointer2cell(a).payload.integer.more; + b = pointer2cell(b).payload.integer.more; + } + } + + return result; } diff --git a/src/arith/integer.h b/src/arith/integer.h index 00b94a6..9f9b984 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -16,6 +16,10 @@ long double numeric_value( struct cons_pointer pointer ); /** * Allocate an integer cell representing this value and return a cons pointer to it. */ -struct cons_pointer make_integer( int64_t value ); +struct cons_pointer make_integer( int64_t value, struct cons_pointer more ); + +struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer b); + +struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b); #endif diff --git a/src/arith/peano.c b/src/arith/peano.c index a52f314..56c2190 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -152,8 +152,7 @@ struct cons_pointer add_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV: - result = make_integer( cell1.payload.integer.value + - cell2.payload.integer.value ); + result = add_integers( arg1, arg2 ); break; case RATIOTV: result = @@ -224,7 +223,7 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer result = make_integer( 0 ); + struct cons_pointer result = make_integer( 0, NIL ); struct cons_pointer tmp; for ( int i = 0; @@ -285,8 +284,7 @@ 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 ); + result = multiply_integers( arg1, arg2 ); break; case RATIOTV: result = @@ -361,7 +359,7 @@ struct cons_pointer lisp_multiply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer result = make_integer( 1 ); + struct cons_pointer result = make_integer( 1, NIL ); struct cons_pointer tmp; for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ) @@ -404,7 +402,8 @@ struct cons_pointer inverse( struct cons_pointer frame, result = arg; break; case INTEGERTV: - result = make_integer( 0 - to_long_int( arg ) ); + // TODO: bignums + result = make_integer( 0 - to_long_int( arg ), NIL ); break; case NILTV: result = TRUE; @@ -413,7 +412,7 @@ struct cons_pointer inverse( struct cons_pointer frame, result = make_ratio( frame, make_integer( 0 - to_long_int( cell.payload.ratio. - dividend ) ), + dividend ), NIL ), cell.payload.ratio.divisor ); break; case REALTV: @@ -453,12 +452,12 @@ struct cons_pointer lisp_subtract( struct break; case INTEGERTV: result = make_integer( cell0.payload.integer.value - - cell1.payload.integer.value ); + - cell1.payload.integer.value, NIL ); break; case RATIOTV:{ struct cons_pointer tmp = make_ratio( frame_pointer, frame->arg[0], - make_integer( 1 ) ); + make_integer( 1, NIL ) ); inc_ref( tmp ); result = subtract_ratio_ratio( frame_pointer, tmp, @@ -486,7 +485,7 @@ struct cons_pointer lisp_subtract( struct case INTEGERTV:{ struct cons_pointer tmp = make_ratio( frame_pointer, frame->arg[1], - make_integer( 1 ) ); + make_integer( 1, NIL ) ); inc_ref( tmp ); result = subtract_ratio_ratio( frame_pointer, frame->arg[0], @@ -564,7 +563,7 @@ struct cons_pointer lisp_divide( struct } break; case RATIOTV:{ - struct cons_pointer one = make_integer( 1 ); + struct cons_pointer one = make_integer( 1, NIL ); struct cons_pointer ratio = make_ratio( frame_pointer, frame->arg[0], one ); inc_ref( ratio ); @@ -592,7 +591,7 @@ struct cons_pointer lisp_divide( struct result = frame->arg[1]; break; case INTEGERTV:{ - struct cons_pointer one = make_integer( 1 ); + struct cons_pointer one = make_integer( 1, NIL ); inc_ref( one ); struct cons_pointer ratio = make_ratio( frame_pointer, frame->arg[1], one ); diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 31dd0a2..7b587e1 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -68,11 +68,11 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, if ( gcd > 1 ) { if ( drrv / gcd == 1 ) { - result = make_integer( ddrv / gcd ); + result = make_integer( ddrv / gcd , NIL); } else { result = - make_ratio( frame_pointer, make_integer( ddrv / gcd ), - make_integer( drrv / gcd ) ); + make_ratio( frame_pointer, make_integer( ddrv / gcd , NIL), + make_integer( drrv / gcd , NIL) ); } } } else { @@ -106,6 +106,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, if ( ratiop( arg1 ) && ratiop( arg2 ) ) { struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); + // TODO: to be entirely reworked for bignums. All vars must be lisp integers. int64_t dd1v = pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value, dd2v = @@ -122,13 +123,13 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, if ( dr1v == dr2v ) { r = make_ratio( frame_pointer, - make_integer( dd1v + dd2v ), + make_integer( dd1v + dd2v, NIL ), cell1.payload.ratio.divisor ); } else { - struct cons_pointer dd1vm = make_integer( dd1v * m1 ), - dr1vm = make_integer( dr1v * m1 ), - dd2vm = make_integer( dd2v * m2 ), - dr2vm = make_integer( dr2v * m2 ), + struct cons_pointer dd1vm = make_integer( dd1v * m1, NIL ), + dr1vm = make_integer( dr1v * m1, NIL ), + dd2vm = make_integer( dd2v * m2, NIL ), + dr2vm = make_integer( dr2v * m2, NIL ), r1 = make_ratio( frame_pointer, dd1vm, dr1vm ), r2 = make_ratio( frame_pointer, dd2vm, dr2vm ); @@ -173,7 +174,7 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer result; if ( integerp( intarg ) && ratiop( ratarg ) ) { - struct cons_pointer one = make_integer( 1 ), + struct cons_pointer one = make_integer( 1, NIL ), ratio = make_ratio( frame_pointer, intarg, one ); result = add_ratio_ratio( frame_pointer, ratio, ratarg ); @@ -243,8 +244,8 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str ddrv = dd1v * dd2v, drrv = dr1v * dr2v; struct cons_pointer unsimplified = - make_ratio( frame_pointer, make_integer( ddrv ), - make_integer( drrv ) ); + make_ratio( frame_pointer, make_integer( ddrv, NIL ), + make_integer( drrv , NIL) ); result = simplify_ratio( frame_pointer, unsimplified ); if ( !eq( unsimplified, result ) ) { @@ -271,7 +272,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, struct cons_pointer result; if ( integerp( intarg ) && ratiop( ratarg ) ) { - struct cons_pointer one = make_integer( 1 ), + struct cons_pointer one = make_integer( 1, NIL), ratio = make_ratio( frame_pointer, intarg, one ); result = multiply_ratio_ratio( frame_pointer, ratio, ratarg ); diff --git a/src/memory/conspage.c b/src/memory/conspage.c index eee6d2d..975c9da 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -150,6 +150,9 @@ void free_cell( struct cons_pointer pointer ) { case FUNCTIONTV: dec_ref( cell->payload.function.source ); break; + case INTEGERTV: + dec_ref( cell->payload.integer.more); + break; case LAMBDATV: case NLAMBDATV: dec_ref( cell->payload.lambda.args ); diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 523fdaa..0cf44a7 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -29,12 +29,6 @@ * tag values, all of which must be 4 bytes. Must not collide with vector space tag values */ -/** - * A word within a bignum - arbitrary precision integer. - */ -#define BIGNUMTAG "BIGN" -#define BIGNUMTV 1313294658 - /** * An ordinary cons cell: 1397641027 */ @@ -168,11 +162,6 @@ */ #define nilp(conspoint) (check_tag(conspoint,NILTAG)) -/** - * true if conspointer points to a cons cell, else false - */ -#define bignump(conspoint) (check_tag(conspoint,BIGNUMTAG)) - /** * true if conspointer points to a cons cell, else false */ @@ -289,16 +278,6 @@ struct stack_frame { int args; }; -/** - * payload of a bignum cell. Intentionally similar to an integer payload, but - * with a next pointer. - */ -struct bignum_payload { - int64_t value; - struct cons_pointer next; -}; - - /** * payload of a cons cell. */ @@ -348,6 +327,7 @@ struct free_payload { */ struct integer_payload { int64_t value; + struct cons_pointer more; }; /** diff --git a/src/ops/equal.c b/src/ops/equal.c index ebb085e..877a8cc 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -85,8 +85,9 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { break; case INTEGERTV: result = - cell_a->payload.integer.value == - cell_b->payload.integer.value; + (cell_a->payload.integer.value == + cell_b->payload.integer.value) && + equal(cell_a->payload.integer.more, cell_b->payload.integer.more); break; case REALTV: { diff --git a/src/ops/read.c b/src/ops/read.c index 69de893..2a8522c 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -220,13 +220,13 @@ struct cons_pointer read_number( struct stack_frame *frame, result = make_real( rv ); } else if ( dividend != 0 ) { result = - make_ratio( frame_pointer, make_integer( dividend ), - make_integer( accumulator ) ); + make_ratio( frame_pointer, make_integer( dividend, NIL ), + make_integer( accumulator, NIL ) ); } else { if ( negative ) { accumulator = 0 - accumulator; } - result = make_integer( accumulator ); + result = make_integer( accumulator, NIL ); } debug_print( L"read_number returning\n", DEBUG_IO ); diff --git a/unit-tests/integer-allocation.sh b/unit-tests/integer-allocation.sh index 5d07d90..ced92f2 100644 --- a/unit-tests/integer-allocation.sh +++ b/unit-tests/integer-allocation.sh @@ -1,8 +1,8 @@ #!/bin/bash value=354 -expected="Integer cell: value ${value}" -echo ${value} | target/psse -d 2>&1 | grep "${expected}" > /dev/null +expected="Integer cell: value ${value}," +echo ${value} | target/psse -v5 2>&1 | grep "${expected}" > /dev/null if [ $? -eq 0 ] then