diff --git a/src/arith/bignum.c b/src/arith/bignum.c new file mode 100644 index 0000000..a21a7df --- /dev/null +++ b/src/arith/bignum.c @@ -0,0 +1,14 @@ +/* + * 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 new file mode 100644 index 0000000..05c9073 --- /dev/null +++ b/src/arith/bignum.h @@ -0,0 +1,16 @@ +/** + * 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 e069f52..60ce8c3 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -35,7 +35,7 @@ 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( long int value ) { +struct cons_pointer make_integer( int64_t value ) { struct cons_pointer result = allocate_cell( INTEGERTAG ); struct cons_space_object *cell = &pointer2cell( result ); cell->payload.integer.value = value; diff --git a/src/arith/integer.h b/src/arith/integer.h index d44f34d..00b94a6 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -16,6 +16,6 @@ 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( long int value ); +struct cons_pointer make_integer( int64_t value ); #endif diff --git a/src/arith/peano.c b/src/arith/peano.c index d43c768..2b0183d 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -27,7 +27,7 @@ #include "stack.h" long double to_long_double( struct cons_pointer arg ); -long int to_long_int( struct cons_pointer arg ); +int64_t to_long_int( struct cons_pointer arg ); struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1, struct cons_pointer arg2 ); @@ -97,8 +97,8 @@ long double to_long_double( struct cons_pointer arg ) { * if a ratio may legally have zero as a divisor, or something which is * not a number (or is a big number) is passed in. */ -long int to_long_int( struct cons_pointer arg ) { - long int result = 0; +int64_t to_long_int( struct cons_pointer arg ) { + int64_t result = 0; struct cons_space_object cell = pointer2cell( arg ); switch ( cell.tag.value ) { case INTEGERTV: @@ -125,10 +125,13 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1, struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); +#ifdef DEBUG fputws( L"add_2( arg1 = ", stderr ); print( stderr, arg1 ); fputws( L"; arg2 = ", stderr ); print( stderr, arg2 ); + fputws( L")\n", stderr); +#endif if ( zerop( arg1 ) ) { result = arg2; @@ -199,9 +202,11 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1, } } +#ifdef DEBUG fputws( L"}; => ", stderr ); print( stderr, arg2 ); fputws( L"\n", stderr ); +#endif return result; } @@ -254,17 +259,19 @@ struct cons_pointer multiply_2( struct stack_frame *frame, struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); +#ifdef DEBUG fputws( L"multiply_2( arg1 = ", stderr ); print( stderr, arg1 ); fputws( L"; arg2 = ", stderr ); print( stderr, arg2 ); + fputws( L")\n", stderr); +#endif if ( zerop( arg1 ) ) { result = arg2; } else if ( zerop( arg2 ) ) { result = arg1; } else { - switch ( cell1.tag.value ) { case EXCEPTIONTV: result = arg1; @@ -328,9 +335,11 @@ struct cons_pointer multiply_2( struct stack_frame *frame, } } - fputws( L"}; => ", stderr ); +#ifdef DEBUG + fputws( L" => ", stderr ); print( stderr, arg2 ); fputws( L"\n", stderr ); +#endif return result; } diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 28ba59a..ff716ec 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -28,9 +28,9 @@ struct cons_pointer inverse( struct stack_frame *frame, struct cons_pointer arg ); /** - * return, as a long int, the greatest common divisor of `m` and `n`, + * return, as a int64_t, the greatest common divisor of `m` and `n`, */ -long int greatest_common_divisor( long int m, long int n ) { +int64_t greatest_common_divisor( int64_t m, int64_t n ) { int o; while ( m ) { o = m; @@ -42,9 +42,9 @@ long int greatest_common_divisor( long int m, long int n ) { } /** - * return, as a long int, the least common multiple of `m` and `n`, + * return, as a int64_t, the least common multiple of `m` and `n`, */ -long int least_common_multiple( long int m, long int n ) { +int64_t least_common_multiple( int64_t m, int64_t n ) { return m / greatest_common_divisor( m, n ) * n; } @@ -59,7 +59,7 @@ struct cons_pointer simplify_ratio( struct stack_frame *frame, struct cons_pointer result = arg; if (ratiop(arg)) { - long int ddrv = + int64_t ddrv = pointer2cell( pointer2cell( arg ).payload.ratio.dividend ). payload.integer.value, drrv = pointer2cell( pointer2cell( arg ).payload.ratio.divisor ). @@ -106,7 +106,7 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame, if ( ratiop(arg1) && ratiop(arg2)) { struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); - long int dd1v = + int64_t dd1v = pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value, dd2v = pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value, @@ -231,7 +231,7 @@ struct cons_pointer multiply_ratio_ratio( struct if ( ratiop(arg1) && ratiop(arg2)) { struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell2 = pointer2cell( arg2 ); - long int dd1v = + int64_t dd1v = pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value, dd2v = pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value, diff --git a/src/memory/conspage.c b/src/memory/conspage.c index c5920c0..13d8373 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -127,8 +127,10 @@ void dump_pages( FILE * output ) { void free_cell( struct cons_pointer pointer ) { struct cons_space_object *cell = &pointer2cell( pointer ); +#ifdef DEBUG fwprintf( stderr, L"Freeing cell " ); dump_object( stderr, pointer ); +#endif switch ( cell->tag.value ) { /* for all the types of cons-space object which point to other @@ -173,7 +175,7 @@ void free_cell( struct cons_pointer pointer ) { if ( !check_tag( pointer, FREETAG ) ) { if ( cell->count == 0 ) { - strncpy( &cell->tag.bytes[0], FREETAG, 4 ); + strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH ); cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; freelist = pointer; @@ -209,7 +211,7 @@ struct cons_pointer allocate_cell( char *tag ) { if ( strncmp( &cell->tag.bytes[0], FREETAG, TAGLENGTH ) == 0 ) { freelist = cell->payload.free.cdr; - strncpy( &cell->tag.bytes[0], tag, 4 ); + strncpy( &cell->tag.bytes[0], tag, TAGLENGTH ); cell->count = 0; cell->payload.cons.car = NIL; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 50ad5e1..555614a 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -28,6 +28,13 @@ /** * 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 */ @@ -38,7 +45,6 @@ * An exception. */ #define EXCEPTIONTAG "EXEP" -/* TODO: this is wrong */ #define EXCEPTIONTV 1346721861 /** @@ -162,6 +168,11 @@ */ #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 */ @@ -221,7 +232,7 @@ * true if conspointer points to some sort of a number cell, * else false */ -#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||heck_tag(conspoint,REALTAG)) +#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG)) /** * true if thr conspointer points to a vector pointer. @@ -274,6 +285,16 @@ struct stack_frame { struct cons_pointer function; /* the function to be called */ }; +/** + * 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. */ @@ -321,7 +342,7 @@ struct free_payload { * optional bignum object. */ struct integer_payload { - long int value; + int64_t value; }; /** diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 6e331d6..4b18b96 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -45,9 +45,9 @@ struct cons_pointer make_vec_pointer( char *tag, uint64_t address ) { * NOTE that `tag` should be the vector-space tag of the particular type of * vector-space object, NOT `VECTORPOINTTAG`. */ -struct cons_pointer make_vso( char *tag, long int payload_size ) { +struct cons_pointer make_vso( char *tag, int64_t payload_size ) { struct cons_pointer result = NIL; - long int total_size = sizeof( struct vector_space_header ) + payload_size; + int64_t total_size = sizeof( struct vector_space_header ) + payload_size; struct vector_space_header *vso = malloc( total_size ); diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index b338766..07a0b91 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -34,6 +34,11 @@ #define NAMESPACETAG "NMSP" #define NAMESPACETV 0 +/* + * a stack frame. + */ +#define STACKFRAMETAG "STAK" +#define STACKFRAMETV /* * a vector of cons pointers. */ @@ -42,7 +47,7 @@ #define pointer_to_vso(pointer)(vectorpointp(pointer)? pointer2cell(pointer).payload.vectorp.address : 0) -struct cons_pointer make_vso( char *tag, long int payload_size ); +struct cons_pointer make_vso( char *tag, int64_t payload_size ); struct vector_space_header { union { diff --git a/src/ops/read.c b/src/ops/read.c index e5a41a5..9c21c9a 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -125,8 +125,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input, struct cons_pointer read_number( struct stack_frame *frame, FILE * input, wint_t initial, bool seen_period ) { struct cons_pointer result = NIL; - long int accumulator = 0; - long int dividend = 0; + int64_t accumulator = 0; + int64_t dividend = 0; int places_of_decimals = 0; wint_t c; fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial ); diff --git a/utils_src/tagvalcalc/tagvalcalc.c b/utils_src/tagvalcalc/tagvalcalc.c index 1159187..67828bd 100644 --- a/utils_src/tagvalcalc/tagvalcalc.c +++ b/utils_src/tagvalcalc/tagvalcalc.c @@ -1,9 +1,26 @@ #include #include +#include +#include + +#define TAGLENGTH 4 + +struct dummy { + union { + char bytes[TAGLENGTH]; /* the tag (type) of this cell, + * considered as bytes */ + uint32_t value; /* the tag considered as a number */ + } tag; +}; int main( int argc, char *argv[] ) { + struct dummy *b = malloc( sizeof( struct dummy)); + struct dummy buffer = *b; for (int i = 1; i < argc; i++) { - printf( "%4.4s:\t%u\n", argv[i], (uint32_t)*argv[i]); + + strncpy( &buffer.tag.bytes[0], argv[i], TAGLENGTH ); + + printf( "%4.4s:\t%d\n", argv[i], buffer.tag.value); } } diff --git a/utils_src/tagvalcalc/tvc b/utils_src/tagvalcalc/tvc index 8fb6cb3..a639364 100755 Binary files a/utils_src/tagvalcalc/tvc and b/utils_src/tagvalcalc/tvc differ