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

The beginning of bignums is in place, tests still pass.

Browse source
This commit is contained in:
Simon Brooke 2018-12-29 22:30:07 +00:00
parent c21a762413
commit 342f0308d3
11 changed files with 134 additions and 96 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/arith/bignum.c
View file

@ -1,14 +0,0 @@
/*
* bignum.c
*
* Allocation of and operations on arbitrary precision integers.
*
* (c) 2018 Simon Brooke <simon@journeyman.cc>
* 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.
*/

16
src/arith/bignum.h
View file

@ -1,16 +0,0 @@
/**
* bignum.h
*
* functions for bignum cells.
*
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __bignum_h
#define __bignum_h
#endif

104
src/arith/integer.c
View file

@ -8,8 +8,10 @@
*/
#define _GNU_SOURCE
#include <limits.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#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;
}

6
src/arith/integer.h
View file

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

25
src/arith/peano.c
View file

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

25
src/arith/ratio.c
View file

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

3
src/memory/conspage.c
View file

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

22
src/memory/consspaceobject.h
View file

@ -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;
};
/**

5
src/ops/equal.c
View file

@ -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:
{

6
src/ops/read.c
View file

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

4
unit-tests/integer-allocation.sh
View file

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