Compare commits
7 commits
fa99dd6990
...
34ef8cd4c1
| Author | SHA1 | Date | |
|---|---|---|---|
 Simon Brooke
|
34ef8cd4c1 | ||
|
Simon Brooke
|
36696254f2 | ||
|
Simon Brooke
|
7c84cb433a | ||
|
Simon Brooke
|
bef9be4914 | ||
|
Simon Brooke
|
4e76fad655 | ||
|
Simon Brooke
|
e9f49d06a6 | ||
|
Simon Brooke
|
ce1c72973d |
4
Makefile
4
Makefile
|
|
@ -21,6 +21,8 @@ DEBUGFLAGS := -g3
|
|||
|
||||
all: $(TARGET)
|
||||
|
||||
Debug: $(TARGET)
|
||||
|
||||
$(TARGET): $(OBJS) Makefile
|
||||
$(CC) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
|
||||
|
||||
|
|
@ -34,7 +36,7 @@ else
|
|||
indent $(INDENT_FLAGS) $(SRCS) $(HDRS)
|
||||
endif
|
||||
|
||||
test: $(OBJS) $(TESTS) Makefile
|
||||
test: $(TESTS) Makefile $(TARGET)
|
||||
bash ./unit-tests.sh
|
||||
|
||||
.PHONY: clean
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(set! fact
|
||||
(lambda (n)
|
||||
"Compute the factorial of `n`, expected to be an integer."
|
||||
"Compute the factorial of `n`, expected to be a natural number."
|
||||
(cond ((= n 1) 1)
|
||||
(t (* n (fact (- n 1)))))))
|
||||
|
||||
|
|
|
|||
157
post-scarcity.cbp
Normal file
157
post-scarcity.cbp
Normal file
|
|
@ -0,0 +1,157 @@
|
|||
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
|
||||
<CodeBlocks_project_file>
|
||||
<FileVersion major="1" minor="6" />
|
||||
<Project>
|
||||
<Option title="post-scarcity" />
|
||||
<Option makefile_is_custom="1" />
|
||||
<Option pch_mode="2" />
|
||||
<Option compiler="gcc" />
|
||||
<Build>
|
||||
<Target title="Debug">
|
||||
<Option output="bin/Debug/post-scarcity" prefix_auto="1" extension_auto="1" />
|
||||
<Option object_output="obj/Debug/" />
|
||||
<Option type="1" />
|
||||
<Option compiler="gcc" />
|
||||
<Compiler>
|
||||
<Add option="-g" />
|
||||
</Compiler>
|
||||
</Target>
|
||||
<Target title="Release">
|
||||
<Option output="bin/Release/post-scarcity" prefix_auto="1" extension_auto="1" />
|
||||
<Option object_output="obj/Release/" />
|
||||
<Option type="1" />
|
||||
<Option compiler="gcc" />
|
||||
<Compiler>
|
||||
<Add option="-O2" />
|
||||
</Compiler>
|
||||
<Linker>
|
||||
<Add option="-s" />
|
||||
</Linker>
|
||||
</Target>
|
||||
</Build>
|
||||
<Compiler>
|
||||
<Add option="-Wall" />
|
||||
</Compiler>
|
||||
<Unit filename="Makefile" />
|
||||
<Unit filename="src/arith/integer.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/arith/integer.h" />
|
||||
<Unit filename="src/arith/peano.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/arith/peano.h" />
|
||||
<Unit filename="src/arith/ratio.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/arith/ratio.h" />
|
||||
<Unit filename="src/arith/real.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/arith/real.h" />
|
||||
<Unit filename="src/authorise.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/authorise.h" />
|
||||
<Unit filename="src/debug.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/debug.h" />
|
||||
<Unit filename="src/init.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/io/fopen.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/io/fopen.h" />
|
||||
<Unit filename="src/io/io.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/io/io.h" />
|
||||
<Unit filename="src/io/print.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/io/print.h" />
|
||||
<Unit filename="src/io/read.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/io/read.h" />
|
||||
<Unit filename="src/memory/conspage.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/conspage.h" />
|
||||
<Unit filename="src/memory/consspaceobject.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/consspaceobject.h" />
|
||||
<Unit filename="src/memory/cursor.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/cursor.h" />
|
||||
<Unit filename="src/memory/dump.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/dump.h" />
|
||||
<Unit filename="src/memory/hashmap.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/hashmap.h" />
|
||||
<Unit filename="src/memory/lookup3.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/lookup3.h" />
|
||||
<Unit filename="src/memory/stack.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/stack.h" />
|
||||
<Unit filename="src/memory/vectorspace.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/memory/vectorspace.h" />
|
||||
<Unit filename="src/ops/equal.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/ops/equal.h" />
|
||||
<Unit filename="src/ops/intern.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/ops/intern.h" />
|
||||
<Unit filename="src/ops/lispops.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/ops/lispops.h" />
|
||||
<Unit filename="src/ops/loop.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/ops/loop.h" />
|
||||
<Unit filename="src/ops/meta.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/ops/meta.h" />
|
||||
<Unit filename="src/repl.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/repl.h" />
|
||||
<Unit filename="src/time/psse_time.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/time/psse_time.h" />
|
||||
<Unit filename="src/utils.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="src/utils.h" />
|
||||
<Unit filename="src/version.h" />
|
||||
<Unit filename="utils_src/debugflags/debugflags.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="utils_src/readprintwc/readprintwc.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Unit filename="utils_src/tagvalcalc/tagvalcalc.c">
|
||||
<Option compilerVar="CC" />
|
||||
</Unit>
|
||||
<Extensions>
|
||||
<lib_finder disable_auto="1" />
|
||||
</Extensions>
|
||||
</Project>
|
||||
</CodeBlocks_project_file>
|
||||
58
post-scarcity.cscope_file_list
Normal file
58
post-scarcity.cscope_file_list
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
"/home/simon/workspace/post-scarcity/utils_src/readprintwc/readprintwc.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/vectorspace.c"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/peano.c"
|
||||
"/home/simon/workspace/post-scarcity/src/init.c"
|
||||
"/home/simon/workspace/post-scarcity/src/utils.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/intern.h"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/ratio.h"
|
||||
"/home/simon/workspace/post-scarcity/src/io/io.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/conspage.h"
|
||||
"/home/simon/workspace/post-scarcity/src/time/psse_time.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/cursor.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/dump.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/intern.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/lookup3.c"
|
||||
"/home/simon/workspace/post-scarcity/src/io/fopen.h"
|
||||
"/home/simon/workspace/post-scarcity/src/version.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/meta.h"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/real.c"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/loop.c"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/integer.h"
|
||||
"/home/simon/workspace/post-scarcity/src/time/psse_time.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/vectorspace.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/hashmap.c"
|
||||
"/home/simon/workspace/post-scarcity/src/io/read.c"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/lispops.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/loop.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/stack.h"
|
||||
"/home/simon/workspace/post-scarcity/utils_src/tagvalcalc/tagvalcalc.c"
|
||||
"/home/simon/workspace/post-scarcity/src/debug.c"
|
||||
"/home/simon/workspace/post-scarcity/src/io/read.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/meta.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/dump.c"
|
||||
"/home/simon/workspace/post-scarcity/src/repl.c"
|
||||
"/home/simon/workspace/post-scarcity/src/io/print.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/hashmap.h"
|
||||
"/home/simon/workspace/post-scarcity/src/utils.c"
|
||||
"/home/simon/workspace/post-scarcity/src/io/io.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/stack.c"
|
||||
"/home/simon/workspace/post-scarcity/utils_src/debugflags/debugflags.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/conspage.c"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/cursor.c"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/ratio.c"
|
||||
"/home/simon/workspace/post-scarcity/Makefile"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/peano.h"
|
||||
"/home/simon/workspace/post-scarcity/src/memory/lookup3.h"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/real.h"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/equal.c"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/lispops.c"
|
||||
"/home/simon/workspace/post-scarcity/src/authorise.h"
|
||||
"/home/simon/workspace/post-scarcity/src/io/print.h"
|
||||
"/home/simon/workspace/post-scarcity/src/authorise.c"
|
||||
"/home/simon/workspace/post-scarcity/src/debug.h"
|
||||
"/home/simon/workspace/post-scarcity/src/arith/integer.c"
|
||||
"/home/simon/workspace/post-scarcity/src/ops/equal.h"
|
||||
"/home/simon/workspace/post-scarcity/src/repl.h"
|
||||
"/home/simon/workspace/post-scarcity/src/io/fopen.c"
|
||||
15
post-scarcity.layout
Normal file
15
post-scarcity.layout
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
|
||||
<CodeBlocks_layout_file>
|
||||
<FileVersion major="1" minor="0" />
|
||||
<ActiveTarget name="Debug" />
|
||||
<File name="Makefile" open="1" top="0" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
|
||||
<Cursor>
|
||||
<Cursor1 position="642" topLine="5" />
|
||||
</Cursor>
|
||||
</File>
|
||||
<File name="src/arith/integer.c" open="1" top="1" tabpos="2" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
|
||||
<Cursor>
|
||||
<Cursor1 position="3454" topLine="156" />
|
||||
</Cursor>
|
||||
</File>
|
||||
</CodeBlocks_layout_file>
|
||||
|
|
@ -12,6 +12,7 @@
|
|||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <inttypes.h>
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
|
|
@ -32,31 +33,9 @@ const char *hex_digits = "0123456789ABCDEF";
|
|||
|
||||
/*
|
||||
* Doctrine from here on in is that ALL integers are bignums, it's just
|
||||
* that integers less than 65 bits are bignums of one cell only.
|
||||
* that integers less than 61 bits are bignums of one cell only.
|
||||
*/
|
||||
|
||||
/**
|
||||
* Allocate an integer cell representing this `value` and return a cons_pointer to it.
|
||||
* @param value an integer value;
|
||||
* @param more `NIL`, or a pointer to the more significant cell(s) of this number.
|
||||
* *NOTE* that if `more` is not `NIL`, `value` *must not* exceed `MAX_INTEGER`.
|
||||
*/
|
||||
struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
||||
struct cons_pointer result = NIL;
|
||||
debug_print( L"Entering make_integer\n", DEBUG_ALLOC );
|
||||
|
||||
if ( integerp( more ) || nilp( more ) ) {
|
||||
result = allocate_cell( INTEGERTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
cell->payload.integer.value = value;
|
||||
cell->payload.integer.more = more;
|
||||
}
|
||||
|
||||
debug_print( L"make_integer: returning\n", DEBUG_ALLOC );
|
||||
debug_dump_object( result, DEBUG_ALLOC );
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Low level integer arithmetic, do not use elsewhere.
|
||||
*
|
||||
|
|
@ -71,7 +50,7 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
|||
__int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
|
||||
long int val = nilp( c ) ? 0 : pointer2cell( c ).payload.integer.value;
|
||||
|
||||
long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 );
|
||||
long int carry = is_first_cell ? 0 : ( INT_CELL_BASE );
|
||||
|
||||
__int128_t result = ( __int128_t ) integerp( c ) ?
|
||||
( val == 0 ) ? carry : val : op == '*' ? 1 : 0;
|
||||
|
|
@ -85,11 +64,41 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
|
|||
return result;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* Allocate an integer cell representing this `value` and return a cons_pointer to it.
|
||||
* @param value an integer value;
|
||||
* @param more `NIL`, or a pointer to the more significant cell(s) of this number.
|
||||
* *NOTE* that if `more` is not `NIL`, `value` *must not* exceed `MAX_INTEGER`.
|
||||
*/
|
||||
struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
||||
struct cons_pointer result = NIL;
|
||||
debug_print( L"Entering make_integer\n", DEBUG_ALLOC );
|
||||
|
||||
if ( integerp(more) && (pointer2cell( more ).payload.integer.value < 0))
|
||||
{
|
||||
printf("WARNING: negative value %" PRId64 " passed as `more` to `make_integer`\n",
|
||||
pointer2cell( more ).payload.integer.value);
|
||||
}
|
||||
|
||||
if ( integerp( more ) || nilp( more ) ) {
|
||||
result = allocate_cell( INTEGERTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
cell->payload.integer.value = value;
|
||||
cell->payload.integer.more = more;
|
||||
}
|
||||
|
||||
debug_print( L"make_integer: returning\n", DEBUG_ALLOC );
|
||||
debug_dump_object( result, DEBUG_ALLOC );
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Overwrite the value field of the integer indicated by `new` with
|
||||
* the least significant 60 bits of `val`, and return the more significant
|
||||
* bits (if any) right-shifted by 60 places. Destructive, primitive, do not
|
||||
* use in any context except primitive operations on integers.
|
||||
* the least significant INTEGER_BITS bits of `val`, and return the
|
||||
* more significant bits (if any) right-shifted by INTEGER_BITS places.
|
||||
* Destructive, primitive, do not use in any context except primitive
|
||||
* operations on integers.
|
||||
*
|
||||
* @param val the value to represent;
|
||||
* @param less_significant the less significant words of this bignum, if any,
|
||||
|
|
@ -105,15 +114,15 @@ __int128_t int128_to_integer( __int128_t val,
|
|||
if ( MAX_INTEGER >= val ) {
|
||||
carry = 0;
|
||||
} else {
|
||||
carry = val >> INTEGER_BIT_SHIFT;
|
||||
carry = val % INT_CELL_BASE;
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"int128_to_integer: 64 bit overflow; setting carry to %ld\n",
|
||||
( int64_t ) carry );
|
||||
val &= MAX_INTEGER;
|
||||
val /= INT_CELL_BASE;
|
||||
}
|
||||
|
||||
struct cons_space_object *newc = &pointer2cell( new );
|
||||
newc->payload.integer.value = val;
|
||||
newc->payload.integer.value = (int64_t)val;
|
||||
|
||||
if ( integerp( less_significant ) ) {
|
||||
struct cons_space_object *lsc = &pointer2cell( less_significant );
|
||||
|
|
@ -135,7 +144,7 @@ struct cons_pointer make_integer_128( __int128_t val,
|
|||
less_significant =
|
||||
make_integer( ( long int ) val & MAX_INTEGER,
|
||||
less_significant );
|
||||
val = val >> INTEGER_BIT_SHIFT;
|
||||
val = val * INT_CELL_BASE;
|
||||
}
|
||||
|
||||
} while ( nilp( result ) );
|
||||
|
|
@ -360,7 +369,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
|
|||
while ( accumulator > 0 || !nilp( next ) ) {
|
||||
if ( accumulator < MAX_INTEGER && !nilp( next ) ) {
|
||||
accumulator +=
|
||||
( pointer2cell( next ).payload.integer.value << INTEGER_BIT_SHIFT );
|
||||
( pointer2cell( next ).payload.integer.value % INT_CELL_BASE );
|
||||
next = pointer2cell( next ).payload.integer.more;
|
||||
}
|
||||
int offset = ( int ) ( accumulator % base );
|
||||
|
|
|
|||
|
|
@ -22,7 +22,12 @@
|
|||
* So left shifting and right shifting by 60 bits is correct.
|
||||
*/
|
||||
#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL)
|
||||
#define INT_CELL_BASE ((__int128_t)MAX_INTEGER + 1) // ((__int128_t)0x1000000000000000L)
|
||||
|
||||
/**
|
||||
* @brief Number of value bits in an integer cell
|
||||
*
|
||||
*/
|
||||
#define INTEGER_BIT_SHIFT (60)
|
||||
|
||||
bool zerop( struct cons_pointer arg );
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@ struct cons_pointer read_path( URL_FILE * input, wint_t initial,
|
|||
prefix = c_string_to_lisp_symbol( L"oblist" );
|
||||
break;
|
||||
case '$':
|
||||
case L'§':
|
||||
case LSESSION:
|
||||
prefix = c_string_to_lisp_symbol( L"session" );
|
||||
break;
|
||||
}
|
||||
|
|
@ -255,7 +255,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
}
|
||||
break;
|
||||
case '$':
|
||||
case L'§':
|
||||
case LSESSION:
|
||||
result = read_path( input, c, NIL );
|
||||
break;
|
||||
default:
|
||||
|
|
@ -308,9 +308,9 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
initial );
|
||||
|
||||
for ( c = initial; iswdigit( c )
|
||||
|| c == L'.' || c == L'/' || c == L','; c = url_fgetwc( input ) ) {
|
||||
|| c == LPERIOD || c == LSLASH || c == LCOMMA; c = url_fgetwc( input ) ) {
|
||||
switch ( c ) {
|
||||
case L'.':
|
||||
case LPERIOD:
|
||||
if ( seen_period || !nilp( dividend ) ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: too many periods" ),
|
||||
|
|
@ -321,7 +321,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
seen_period = true;
|
||||
}
|
||||
break;
|
||||
case L'/':
|
||||
case LSLASH:
|
||||
if ( seen_period || !nilp( dividend ) ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: dividend of rational must be integer" ),
|
||||
|
|
@ -334,8 +334,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
result = make_integer( 0, NIL );
|
||||
}
|
||||
break;
|
||||
case L',':
|
||||
// silently ignore commas.
|
||||
case LCOMMA:
|
||||
// silently ignore comma.
|
||||
break;
|
||||
default:
|
||||
result = add_integers( multiply_integers( result, base ),
|
||||
|
|
@ -412,7 +412,7 @@ struct cons_pointer read_list( struct stack_frame *frame,
|
|||
for ( c = url_fgetwc( input );
|
||||
iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) );
|
||||
|
||||
if ( c == L'.' ) {
|
||||
if ( c == LPERIOD ) {
|
||||
/* might be a dotted pair; indeed, if we rule out numbers with
|
||||
* initial periods, it must be a dotted pair. \todo Ought to check,
|
||||
* howerver, that there's only one form after the period. */
|
||||
|
|
@ -443,7 +443,7 @@ struct cons_pointer read_map( struct stack_frame *frame,
|
|||
make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE );
|
||||
wint_t c = initial;
|
||||
|
||||
while ( c != L'}' ) {
|
||||
while ( c != LCBRACE ) {
|
||||
struct cons_pointer key =
|
||||
read_continuation( frame, frame_pointer, env, input, c );
|
||||
|
||||
|
|
@ -456,7 +456,7 @@ struct cons_pointer read_map( struct stack_frame *frame,
|
|||
|
||||
/* skip commaa and whitespace at this point. */
|
||||
for ( c = url_fgetwc( input );
|
||||
c == L',' || iswblank( c ) || iswcntrl( c );
|
||||
c == LCOMMA || iswblank( c ) || iswcntrl( c );
|
||||
c = url_fgetwc( input ) );
|
||||
|
||||
result =
|
||||
|
|
|
|||
|
|
@ -13,6 +13,15 @@
|
|||
|
||||
#include "memory/consspaceobject.h"
|
||||
|
||||
/* characters (other than arabic numberals) used in number representations */
|
||||
#define LCOMMA L','
|
||||
#define LPERIOD L'.'
|
||||
#define LSLASH L'/'
|
||||
/* ... used in map representations */
|
||||
#define LCBRACE L'}'
|
||||
/* ... used in path representations */
|
||||
#define LSESSION L'§'
|
||||
|
||||
/**
|
||||
* read the next object on this input stream and return a cons_pointer to it.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -508,7 +508,7 @@ struct free_payload {
|
|||
struct integer_payload {
|
||||
/** the value of the payload (i.e. 60 bits) of this cell. */
|
||||
int64_t value;
|
||||
/** the next (more significant) cell in the chain, ir `NIL` if there are no
|
||||
/** the next (more significant) cell in the chain, or `NIL` if there are no
|
||||
* more. */
|
||||
struct cons_pointer more;
|
||||
};
|
||||
|
|
|
|||
|
|
@ -155,7 +155,16 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
|
|||
}
|
||||
}
|
||||
if ( frame->args > 1 ) {
|
||||
if ( functionp( frame->arg[1])) {
|
||||
hash_fn = frame->arg[1];
|
||||
} else if ( nilp(frame->arg[1])){
|
||||
/* that's allowed */
|
||||
} else {
|
||||
result =
|
||||
make_exception( c_string_to_lisp_string
|
||||
( L"Second arg to `hashmap`, if passed, must "
|
||||
L"be a function or `nil`.`" ), NIL );
|
||||
}
|
||||
}
|
||||
|
||||
if ( nilp( result ) ) {
|
||||
|
|
@ -189,26 +198,23 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
|
|||
return result;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/**
|
||||
* If this `ptr` is a pointer to a hashmap, return a new identical hashmap;
|
||||
* else return `NIL`. TODO: should return an exception if ptr is not a
|
||||
* readable hashmap.
|
||||
* else return an exception.
|
||||
*/
|
||||
struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( truep( authorised( ptr, NIL ) ) ) {
|
||||
if ( hashmapp( ptr ) ) {
|
||||
struct vector_space_object *from = pointer_to_vso( ptr );
|
||||
struct vector_space_object const *from = pointer_to_vso( ptr );
|
||||
|
||||
if ( from != NULL ) {
|
||||
struct hashmap_payload from_pl = from->payload.hashmap;
|
||||
result =
|
||||
make_hashmap( from_pl.n_buckets, from_pl.hash_fn,
|
||||
from_pl.write_acl );
|
||||
struct vector_space_object *to = pointer_to_vso( result );
|
||||
struct vector_space_object const *to = pointer_to_vso( result );
|
||||
struct hashmap_payload to_pl = to->payload.hashmap;
|
||||
|
||||
for ( int i = 0; i < to_pl.n_buckets; i++ ) {
|
||||
|
|
@ -217,8 +223,12 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
|
|||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
result =
|
||||
make_exception( c_string_to_lisp_string
|
||||
( L"Arg to `clone_hashmap` must "
|
||||
L"be a readable hashmap.`" ), NIL );
|
||||
}
|
||||
// TODO: else exception?
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
62
state-of-play.md
Normal file
62
state-of-play.md
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
# State of Play
|
||||
|
||||
## 20250704
|
||||
|
||||
Right, I'm getting second and subsequent integer cells with negative values, which should not happen. This is probably the cause of (at least some of) the bignum problems. I need to find out why. This is (probably) fixable.
|
||||
|
||||
```lisp
|
||||
:: (inspect 10000000000000000000)
|
||||
|
||||
INTR (1381256777) at page 3, offset 873 count 2
|
||||
Integer cell: value 776627963145224192, count 2
|
||||
BIGNUM! More at:
|
||||
INTR (1381256777) at page 3, offset 872 count 1
|
||||
Integer cell: value -8, count 1
|
||||
```
|
||||
|
||||
Also, `print` is printing bignums wrong on ploughwright, but less wrong on mason, which implies a code difference. Investigate.
|
||||
|
||||
## 20250314
|
||||
|
||||
Thinking further about this, I think at least part of the problem is that I'm storing bignums as cons-space objects, which means that the integer representation I can store has to fit into the size of a cons pointer, which is 64 bits. Which means that to store integers larger than 64 bits I need chains of these objects.
|
||||
|
||||
If I stored bignums in vector space, this problem would go away (especially as I have not implemented vector space yet).
|
||||
|
||||
However, having bignums in vector space would cause a churn of non-standard-sized objects in vector space, which would mean much more frequent garbage collection, which has to be mark-and-sweep because unequal-sized objects, otherwise you get heap fragmentation.
|
||||
|
||||
So maybe I just have to put more work into debugging my cons-space bignums.
|
||||
|
||||
Bother, bother.
|
||||
|
||||
There are no perfect solutions.
|
||||
|
||||
However however, it's only the node that's short on vector space which has to pause to do a mark and sweep. It doesn't interrupt any other node, because their reference to the object will remain the same, even if it is the 'home node' of the object which is sweeping. So all the node has to do is set its busy flag, do GC, and clear its busy flag, The rest of the system can just be carrying on as normal.
|
||||
|
||||
So... maybe mark and sweep isn't the big deal I think it is?
|
||||
|
||||
## 20250313
|
||||
|
||||
OK, the 60 bit integer cell happens in `int128_to_integer` in `arith/integer.c`. It seems to be being done consistently; but there is no obvious reason. `MAX_INTEGER` is defined in `arith/peano.h`. I've changed both to use 63 bits, and this makes no change to the number of unit tests that fail.
|
||||
|
||||
With this change, `(fact 21)`, which was previously printing nothing, now prints a value, `11,891,611,015,076,642,816`. However, this value is definitively wrong, should be `51,090,942,171,709,440,000`. But, I hadn't fixed the shift in `integer_to_string`; have now... still no change in number of failed tests...
|
||||
|
||||
But `(fact 21)` gives a different wrong value, `4,974,081,987,435,560,960`. Factorial values returned by `fact` are correct (agree with SBCL running the same code) up to `(fact 20)`, with both 60 bit integer cells and 63 bit integer cells giving correct values.
|
||||
|
||||
Uhhhmmm... but I'd missed two other places where I'd had the number of significant bits as a numeric literal. Fixed those and now `(fact 21)` does not return a printable answer at all, although the internal representation is definitely wrong. So we may be seeing why I chose 60 bits.
|
||||
|
||||
Bother.
|
||||
|
||||
## 20250312
|
||||
|
||||
Printing of bignums definitely doesn't work; I'm not persuaded that reading of bignums works right either, and there are probably problems with bignum arithmetic too.
|
||||
|
||||
The internal memory representation of a number rolls over from one cell to two cells at 1152921504606846976, and I'm not at all certain why it does because this is neither 2<sup>63</sup> nor 2<sup>64</sup>.
|
||||
|
||||
| | | |
|
||||
| -------------- | -------------------- | ---- |
|
||||
| 2<sup>62</sup> | 4611686018427387904 | |
|
||||
| 2<sup>63</sup> | 9223372036854775808 | |
|
||||
| 2<sup>64</sup> | 18446744073709551616 | |
|
||||
| Mystery number | 1152921504606846976 | |
|
||||
|
||||
In fact, our mystery number turns out (by inspection) to be 2<sup>60</sup>. But **why**?
|
||||
Loading…
Reference in a new issue