From 16f78f40779c48af73603a2d62ea85c63c8c1eb1 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 19 Jul 2021 10:57:22 +0100 Subject: [PATCH 01/90] Print output for lambda and nlambda cells was misleading. --- src/io/print.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/io/print.c b/src/io/print.c index f0db8cd..c68c03e 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -183,8 +183,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_string_contents( output, pointer ); break; case LAMBDATV:{ + url_fputws( L"', output); } break; case NILTV: url_fwprintf( output, L"nil" ); break; case NLAMBDATV:{ + url_fputws( L"', output); } break; case RATIOTV: From d2101dbd473eff0984e540bd76b45cd4484803ff Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 24 Jul 2021 08:54:55 +0100 Subject: [PATCH 02/90] Started to try to get back into this; work on exceptions and loops. --- .vscode/settings.json | 7 ++++ src/memory/conspage.c | 2 +- src/memory/consspaceobject.c | 2 +- src/memory/consspaceobject.h | 25 +++++++++++--- src/memory/stack.c | 3 +- src/ops/exceptions.c | 62 +++++++++++++++++++++++++++++++++++ src/ops/lispops.c | 6 ++-- src/ops/lispops.h | 4 +++ utils_src/tagvalcalc/tvc | Bin 8544 -> 16848 bytes 9 files changed, 101 insertions(+), 10 deletions(-) create mode 100644 .vscode/settings.json create mode 100644 src/ops/exceptions.c diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..14fb483 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,7 @@ +{ + "files.associations": { + "future": "cpp", + "system_error": "cpp", + "functional": "c" + } +} \ No newline at end of file diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 2d0958d..53496d3 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -148,7 +148,7 @@ void free_cell( struct cons_pointer pointer ) { dec_ref( cell->payload.cons.cdr ); break; case EXCEPTIONTV: - dec_ref( cell->payload.exception.message ); + dec_ref( cell->payload.exception.payload ); dec_ref( cell->payload.exception.frame ); break; case FUNCTIONTV: diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 344f4ae..98bb495 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -163,7 +163,7 @@ struct cons_pointer make_exception( struct cons_pointer message, inc_ref( message ); inc_ref( frame_pointer ); - cell->payload.exception.message = message; + cell->payload.exception.payload = message; cell->payload.exception.frame = frame_pointer; result = pointer; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 9197172..4b0500b 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -45,7 +45,8 @@ #define CONSTV 1397641027 /** - * An exception. + * An exception. TODO: we need a means of dealing with different classes of + * exception, and we don't have one yet. */ #define EXCEPTIONTAG "EXEP" @@ -108,6 +109,17 @@ */ #define LAMBDATV 1094995276 +/** + * A loop exit is a special kind of exception which has exactly the same + * payload as an exception. + */ +#define LOOPXTAG "LOOX" + +/** + * The string `LOOX`, considered as an `unsigned int`. + */ +#define LOOPXTV 1481592652 + /** * The special cons cell at address {0,0} whose car and cdr both point to * itself. @@ -286,10 +298,15 @@ #define keywordp(conspoint) (check_tag(conspoint,KEYTAG)) /** - * true if `conspoint` points to a special Lambda cell, else false + * true if `conspoint` points to a Lambda binding cell, else false */ #define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG)) +/** + * true if `conspoint` points to a loop exit exception, else false. + */ +#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTAG)) + /** * true if `conspoint` points to a special form cell, else false */ @@ -414,8 +431,8 @@ struct cons_payload { * Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame. */ struct exception_payload { - /** The message: should be a Lisp string but in practice anything printable will do. */ - struct cons_pointer message; + /** The payload: usually a Lisp string but in practice anything printable will do. */ + struct cons_pointer payload; /** pointer to the (unfreed) stack frame in which the exception was thrown. */ struct cons_pointer frame; }; diff --git a/src/memory/stack.c b/src/memory/stack.c index 3f4a271..d6d3c36 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -267,7 +267,8 @@ void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) { void dump_stack_trace( URL_FILE * output, struct cons_pointer pointer ) { if ( exceptionp( pointer ) ) { - print( output, pointer2cell( pointer ).payload.exception.message ); + // todo: if the payload isn't a message, we maybe shouldn't print it? + print( output, pointer2cell( pointer ).payload.exception.payload ); url_fputws( L"\n", output ); dump_stack_trace( output, pointer2cell( pointer ).payload.exception.frame ); diff --git a/src/ops/exceptions.c b/src/ops/exceptions.c new file mode 100644 index 0000000..48c031f --- /dev/null +++ b/src/ops/exceptions.c @@ -0,0 +1,62 @@ + /* + * exceptions.c + * + * This is really, really unfinished and doesn't yet work. One of the really key + * things about exceptions is that the stack frames between the throw and the + * catch should not be derefed, so eval/apply will need to be substantially + * re-written. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include +#include +#include +#include + +#include "consspaceobject.h" +#include "conspage.h" +#include "debug.h" +#include "dump.h" +#include "equal.h" +#include "integer.h" +#include "intern.h" +#include "io.h" +#include "lispops.h" +#include "map.h" +#include "print.h" +#include "read.h" +#include "stack.h" +#include "vectorspace.h" + + +/** + * OK, the idea here (and I know this is less than perfect) is that the basic `try` + * function in PSSE takes two arguments, the first, `body`, being a list of forms, + * and the second, `catch`, being a catch handler (which is also a list of forms). + * Forms from `body` are evaluated in turn until one returns an exception object, + * or until the list is exhausted. If the list was exhausted, then the value of + * evaluating the last form in `body` is returned. If an exception was encountered, + * then each of the forms in `catch` is evaluated and the value of the last of + * those is returned. + * + * This is experimental. It almost certainly WILL change. + */ +struct cons_pointer lisp_try(struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env) +{ + struct cons_pointer result = c_progn(frame, frame_pointer, frame->arg[0], env); + + if (loopexitp(result)) + { + // TODO: need to put the exception into the environment! + result = c_progn(frame, frame_pointer, frame->arg[1], env); + } + + return result; +} + + diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 4e2ddbf..8dd0109 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -107,7 +107,7 @@ struct cons_pointer eval_forms( struct stack_frame *frame, list = c_cdr( list ); } - return result; + return c_reverse( result); } /** @@ -991,7 +991,7 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, result = eval_form( frame, frame_pointer, c_car( expressions ), env ); dec_ref( r ); - expressions = c_cdr( expressions ); + expressions = exceptionp(result) ? NIL : c_cdr( expressions ); } return result; @@ -1259,7 +1259,7 @@ struct cons_pointer lisp_source( struct stack_frame *frame, case SPECIALTV: result = c_assoc( source_key, cell.payload.special.meta ); break; - case LAMBDATV: + case LAMBDATV: result = make_cons( c_string_to_lisp_symbol( L"lambda" ), make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 122635f..f359252 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -29,6 +29,10 @@ struct cons_pointer c_reverse( struct cons_pointer arg ); +struct cons_pointer +c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer expressions, struct cons_pointer env ); + /** * Useful building block; evaluate this single form in the context of this * parent stack frame and this environment. diff --git a/utils_src/tagvalcalc/tvc b/utils_src/tagvalcalc/tvc index a639364e1d9b231bea94f83e58fdd6378dcccd83..acd850a02231fc7f80d1516dc01c995fcc0d848b 100755 GIT binary patch literal 16848 zcmeHOeQZB$=-#PYs zFOI0H{kL}&``q(8ANSsK@4LP?@7`|*JKCHMhv4KAUlGVncyz>10?#(e0P%}vu^7JV z#DiiU@D&o%<$j%jR8Nd(3PEBjs2ylmi2~xS z^cK~VDa(uHdC?e>SAG|1H!474YP7?uj5SEH7~5{9161B1QMN-C?Z(M&oa~rRQ+Z4| zo){DSG*djS)C)39UimGA)$SnKS!pZjGsQA69k{MVK2Lf3$j;-HZiJO`IZU~{C%}%n zRyVxIH+S=XDsQfS=%)BHrSOXN@mSB6ruFeiLp+wu4mJ!nZ)w=lMq!kFQA0e+&%Zb`dh*u8l@@|vX&GS*FmD-r8DQn~*UW(j=D=S9+zTITdIW%S{=Wyf z*QyLWMtgM`TtNSXu{*YijFwJ@2Zn^IX0%ZFX*JycwAver#l=86mehJhA{39O!XOS0 zhSc6zG8B(J8wD0Uph;R&6QNjA?CNN5*{N>yH5GFkeVc{a-nm)bU|-ofAR;L>0XqVA1ndad5wIg*N8qzX;N$8C z|E&!Fqe>a6{L^|Nl$RznXJJwqK38>CIw)*@0pOWJ{V-5<70J50N^V*?^WhHV%x#zAIImp1tJQ#mSII$D;Yx3H9kh$>F+Rt) zqgZ4g=~9NbzkpdKcU@bgjBGyvOn&Nap^%S2aL!jA1>SKOY)$r4M?i>cq*Wt?d|nd*S(1Klj93VGKNo%^Ww;sV*AUEfE@ul0(J!K2-p#@BVb3s zj({BjI|BbV5y1CP^-aE}%(eyfk^5lxxytnzY|{k3Q}Ij}3WGqqfsO$k0E+v&aiHBm ze{iEvm;~BAQz%RWodnv9dre6A?h}*a+5N&X=y9xCG{5Q;$PmYO`U?1f4Y&}k^X03r zHIQwB|Jg?)&-J#FsV$Ez0}sX8uptlakSrZuY(M*BnXISqQ!5J5a_& z0XqVA1ndad5wIg*N5GDN9f8jh0Y2Zy=lN)RRXjVlh@H@82wu#|l&3?MD~RWFgR6+= zvwACu=ktTOU&6%lTXzd7G9fcD zM(6qP)iI`S`CZya@)^JT2_K+Ch>VX@#kk%Rq{n9ux%>wSXTARv^!7nqB?NCOWqXg4 zKX~&hd5$}5BPHKU@=u88c98r38R2u^R)>w$-+rR|h;|dT>fej!bD_I-?%d{G+trgz zYFY1A-zHyU!-hw*lHG7@W23LJX`K$=%OS{JFiLC71P0H+^7(Y58y8sc`ExT~A)YJi zr?NOM&HD3--E@b-{mE4wltlUObO%*8hUw`NWLh zFUpN)7t9X){G0V*_VODMJ?|1Lg{Lgevs=jqpW6y?qfkQh9L}3g=#*(oJl%wQ>HIX? zeTi_MhZ%nqG7dw1c%EpJ`0O~~VSOxj%;JAY>d%hnD}a})|6J{QRr;wBhp@tyRL;+D zrOxtM{dEp-hnU@8e;|GSJ>ep*$jt2V^D*Es3(V@@tIz_T#z0AF1O7vZ#)(Xw!& zCoD?0FjOs}hVdRo2JT=)Qfgm3)f0-V5iOO@sG;nj2&WPQ@u(J!_?jEHG?rJwyC5+& zlun0+)M!#m4~gD%C=pd7*+c?wlNdM^G&Pf|7V3K@6c586R7_Rd_6K$c)!?316|RAp zwIf1p{o0?2TK5ZeSI6F#K!>`wt?fXtQ|%12bOh0>ysr|@ zWM#ei){EcI*H-R%StS|?X(8}qz9my~&_owzN{Do6y(eQ8qgVY34EQ$RhfyP$l-eIk zM)0mo`(DtB#FA<@6NQ+RnuD>WOFCBHJ(&!-mN#@%6|UcKl<{6p*~>QOi#}$T!j~CJ zXrUgUT3V<5oP*0k(e!}uB~x0|*O$!t2GXg4Xj&UGKt0(QTnURs2nw{cH^4{`QoTQv z=@-7pP!fvJsg~9y&qULiSSo2^RFI{k@emqNZXm7+pNxhNvcA3)u$ak2!@{RU2Z6;Q z3)(5!mA+^{4buJycwyW`c z1aDV)oy_--t@_L}y#cn^Mz-gD)N2g@LSj9gEAfoq0RfI(w&(p8-zVpL<2Zj{Vmt2t zUjT+pWP9G1jnP7|8)U}B_Dtu2vC&@mNxM;}Tn_tSJLVUGF=AXkuOB^RZ`H@LjA;p# zPwGVx+do`H^bFe@DUThas-GNo)5P!q2z~J3`tbaV|8L^D8|}yNhY8YNi*qhlm*U#K Qy!}Vby2eV2frS*+?rA z9~=y-p^H%KV?r*$xs=jFjy<}xkWdUxa!C$4_>cq{8pzQUW97ZwS!=a!dvBQ!X6JkJ z%{7$gf-v9-@d1j3BIWtvGv+1p!q;qVwMZ-c zTST7c=qTlwIWgAS#T_4QZ4(M(Zeour>>;I{x@pt%EX=puiDVF3QgLFW)3n`Uz6r=z zv`dNNc2k%y0YS)jQ1$S!KcHRl?NtpPpG>E+GpPdF!hE*k8&Lg;sr$C=m|wDJ7c%*4 zszaD>N%0*}apIu0a3dgPDSsoApOTsU)oB;EuEzt#$2F%BhdI26cjda)QKTFh9vcos zuzoG;>aTBLU2)HCb4!`e%HnJ;F`bn&cHtlSd>Y;#9PbJb`If+~kEIk8<7iemrL%(KCc-N7atnp97#UfImS! zftvlOJ>!eO%rV+0#Cg*B$ckI`nJL{LQMez(wfwd}YPISxO{n6jhDpFDgn zgT~)w-i$GaJ&#@>jYxAYn9t~J(N5(CJ|DomG6{5o9YG=gcZQeOF@>p@Hm!hGKr5gX z&to^Ea#c!{82wehU#g)bXt`!5gljrNd=u9 z^YH^w=N{BCSHM_ajyPs*{a&NdsF<5p`SmKr5gX&Q``p8DnZWrl4zIr{h(%F|cE=?TwF~*=%&bhNud}fSjk(Eeb~;I90L|cx z+P(_pTSVgAewWOpW$I=sS+Y|&6Q3k)Uv4s!7cqXYXcNo5s=x2BxhvwG81ggCdoK3A zZ4mRD2Wq;moxnASPlhl*-UQ>`&w6L1{9geq9&9sk^1O4-NEUMr>EJ8i=e|QglD`E8 C{uSo{ From 70d176982b04709abd94a1b5e861e8c7b596a95b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 25 Jul 2021 17:02:28 +0100 Subject: [PATCH 03/90] Work on exception handling, especially around ratio arithmetic Much simplified but will break things! --- .gitignore | 2 + lisp/defun.lisp | 5 ++ src/arith/integer.c | 35 ++++++++ src/arith/integer.h | 18 ++-- src/arith/peano.c | 54 ++++++------ src/arith/peano.h | 9 +- src/arith/ratio.c | 145 ++++++++++++++++++--------------- src/arith/ratio.h | 25 ++---- src/io/read.c | 6 +- src/memory/consspaceobject.h | 4 +- src/memory/stack.c | 1 - src/ops/equal.c | 154 ++++++++++++++++++++--------------- src/ops/exceptions.c | 62 -------------- src/ops/lispops.c | 36 ++++++++ 14 files changed, 298 insertions(+), 258 deletions(-) delete mode 100644 src/ops/exceptions.c diff --git a/.gitignore b/.gitignore index 1968658..3bf3906 100644 --- a/.gitignore +++ b/.gitignore @@ -38,3 +38,5 @@ utils_src/readprintwc/out src/io/fopen hi\.* + +.vscode/ diff --git a/lisp/defun.lisp b/lisp/defun.lisp index cec893b..a6d80f5 100644 --- a/lisp/defun.lisp +++ b/lisp/defun.lisp @@ -9,6 +9,11 @@ (set (car form) (apply 'lambda (cdr form)))) (t nil)))) +(set! defun! + (nlambda + form + (eval (list 'set! (car form) (cons 'lambda (cdr form)))))) + (defun! square (x) (* x x)) (set! defsp! diff --git a/src/arith/integer.c b/src/arith/integer.c index 1b2667c..e02d30e 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -390,3 +390,38 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, return result; } + +/** + * true if a and be are both integers whose value is the same value. + */ +bool equal_integer_integer(struct cons_pointer a, struct cons_pointer b) { + bool result = false; + + if (integerp(a) && integerp(b)){ + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); + + result = cell_a->payload.integer.value == cell_b->payload.integer.value; + } + + return result; +} + +/** + * true if `a` is an integer, and `b` is a real number whose value is the + * value of that integer. + */ +bool equal_integer_real(struct cons_pointer a, struct cons_pointer b) { + bool result = false; + + if (integerp(a) && realp(b)) + { + long double bv = pointer2cell(b).payload.real.value; + + if (floor(bv) == bv) { + result = pointer2cell(a).payload.integer.value == (int64_t)bv; + } + } + + return result; +} \ No newline at end of file diff --git a/src/arith/integer.h b/src/arith/integer.h index 117a0bf..f0117f5 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -11,15 +11,19 @@ #ifndef __integer_h #define __integer_h -struct cons_pointer make_integer( int64_t value, struct cons_pointer more ); +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 add_integers(struct cons_pointer a, + struct cons_pointer b); -struct cons_pointer multiply_integers( struct cons_pointer a, - struct cons_pointer b ); +struct cons_pointer multiply_integers(struct cons_pointer a, + struct cons_pointer b); -struct cons_pointer integer_to_string( struct cons_pointer int_pointer, - int base ); +struct cons_pointer integer_to_string(struct cons_pointer int_pointer, + int base); + +bool equal_integer_integer(struct cons_pointer a, struct cons_pointer b); + +bool equal_integer_real(struct cons_pointer a, struct cons_pointer b); #endif diff --git a/src/arith/peano.c b/src/arith/peano.c index 8e4cb43..8fe63fb 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -86,8 +86,7 @@ bool is_negative( struct cons_pointer arg ) { return result; } -struct cons_pointer absolute( struct cons_pointer frame_pointer, - struct cons_pointer arg ) { +struct cons_pointer absolute( struct cons_pointer arg ) { struct cons_pointer result = NIL; struct cons_space_object cell = pointer2cell( arg ); @@ -99,9 +98,7 @@ struct cons_pointer absolute( struct cons_pointer frame_pointer, cell.payload.integer.more ); break; case RATIOTV: - result = make_ratio( frame_pointer, - absolute( frame_pointer, - cell.payload.ratio.dividend ), + result = make_ratio( absolute( cell.payload.ratio.dividend ), cell.payload.ratio.divisor ); break; case REALTV: @@ -210,7 +207,7 @@ int64_t to_long_int( struct cons_pointer arg ) { struct cons_pointer lisp_absolute( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - return absolute( frame_pointer, frame->arg[0] ); + return absolute( frame->arg[0] ); } /** @@ -251,7 +248,7 @@ struct cons_pointer add_2( struct stack_frame *frame, break; case RATIOTV: result = - add_integer_ratio( frame_pointer, arg1, arg2 ); + add_integer_ratio( arg1, arg2 ); break; case REALTV: result = @@ -272,10 +269,10 @@ struct cons_pointer add_2( struct stack_frame *frame, break; case INTEGERTV: result = - add_integer_ratio( frame_pointer, arg2, arg1 ); + add_integer_ratio( arg2, arg1 ); break; case RATIOTV: - result = add_ratio_ratio( frame_pointer, arg1, arg2 ); + result = add_ratio_ratio( arg1, arg2 ); break; case REALTV: result = @@ -384,7 +381,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame, break; case RATIOTV: result = - multiply_integer_ratio( frame_pointer, arg1, + multiply_integer_ratio( arg1, arg2 ); break; case REALTV: @@ -409,12 +406,12 @@ struct cons_pointer multiply_2( struct stack_frame *frame, break; case INTEGERTV: result = - multiply_integer_ratio( frame_pointer, arg2, + multiply_integer_ratio( arg2, arg1 ); break; case RATIOTV: result = - multiply_ratio_ratio( frame_pointer, arg1, arg2 ); + multiply_ratio_ratio( arg1, arg2 ); break; case REALTV: result = @@ -496,8 +493,7 @@ struct cons_pointer lisp_multiply( struct * return a cons_pointer indicating a number which is the * 0 - the number indicated by `arg`. */ -struct cons_pointer negative( struct cons_pointer frame, - struct cons_pointer arg ) { +struct cons_pointer negative( struct cons_pointer arg ) { struct cons_pointer result = NIL; struct cons_space_object cell = pointer2cell( arg ); @@ -514,9 +510,7 @@ struct cons_pointer negative( struct cons_pointer frame, result = TRUE; break; case RATIOTV: - result = make_ratio( frame, - negative( frame, - cell.payload.ratio.dividend ), + result = make_ratio( negative( cell.payload.ratio.dividend ), cell.payload.ratio.divisor ); break; case REALTV: @@ -571,7 +565,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame, break; case INTEGERTV:{ struct cons_pointer i = - negative( frame_pointer, arg2 ); + negative( arg2 ); inc_ref( i ); result = add_integers( arg1, i ); dec_ref( i ); @@ -579,11 +573,11 @@ struct cons_pointer subtract_2( struct stack_frame *frame, break; case RATIOTV:{ struct cons_pointer tmp = - make_ratio( frame_pointer, arg1, + make_ratio( arg1, make_integer( 1, NIL ) ); inc_ref( tmp ); result = - subtract_ratio_ratio( frame_pointer, tmp, arg2 ); + subtract_ratio_ratio( tmp, arg2 ); dec_ref( tmp ); } break; @@ -606,16 +600,16 @@ struct cons_pointer subtract_2( struct stack_frame *frame, break; case INTEGERTV:{ struct cons_pointer tmp = - make_ratio( frame_pointer, arg2, + make_ratio( arg2, make_integer( 1, NIL ) ); inc_ref( tmp ); result = - subtract_ratio_ratio( frame_pointer, arg1, tmp ); + subtract_ratio_ratio( arg1, tmp ); dec_ref( tmp ); } break; case RATIOTV: - result = subtract_ratio_ratio( frame_pointer, arg1, arg2 ); + result = subtract_ratio_ratio( arg1, arg2 ); break; case REALTV: result = @@ -687,11 +681,11 @@ struct cons_pointer lisp_divide( struct break; case INTEGERTV:{ struct cons_pointer unsimplified = - make_ratio( frame_pointer, frame->arg[0], + make_ratio( frame->arg[0], frame->arg[1] ); /* OK, if result may be unsimplified, we should not inc_ref it * - but if not, we should dec_ref it. */ - result = simplify_ratio( frame_pointer, unsimplified ); + result = simplify_ratio( unsimplified ); if ( !eq( unsimplified, result ) ) { dec_ref( unsimplified ); } @@ -700,10 +694,10 @@ struct cons_pointer lisp_divide( struct case RATIOTV:{ struct cons_pointer one = make_integer( 1, NIL ); struct cons_pointer ratio = - make_ratio( frame_pointer, frame->arg[0], one ); + make_ratio( frame->arg[0], one ); inc_ref( ratio ); result = - divide_ratio_ratio( frame_pointer, ratio, + divide_ratio_ratio( ratio, frame->arg[1] ); dec_ref( ratio ); } @@ -729,10 +723,10 @@ struct cons_pointer lisp_divide( struct struct cons_pointer one = make_integer( 1, NIL ); inc_ref( one ); struct cons_pointer ratio = - make_ratio( frame_pointer, frame->arg[1], one ); + make_ratio( frame->arg[1], one ); inc_ref( ratio ); result = - divide_ratio_ratio( frame_pointer, frame->arg[0], + divide_ratio_ratio( frame->arg[0], ratio ); dec_ref( ratio ); dec_ref( one ); @@ -740,7 +734,7 @@ struct cons_pointer lisp_divide( struct break; case RATIOTV: result = - divide_ratio_ratio( frame_pointer, frame->arg[0], + divide_ratio_ratio( frame->arg[0], frame->arg[1] ); break; case REALTV: diff --git a/src/arith/peano.h b/src/arith/peano.h index 7ad7662..89bfc3d 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -19,13 +19,11 @@ bool zerop( struct cons_pointer arg ); -struct cons_pointer negative( struct cons_pointer frame, - struct cons_pointer arg ); +struct cons_pointer negative( struct cons_pointer arg ); bool is_negative( struct cons_pointer arg ); -struct cons_pointer absolute( struct cons_pointer frame_pointer, - struct cons_pointer arg ); +struct cons_pointer absolute( struct cons_pointer arg ); long double to_long_double( struct cons_pointer arg ); @@ -46,8 +44,7 @@ struct cons_pointer lisp_multiply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer negative( struct cons_pointer frame, - struct cons_pointer arg ); +struct cons_pointer negative( struct cons_pointer arg ); struct cons_pointer subtract_2( struct stack_frame *frame, struct cons_pointer frame_pointer, diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 65b09da..8976e38 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -43,52 +43,52 @@ int64_t least_common_multiple( int64_t m, int64_t n ) { return m / greatest_common_divisor( m, n ) * n; } -/** - * return a cons_pointer indicating a number which is of the - * same value as the ratio indicated by `arg`, but which may - * be in a simplified representation. - * @exception If `arg` isn't a ratio, will return an exception. - */ -struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg ) { - struct cons_pointer result = arg; +struct cons_pointer simplify_ratio( struct cons_pointer pointer) { + struct cons_pointer result = pointer; + struct cons_space_object cell = pointer2cell(pointer); + struct cons_space_object dividend = pointer2cell(cell.payload.ratio.dividend); + struct cons_space_object divisor = pointer2cell(cell.payload.ratio.divisor); - if ( ratiop( arg ) ) { - int64_t ddrv = - pointer2cell( pointer2cell( arg ).payload.ratio.dividend ). - payload.integer.value, drrv = - pointer2cell( pointer2cell( arg ).payload.ratio.divisor ). - payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv ); + if (divisor.payload.integer.value == 1) + { + result = pointer2cell(pointer).payload.ratio.dividend; + } + else + { + if (ratiop(pointer)) + { + int64_t ddrv = dividend.payload.integer.value, + drrv = divisor.payload.integer.value, + gcd = greatest_common_divisor(ddrv, drrv); - if ( gcd > 1 ) { - if ( drrv / gcd == 1 ) { - result = make_integer( ddrv / gcd, NIL ); - } else { - result = - make_ratio( frame_pointer, make_integer( ddrv / gcd, NIL ), - make_integer( drrv / gcd, NIL ) ); + if (gcd > 1) + { + if (drrv / gcd == 1) + { + result = make_integer(ddrv / gcd, NIL); + } + else + { + result = + make_ratio(make_integer(ddrv / gcd, NIL), + make_integer(drrv / gcd, NIL)); + } } } - } else { - result = - throw_exception( make_cons( c_string_to_lisp_string - ( L"Shouldn't happen: bad arg to simplify_ratio" ), - arg ), frame_pointer ); } return result; + } - /** * return a cons_pointer indicating a number which is the sum of * the ratios indicated by `arg1` and `arg2`. * @exception will return an exception if either `arg1` or `arg2` is not a * rational number. */ -struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer add_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer r, result; @@ -116,18 +116,17 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, m1, m2 ); if ( dr1v == dr2v ) { - r = make_ratio( frame_pointer, - make_integer( dd1v + dd2v, NIL ), + r = make_ratio( make_integer( dd1v + dd2v, NIL ), cell1.payload.ratio.divisor ); } else { 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 ); + r1 = make_ratio( dd1vm, dr1vm ), + r2 = make_ratio( dd2vm, dr2vm ); - r = add_ratio_ratio( frame_pointer, r1, r2 ); + r = add_ratio_ratio( r1, r2 ); /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were * never incremented except when making r1 and r2, decrementing @@ -136,7 +135,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, dec_ref( r2 ); } - result = simplify_ratio( frame_pointer, r ); + result = simplify_ratio( r ); if ( !eq( r, result ) ) { dec_ref( r ); } @@ -146,7 +145,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, ( L"Shouldn't happen: bad arg to add_ratio_ratio" ), make_cons( arg1, make_cons( arg2, NIL ) ) ), - frame_pointer ); + NIL ); } debug_print( L" => ", DEBUG_ARITH ); @@ -163,16 +162,16 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, * `ratarg`. * @exception if either `intarg` or `ratarg` is not of the expected type. */ -struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, - struct cons_pointer intarg, +struct cons_pointer add_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; if ( integerp( intarg ) && ratiop( ratarg ) ) { + // TODO: not longer works struct cons_pointer one = make_integer( 1, NIL ), - ratio = make_ratio( frame_pointer, intarg, one ); + ratio = make_ratio( intarg, one ); - result = add_ratio_ratio( frame_pointer, ratio, ratarg ); + result = add_ratio_ratio( ratio, ratarg ); dec_ref( one ); dec_ref( ratio ); @@ -183,7 +182,7 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, make_cons( intarg, make_cons( ratarg, NIL ) ) ), - frame_pointer ); + NIL ); } return result; @@ -195,15 +194,14 @@ struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, * @exception will return an exception if either `arg1` or `arg2` is not a * rational number. */ -struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - struct cons_pointer i = make_ratio( frame_pointer, - pointer2cell( arg2 ).payload. + // TODO: this now has to work if `arg1` is an integer + struct cons_pointer i = make_ratio( pointer2cell( arg2 ).payload. ratio.divisor, pointer2cell( arg2 ).payload. ratio.dividend ), result = - multiply_ratio_ratio( frame_pointer, arg1, i ); + multiply_ratio_ratio( arg1, i ); dec_ref( i ); @@ -216,9 +214,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, * @exception will return an exception if either `arg1` or `arg2` is not a * rational number. */ -struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, struct +struct cons_pointer multiply_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { + // TODO: this now has to work if arg1 is an integer struct cons_pointer result; debug_print( L"multiply_ratio_ratio( arg1 = ", DEBUG_ARITH ); @@ -241,9 +240,9 @@ 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, NIL ), + make_ratio( make_integer( ddrv, NIL ), make_integer( drrv, NIL ) ); - result = simplify_ratio( frame_pointer, unsimplified ); + result = simplify_ratio( unsimplified ); if ( !eq( unsimplified, result ) ) { dec_ref( unsimplified ); @@ -252,7 +251,7 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str result = throw_exception( c_string_to_lisp_string ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ), - frame_pointer ); + NIL ); } return result; @@ -264,15 +263,15 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str * `ratarg`. * @exception if either `intarg` or `ratarg` is not of the expected type. */ -struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, - struct cons_pointer intarg, +struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ) { struct cons_pointer result; if ( integerp( intarg ) && ratiop( ratarg ) ) { + // TODO: no longer works; fix struct cons_pointer one = make_integer( 1, NIL ), - ratio = make_ratio( frame_pointer, intarg, one ); - result = multiply_ratio_ratio( frame_pointer, ratio, ratarg ); + ratio = make_ratio( intarg, one ); + result = multiply_ratio_ratio( ratio, ratarg ); dec_ref( one ); dec_ref( ratio ); @@ -280,7 +279,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, result = throw_exception( c_string_to_lisp_string ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ), - frame_pointer ); + NIL ); } return result; @@ -293,11 +292,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, * @exception will return an exception if either `arg1` or `arg2` is not a * rational number. */ -struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - struct cons_pointer i = negative( frame_pointer, arg2 ), - result = add_ratio_ratio( frame_pointer, arg1, i ); + struct cons_pointer i = negative( arg2), + result = add_ratio_ratio( arg1, i ); dec_ref( i ); @@ -311,8 +309,7 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, * `frame_pointer`. * @exception if either `dividend` or `divisor` is not an integer. */ -struct cons_pointer make_ratio( struct cons_pointer frame_pointer, - struct cons_pointer dividend, +struct cons_pointer make_ratio( struct cons_pointer dividend, struct cons_pointer divisor ) { struct cons_pointer result; if ( integerp( dividend ) && integerp( divisor ) ) { @@ -326,10 +323,30 @@ struct cons_pointer make_ratio( struct cons_pointer frame_pointer, result = throw_exception( c_string_to_lisp_string ( L"Dividend and divisor of a ratio must be integers" ), - frame_pointer ); + NIL ); } debug_dump_object( result, DEBUG_ARITH ); - return result; } + +/** + * True if a and be are identical ratios, else false. + */ +bool equal_ratio_ratio(struct cons_pointer a, struct cons_pointer b) +{ + bool result = false; + + if (ratiop(a) && ratiop(b)) + { + struct cons_space_object *cell_a = &pointer2cell(a); + struct cons_space_object *cell_b = &pointer2cell(b); + + result = equal_integer_integer(cell_a->payload.ratio.dividend, + cell_b->payload.ratio.dividend) && + equal_integer_integer(cell_a->payload.ratio.divisor, + cell_b->payload.ratio.divisor); + } + + return result; +} \ No newline at end of file diff --git a/src/arith/ratio.h b/src/arith/ratio.h index 5a3b0d6..d440530 100644 --- a/src/arith/ratio.h +++ b/src/arith/ratio.h @@ -11,36 +11,29 @@ #ifndef __ratio_h #define __ratio_h -struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg ); +struct cons_pointer simplify_ratio( struct cons_pointer arg ); -struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer add_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer add_integer_ratio( struct cons_pointer frame_pointer, - struct cons_pointer intarg, +struct cons_pointer add_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ); -struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, struct - cons_pointer arg1, struct +struct cons_pointer multiply_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer, - struct cons_pointer intarg, +struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, struct cons_pointer ratarg ); -struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer, - struct cons_pointer arg1, +struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ); -struct cons_pointer make_ratio( struct cons_pointer frame_pointer, - struct cons_pointer dividend, +struct cons_pointer make_ratio( struct cons_pointer dividend, struct cons_pointer divisor ); +bool equal_ratio_ratio(struct cons_pointer a, struct cons_pointer b); #endif diff --git a/src/io/read.c b/src/io/read.c index 4f3ed0a..0f32815 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -250,7 +250,7 @@ struct cons_pointer read_number( struct stack_frame *frame, if ( seen_period ) { debug_print( L"read_number: converting result to real\n", DEBUG_IO ); - struct cons_pointer div = make_ratio( frame_pointer, result, + struct cons_pointer div = make_ratio( result, make_integer( powl ( to_long_double ( base ), @@ -263,14 +263,14 @@ struct cons_pointer read_number( struct stack_frame *frame, dec_ref( div ); } else if ( integerp( dividend ) ) { debug_print( L"read_number: converting result to ratio\n", DEBUG_IO ); - result = make_ratio( frame_pointer, dividend, result ); + result = make_ratio( dividend, result ); } if ( neg ) { debug_print( L"read_number: converting result to negative\n", DEBUG_IO ); - result = negative( frame_pointer, result ); + result = negative( result ); } debug_print( L"read_number returning\n", DEBUG_IO ); diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 4b0500b..f82b103 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -346,7 +346,7 @@ * true if `conspoint` points to some sort of a number cell, * else false */ -#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG)) +#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)) /** * true if `conspoint` points to a sequence (list, string or, later, vector), @@ -614,7 +614,7 @@ struct cons_space_object { */ struct cons_payload cons; /** - * if tag == EXCEPTIONTAG + * if tag == EXCEPTIONTAG || tag == LOOPXTAG */ struct exception_payload exception; /** diff --git a/src/memory/stack.c b/src/memory/stack.c index d6d3c36..e26bd0e 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -267,7 +267,6 @@ void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) { void dump_stack_trace( URL_FILE * output, struct cons_pointer pointer ) { if ( exceptionp( pointer ) ) { - // todo: if the payload isn't a message, we maybe shouldn't print it? print( output, pointer2cell( pointer ).payload.exception.payload ); url_fputws( L"\n", output ); dump_stack_trace( output, diff --git a/src/ops/equal.c b/src/ops/equal.c index c4d7f54..6a87de8 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -12,14 +12,17 @@ #include "conspage.h" #include "consspaceobject.h" +#include "integer.h" #include "peano.h" +#include "ratio.h" /** * Shallow, and thus cheap, equality: true if these two objects are * the same object, else false. */ -bool eq( struct cons_pointer a, struct cons_pointer b ) { - return ( ( a.page == b.page ) && ( a.offset == b.offset ) ); +bool eq(struct cons_pointer a, struct cons_pointer b) +{ + return ((a.page == b.page) && (a.offset == b.offset)); } /** @@ -29,12 +32,12 @@ bool eq( struct cons_pointer a, struct cons_pointer b ) { * @return true if the objects at these two cons pointers have the same tag, * else false. */ -bool same_type( struct cons_pointer a, struct cons_pointer b ) { - struct cons_space_object *cell_a = &pointer2cell( a ); - struct cons_space_object *cell_b = &pointer2cell( b ); +bool same_type(struct cons_pointer a, struct cons_pointer b) +{ + struct cons_space_object *cell_a = &pointer2cell(a); + struct cons_space_object *cell_b = &pointer2cell(b); return cell_a->tag.value == cell_b->tag.value; - } /** @@ -42,82 +45,99 @@ bool same_type( struct cons_pointer a, struct cons_pointer b ) { * @param string the string to test * @return true if it's the end of a string. */ -bool end_of_string( struct cons_pointer string ) { - return nilp( string ) || - pointer2cell( string ).payload.string.character == '\0'; +bool end_of_string(struct cons_pointer string) +{ + return nilp(string) || + pointer2cell(string).payload.string.character == '\0'; } /** * Deep, and thus expensive, equality: true if these two objects have * identical structure, else false. */ -bool equal( struct cons_pointer a, struct cons_pointer b ) { - bool result = eq( a, b ); +bool equal(struct cons_pointer a, struct cons_pointer b) +{ + bool result = eq(a, b); - if ( !result && same_type( a, b ) ) { - struct cons_space_object *cell_a = &pointer2cell( a ); - struct cons_space_object *cell_b = &pointer2cell( b ); + if (!result && same_type(a, b)) + { + struct cons_space_object *cell_a = &pointer2cell(a); + struct cons_space_object *cell_b = &pointer2cell(b); - switch ( cell_a->tag.value ) { - case CONSTV: - case LAMBDATV: - case NLAMBDATV: - result = - equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) - && equal( cell_a->payload.cons.cdr, - cell_b->payload.cons.cdr ); - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - /* + switch (cell_a->tag.value) + { + case CONSTV: + case LAMBDATV: + case NLAMBDATV: + result = + equal(cell_a->payload.cons.car, cell_b->payload.cons.car) && equal(cell_a->payload.cons.cdr, + cell_b->payload.cons.cdr); + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + /* * slightly complex because a string may or may not have a '\0' * cell at the end, but I'll ignore that for now. I think in * practice only the empty string will. */ - result = - cell_a->payload.string.character == - cell_b->payload.string.character - && ( equal( cell_a->payload.string.cdr, - cell_b->payload.string.cdr ) - || ( end_of_string( cell_a->payload.string.cdr ) - && end_of_string( cell_b->payload.string. - cdr ) ) ); - break; - case INTEGERTV: - result = - ( cell_a->payload.integer.value == - cell_b->payload.integer.value ) && - equal( cell_a->payload.integer.more, - cell_b->payload.integer.more ); - break; - case REALTV: - { - double num_a = to_long_double( a ); - double num_b = to_long_double( b ); - double max = - fabs( num_a ) > - fabs( num_b ) ? fabs( num_a ) : fabs( num_b ); + result = + cell_a->payload.string.character == + cell_b->payload.string.character && + (equal(cell_a->payload.string.cdr, + cell_b->payload.string.cdr) || + (end_of_string(cell_a->payload.string.cdr) && end_of_string(cell_b->payload.string.cdr))); + break; + case INTEGERTV: + result = + (cell_a->payload.integer.value == + cell_b->payload.integer.value) && + equal(cell_a->payload.integer.more, + cell_b->payload.integer.more); + break; + case RATIOTV: + result = equal_ratio_ratio(a, b); + break; + case REALTV: + { + double num_a = to_long_double(a); + double num_b = to_long_double(b); + double max = + fabs(num_a) > + fabs(num_b) + ? fabs(num_a) + : fabs(num_b); - /* - * not more different than one part in a million - close enough - */ - result = fabs( num_a - num_b ) < ( max / 1000000.0 ); - } - break; - default: - result = false; - break; + /* + * not more different than one part in a million - close enough + */ + result = fabs(num_a - num_b) < (max / 1000000.0); + } + break; + default: + result = false; + break; } - - /* - * there's only supposed ever to be one T and one NIL cell, so each - * should be caught by eq; equality of vector-space objects is a whole - * other ball game so we won't deal with it now (and indeed may never). - * I'm not certain what equality means for read and write streams, so - * I'll ignore them, too, for now. - */ } + else if (numberp(a) && numberp(b)) + { + if (integerp(a)) + { + result = equal_integer_real(a, b); + } + else if (integerp(b)) + { + result = equal_integer_real(b, a); + } + } + + /* + * there's only supposed ever to be one T and one NIL cell, so each + * should be caught by eq; equality of vector-space objects is a whole + * other ball game so we won't deal with it now (and indeed may never). + * I'm not certain what equality means for read and write streams, so + * I'll ignore them, too, for now. + */ return result; } diff --git a/src/ops/exceptions.c b/src/ops/exceptions.c deleted file mode 100644 index 48c031f..0000000 --- a/src/ops/exceptions.c +++ /dev/null @@ -1,62 +0,0 @@ - /* - * exceptions.c - * - * This is really, really unfinished and doesn't yet work. One of the really key - * things about exceptions is that the stack frames between the throw and the - * catch should not be derefed, so eval/apply will need to be substantially - * re-written. - * - * (c) 2021 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#include -#include -#include -#include -#include - -#include "consspaceobject.h" -#include "conspage.h" -#include "debug.h" -#include "dump.h" -#include "equal.h" -#include "integer.h" -#include "intern.h" -#include "io.h" -#include "lispops.h" -#include "map.h" -#include "print.h" -#include "read.h" -#include "stack.h" -#include "vectorspace.h" - - -/** - * OK, the idea here (and I know this is less than perfect) is that the basic `try` - * function in PSSE takes two arguments, the first, `body`, being a list of forms, - * and the second, `catch`, being a catch handler (which is also a list of forms). - * Forms from `body` are evaluated in turn until one returns an exception object, - * or until the list is exhausted. If the list was exhausted, then the value of - * evaluating the last form in `body` is returned. If an exception was encountered, - * then each of the forms in `catch` is evaluated and the value of the last of - * those is returned. - * - * This is experimental. It almost certainly WILL change. - */ -struct cons_pointer lisp_try(struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env) -{ - struct cons_pointer result = c_progn(frame, frame_pointer, frame->arg[0], env); - - if (loopexitp(result)) - { - // TODO: need to put the exception into the environment! - result = c_progn(frame, frame_pointer, frame->arg[1], env); - } - - return result; -} - - diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 8dd0109..c96b1be 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -110,6 +110,37 @@ struct cons_pointer eval_forms( struct stack_frame *frame, return c_reverse( result); } +/** + * OK, the idea here (and I know this is less than perfect) is that the basic `try` + * function in PSSE takes two arguments, the first, `body`, being a list of forms, + * and the second, `catch`, being a catch handler (which is also a list of forms). + * Forms from `body` are evaluated in turn until one returns an exception object, + * or until the list is exhausted. If the list was exhausted, then the value of + * evaluating the last form in `body` is returned. If an exception was encountered, + * then each of the forms in `catch` is evaluated and the value of the last of + * those is returned. + * + * This is experimental. It almost certainly WILL change. + */ +struct cons_pointer lisp_try(struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env) { + struct cons_pointer result = c_progn(frame, frame_pointer, frame->arg[0], env); + + if (exceptionp(result)) + { + // TODO: need to put the exception into the environment! + result = c_progn(frame, frame_pointer, frame->arg[1], + make_cons( + make_cons(c_string_to_lisp_keyword(L"*exception*"), + result), + env)); + } + + return result; +} + + /** * Return the object list (root namespace). * @@ -251,6 +282,11 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, dec_ref( result ); result = eval_form( frame, frame_pointer, sexpr, new_env ); + + if (exceptionp(result)) + { + break; + } } dec_ref( new_env ); From 3f3b596ff0f2e2b35b1328110836717994cb531c Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 3 Aug 2021 15:46:50 +0100 Subject: [PATCH 04/90] Added the beginnings of hashmap but does not yet compile. --- .vscode/settings.json | 7 ----- src/memory/conspage.h | 2 +- src/memory/consspaceobject.c | 42 ++++++++++++++++++++++--- src/memory/consspaceobject.h | 7 +++-- src/memory/hashmap.c | 61 ++++++++++++++++++++++++++++++++++++ src/memory/hashmap.h | 36 +++++++++++++++++++++ src/ops/equal.c | 25 +++++++++------ 7 files changed, 154 insertions(+), 26 deletions(-) delete mode 100644 .vscode/settings.json create mode 100644 src/memory/hashmap.c create mode 100644 src/memory/hashmap.h diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index 14fb483..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,7 +0,0 @@ -{ - "files.associations": { - "future": "cpp", - "system_error": "cpp", - "functional": "c" - } -} \ No newline at end of file diff --git a/src/memory/conspage.h b/src/memory/conspage.h index f13a46b..9eab748 100644 --- a/src/memory/conspage.h +++ b/src/memory/conspage.h @@ -13,7 +13,7 @@ #ifndef __psse_conspage_h #define __psse_conspage_h -#include "consspaceobject.h" +#include "memory/consspaceobject.h" /** * the number of cons cells on a cons page. The maximum value this can diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 98bb495..080158d 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -101,16 +101,16 @@ struct cons_pointer c_car( struct cons_pointer arg ) { struct cons_pointer c_cdr( struct cons_pointer arg ) { struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( arg ); + struct cons_space_object *cell = &pointer2cell( arg ); - switch (cell.tag.value) { + switch (cell->tag.value) { case CONSTV: - result = pointer2cell( arg ).payload.cons.cdr; + result = cell->payload.cons.cdr; break; case KEYTV: case STRINGTV: case SYMBOLTV: - result = pointer2cell( arg ).payload.string.cdr; + result = cell->payload.string.cdr; break; } @@ -226,6 +226,36 @@ struct cons_pointer make_nlambda( struct cons_pointer args, return pointer; } +/** + * Return a hash value for this string. + * + * What's important here is that two strings with the same characters in the + * same order should have the same hash value, even if one was created using + * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function + * has that property. I doubt that it's the most efficient hash function to + * have that property. + */ +uint32_t calculate_hash( wint_t c, struct cons_pointer ptr) { +struct cons_space_object *cell = &pointer2cell(ptr); + uint32_t result = 0; + + switch (cell->tag.value) + { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if (nilp(ptr)) { + result =(uint32_t) c; + } else { + result = ((uint32_t)c * + cell->payload.string.hash) & + 0xffffffff; + } + } + + return result; +} + /** * Construct a string from this character (which later will be UTF) and * this tail. A string is implemented as a flat list of cells each of which @@ -245,8 +275,10 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { cell->payload.string.cdr.page = tail.page; /* \todo There's a problem here. Sometimes the offsets on * strings are quite massively off. Fix is probably - * cell->payload.string.cdr = tsil */ + * cell->payload.string.cdr = tail */ cell->payload.string.cdr.offset = tail.offset; + + cell->payload.string.hash = calculate_hash(c, tail); } else { // \todo should throw an exception! debug_printf( DEBUG_ALLOC, diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index f82b103..7bf34de 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -20,7 +20,8 @@ #include #include -#include "fopen.h" +#include "io/fopen.h" +#include "memory/conspage.h" /** @@ -557,8 +558,8 @@ struct stream_payload { struct string_payload { /** the actual character stored in this cell */ wint_t character; - /** unused padding to word-align the cdr */ - uint32_t padding; + /** a hash of the string value, computed at store time. */ + uint32_t hash; /** the remainder of the string following this character. */ struct cons_pointer cdr; }; diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c new file mode 100644 index 0000000..fcd69e4 --- /dev/null +++ b/src/memory/hashmap.c @@ -0,0 +1,61 @@ +/* + * hashmap.c + * + * Basic implementation of a hashmap. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include "arith/integer.h" +#include "memory/consspaceobject.h" +#include "memory/hashmap.h" + +/** + * Get the hash value for the cell indicated by this `ptr`; currently only + * implemented for string like things. + */ +uint32_t get_hash(struct cons_pointer ptr) +{ + struct cons_space_object *cell = &pointer2cell(ptr); + uint32_t result = 0; + + switch (cell->tag.value) + { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = cell->payload.string.hash; + default: + // TODO: Not Yet Implemented + result = 0; + } + + return result; +} + +/** + * A lisp function signature conforming wrapper around get_hash, q.v.. + */ +struct cons_pointer lisp_get_hash(struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env) +{ + return make_integer(get_hash(frame->arg[0]), NIL); +} + +/** + * Make a hashmap with this number of buckets. + */ +struct cons_pointer make_hashmap( uint32_t n_buckets) { + struct cons_pointer result = make_vso(HASHTAG, + (sizeof(struct cons_pointer) * (n_buckets + 1)) + + (sizeof(uint32_t) * 2)); + + // TODO: fill in the payload! + + struct hashmap_payload *payload = + (struct hashmap_payload *) &pointer_to_vso(result)->payload; + + return result; +} \ No newline at end of file diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h new file mode 100644 index 0000000..b834f5a --- /dev/null +++ b/src/memory/hashmap.h @@ -0,0 +1,36 @@ +/* + * hashmap.h + * + * Basic implementation of a hashmap. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_hashmap_h +#define __psse_hashmap_h + +#include "memory/consspaceobject.h" +#include "memory/vectorspace.h" + +/** + * The payload of a hashmap. The number of buckets is assigned at run-time, + * and is stored in n_buckets. Each bucket is something ASSOC can consume: + * i.e. either an assoc list or a further hashmap. + */ +struct hashmap_payload { + struct cons_pointer hash_fn; + uint32_t n_buckets; + uint32_t unused; /* for word alignment and possible later expansion */ + struct cons_pointer buckets[]; +}; + +uint32_t get_hash(struct cons_pointer ptr); + +struct cons_pointer lisp_get_hash(struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env); + +struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn); + +#endif \ No newline at end of file diff --git a/src/ops/equal.c b/src/ops/equal.c index 6a87de8..feffb93 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -10,11 +10,11 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" -#include "integer.h" -#include "peano.h" -#include "ratio.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" +#include "arith/integer.h" +#include "arith/peano.h" +#include "arith/ratio.h" /** * Shallow, and thus cheap, equality: true if these two objects are @@ -69,6 +69,9 @@ bool equal(struct cons_pointer a, struct cons_pointer b) case CONSTV: case LAMBDATV: case NLAMBDATV: + /* TODO: it is not OK to do this on the stack since list-like + * structures can be of indefinite extent. It *must* be done by + * iteration (and even that is problematic) */ result = equal(cell_a->payload.cons.car, cell_b->payload.cons.car) && equal(cell_a->payload.cons.cdr, cell_b->payload.cons.cdr); @@ -76,11 +79,13 @@ bool equal(struct cons_pointer a, struct cons_pointer b) case KEYTV: case STRINGTV: case SYMBOLTV: - /* - * slightly complex because a string may or may not have a '\0' - * cell at the end, but I'll ignore that for now. I think in - * practice only the empty string will. - */ + /* slightly complex because a string may or may not have a '\0' + * cell at the end, but I'll ignore that for now. I think in + * practice only the empty string will. + */ + /* TODO: it is not OK to do this on the stack since list-like + * structures can be of indefinite extent. It *must* be done by + * iteration (and even that is problematic) */ result = cell_a->payload.string.character == cell_b->payload.string.character && From 492460f37e61b5c86269daa40b25d6f439ef264e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 4 Aug 2021 11:16:00 +0100 Subject: [PATCH 05/90] Compiles and tests, but there are still major problems. --- src/arith/integer.h | 3 ++ src/memory/consspaceobject.c | 67 ++++++++++++++++++++++++++---------- src/memory/consspaceobject.h | 2 +- src/memory/hashmap.c | 24 ++++++++++--- src/memory/hashmap.h | 2 ++ src/memory/vectorspace.h | 6 ++++ 6 files changed, 81 insertions(+), 23 deletions(-) diff --git a/src/arith/integer.h b/src/arith/integer.h index f0117f5..4ce58d5 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -11,6 +11,9 @@ #ifndef __integer_h #define __integer_h +#include +#include + struct cons_pointer make_integer(int64_t value, struct cons_pointer more); struct cons_pointer add_integers(struct cons_pointer a, diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 080158d..c240c4d 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -24,13 +24,30 @@ #include "intern.h" #include "print.h" #include "stack.h" +#include "vectorspace.h" /** - * True if the tag on the cell at this `pointer` is this `tag`, else false. + * True if the tag on the cell at this `pointer` is this `tag`, or, if the tag + * of the cell is `VECP`, if the tag of the vectorspace object indicated by the + * cell is this `tag`, else false. */ bool check_tag( struct cons_pointer pointer, char *tag ) { - struct cons_space_object cell = pointer2cell( pointer ); - return strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; + bool result = false; + struct cons_space_object cell = pointer2cell( pointer ); + + result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; + + if ( !result ) { + // if ( vectorpointp( pointer ) ) { <<< this line blows up! + // // struct vector_space_object *vec = pointer_to_vso( pointer ); + + // // if ( vec != NULL ) { + // // result = strncmp( &vec->header.tag.bytes[0], tag, TAGLENGTH ) == 0; + // // } + // } + } + + return result; } /** @@ -72,14 +89,22 @@ void dec_ref( struct cons_pointer pointer ) { * @return As a Lisp string, the tag of the object which is at that pointer. */ struct cons_pointer c_type( struct cons_pointer pointer ) { - struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( pointer ); + + if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( ( wchar_t ) cell.tag.bytes[i], result ); + result = make_string( (wchar_t)vec->header.tag.bytes[i], result ); } + } else { + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( (wchar_t)cell.tag.bytes[i], result ); + } + } - return result; + return result; } /** @@ -227,16 +252,19 @@ struct cons_pointer make_nlambda( struct cons_pointer args, } /** - * Return a hash value for this string. + * Return a hash value for this string like thing. * * What's important here is that two strings with the same characters in the * same order should have the same hash value, even if one was created using * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function * has that property. I doubt that it's the most efficient hash function to * have that property. - */ -uint32_t calculate_hash( wint_t c, struct cons_pointer ptr) { -struct cons_space_object *cell = &pointer2cell(ptr); + * + * returns 0 for things which are not string like. + */ +uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) +{ + struct cons_space_object *cell = &pointer2cell(ptr); uint32_t result = 0; switch (cell->tag.value) @@ -244,13 +272,16 @@ struct cons_space_object *cell = &pointer2cell(ptr); case KEYTV: case STRINGTV: case SYMBOLTV: - if (nilp(ptr)) { - result =(uint32_t) c; - } else { - result = ((uint32_t)c * - cell->payload.string.hash) & - 0xffffffff; - } + if (nilp(ptr)) + { + result = (uint32_t)c; + } + else + { + result = ((uint32_t)c * + cell->payload.string.hash) & + 0xffffffff; + } } return result; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 7bf34de..486efe2 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -21,7 +21,7 @@ #include #include "io/fopen.h" -#include "memory/conspage.h" +// #include "memory/conspage.h" /** diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index fcd69e4..edabb89 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -10,6 +10,7 @@ #include "arith/integer.h" #include "memory/consspaceobject.h" #include "memory/hashmap.h" +#include "memory/vectorspace.h" /** * Get the hash value for the cell indicated by this `ptr`; currently only @@ -45,17 +46,32 @@ struct cons_pointer lisp_get_hash(struct stack_frame *frame, } /** - * Make a hashmap with this number of buckets. + * Make a hashmap with this number of buckets, using this `hash_fn`. If + * `hash_fn` is `NIL`, use the standard hash funtion. */ -struct cons_pointer make_hashmap( uint32_t n_buckets) { +struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn) { struct cons_pointer result = make_vso(HASHTAG, (sizeof(struct cons_pointer) * (n_buckets + 1)) + (sizeof(uint32_t) * 2)); - // TODO: fill in the payload! - struct hashmap_payload *payload = (struct hashmap_payload *) &pointer_to_vso(result)->payload; + payload->hash_fn = hash_fn; + payload->n_buckets = n_buckets; + for (int i = 0; i < n_buckets; i++) { + payload->buckets[i] = NIL; + } + + return result; +} + +struct cons_pointer clone_hashmap(struct cons_pointer ptr) { + struct cons_pointer result = NIL; + + if (hashmapp(ptr)) { + + } + return result; } \ No newline at end of file diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index b834f5a..813211b 100644 --- a/src/memory/hashmap.h +++ b/src/memory/hashmap.h @@ -10,6 +10,8 @@ #ifndef __psse_hashmap_h #define __psse_hashmap_h +#include "arith/integer.h" +#include "memory/conspage.h" #include "memory/consspaceobject.h" #include "memory/vectorspace.h" diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 22b0d88..15740ac 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -28,18 +28,24 @@ #define HASHTAG "HASH" #define HASHTV 0 +#define hashmapp(conspoint)((check_tag(conspoint,HASHTAG))) + /* * a namespace (i.e. a binding of names to values, implemented as a hashmap) */ #define NAMESPACETAG "NMSP" #define NAMESPACETV 0 +#define namespacep(conspoint)(check_tag(conspoint,NAMESPACETAG)) + /* * a vector of cons pointers. */ #define VECTORTAG "VECT" #define VECTORTV 0 +#define vectorp(conspoint)(check_tag(conspoint,VECTORTAG)) + /** * given a pointer to a vector space object, return the object. */ From 6f54b92d3205146a036ae695f7785108f61b9b15 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 5 Aug 2021 23:35:21 +0100 Subject: [PATCH 06/90] check_tag now works for vectorspace as well as consspace tags All tests except bignum boundary tests still pass. --- src/memory/consspaceobject.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index c240c4d..06bf41c 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -37,14 +37,14 @@ bool check_tag( struct cons_pointer pointer, char *tag ) { result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; - if ( !result ) { - // if ( vectorpointp( pointer ) ) { <<< this line blows up! - // // struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( result == false ) { + if ( strncmp( &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - // // if ( vec != NULL ) { - // // result = strncmp( &vec->header.tag.bytes[0], tag, TAGLENGTH ) == 0; - // // } - // } + if ( vec != NULL ) { + result = strncmp( &vec->header.tag.bytes[0], tag, TAGLENGTH ) == 0; + } + } } return result; From 132f5fb268547056603d40da8c20d73aefe37fc4 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 6 Aug 2021 00:24:19 +0100 Subject: [PATCH 07/90] More work on hashmaps --- src/memory/hashmap.c | 56 +++++++++++++++++++++++++++++--------------- 1 file changed, 37 insertions(+), 19 deletions(-) diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index edabb89..b8110e4 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -49,29 +49,47 @@ struct cons_pointer lisp_get_hash(struct stack_frame *frame, * Make a hashmap with this number of buckets, using this `hash_fn`. If * `hash_fn` is `NIL`, use the standard hash funtion. */ -struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn) { - struct cons_pointer result = make_vso(HASHTAG, - (sizeof(struct cons_pointer) * (n_buckets + 1)) + - (sizeof(uint32_t) * 2)); +struct cons_pointer make_hashmap( uint32_t n_buckets, + struct cons_pointer hash_fn ) { + struct cons_pointer result = + make_vso( HASHTAG, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + + ( sizeof( uint32_t ) * 2 ) ); - struct hashmap_payload *payload = - (struct hashmap_payload *) &pointer_to_vso(result)->payload; + struct hashmap_payload *payload = + (struct hashmap_payload *)&pointer_to_vso( result )->payload; - payload->hash_fn = hash_fn; - payload->n_buckets = n_buckets; - for (int i = 0; i < n_buckets; i++) { - payload->buckets[i] = NIL; + payload->hash_fn = hash_fn; + payload->n_buckets = n_buckets; + for ( int i = 0; i < n_buckets; i++ ) { + payload->buckets[i] = NIL; + } + + return result; +} + +/** + * If this `ptr` is a pointer to a hashmap, return a new identical hashmap; + * else return `NIL`. TODO: should return an exception. + */ +struct cons_pointer clone_hashmap(struct cons_pointer ptr) { + struct cons_pointer result = NIL; + + if (hashmapp(ptr)) { + struct vector_space_object *from = pointer_to_vso( ptr ); + + if ( from != NULL ) { + struct hashmap_payload *from_pl = (struct hashmap_payload*)from->payload; + result = make_hashmap( from_pl->n_buckets, from_pl->hash_fn); + struct vector_space_object *to = pointer_to_vso(result); + struct hashmap_payload *to_pl = (struct hashmap_payload*)to->payload; + + for (int i = 0; i < to_pl->n_buckets; i++) { + to_pl->buckets[i] = from_pl->buckets[i]; + inc_ref(to_pl->buckets[i]); + } + } } return result; } -struct cons_pointer clone_hashmap(struct cons_pointer ptr) { - struct cons_pointer result = NIL; - - if (hashmapp(ptr)) { - - } - - return result; -} \ No newline at end of file From bfd7304da129dd6ce69a3885800595ff67ae6899 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 16 Aug 2021 15:12:05 +0100 Subject: [PATCH 08/90] Bother. It looks like I'd already fully implemented hashmaps... May need to back out a whole hill of work. --- src/arith/peano.h | 2 + src/authorise.c | 24 ++++ src/authorise.h | 15 +++ src/memory/conspage.c | 20 +-- src/memory/consspaceobject.c | 48 ++++--- src/memory/consspaceobject.h | 4 +- src/memory/hashmap.c | 255 +++++++++++++++++++++++++++++++---- src/memory/hashmap.h | 32 ++--- src/memory/vectorspace.c | 26 ++++ src/memory/vectorspace.h | 30 ++++- src/ops/intern.c | 5 +- 11 files changed, 378 insertions(+), 83 deletions(-) create mode 100644 src/authorise.c create mode 100644 src/authorise.h diff --git a/src/arith/peano.h b/src/arith/peano.h index 89bfc3d..9bcd9e4 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -27,6 +27,8 @@ struct cons_pointer absolute( struct cons_pointer arg ); long double to_long_double( struct cons_pointer arg ); +int64_t to_long_int( struct cons_pointer arg ) ; + struct cons_pointer lisp_absolute( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); diff --git a/src/authorise.c b/src/authorise.c new file mode 100644 index 0000000..5574db9 --- /dev/null +++ b/src/authorise.c @@ -0,0 +1,24 @@ +/* + * authorised.c + * + * For now, a dummy authorising everything. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include "memory/conspage.h" +#include "memory/consspaceobject.h" + + +/** + * TODO: does nothing, yet. What it should do is access a magic value in the + * runtime environment and check that it is identical to something on this `acl` + */ +struct cons_pointer authorised(struct cons_pointer target, struct cons_pointer acl) { + if (nilp(acl)) { + acl = pointer2cell(target).access; + } + return TRUE; +} + diff --git a/src/authorise.h b/src/authorise.h new file mode 100644 index 0000000..c67977d --- /dev/null +++ b/src/authorise.h @@ -0,0 +1,15 @@ +/* + * authorise.h + * + * Basic implementation of a authorisation. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_authorise_h +#define __psse_authorise_h + +struct cons_pointer authorised(struct cons_pointer target, struct cons_pointer acl); + +#endif \ No newline at end of file diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 53496d3..c9c224d 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -179,26 +179,8 @@ void free_cell( struct cons_pointer pointer ) { dec_ref( cell->payload.string.cdr ); break; case VECTORPOINTTV: - /* for vector space pointers, free the actual vector-space - * object. Dangerous! */ - debug_printf( DEBUG_ALLOC, - L"About to free vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); - struct vector_space_object *vso = - cell->payload.vectorp.address; - - switch ( vso->header.tag.value ) { - case STACKFRAMETV: - free_stack_frame( get_stack_frame( pointer ) ); - break; - } - - free( ( void * ) cell->payload.vectorp.address ); - debug_printf( DEBUG_ALLOC, - L"Freed vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); + free_vso( pointer); break; - } strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH ); diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 06bf41c..ee82956 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -18,6 +18,7 @@ #include #include +#include "authorise.h" #include "conspage.h" #include "consspaceobject.h" #include "debug.h" @@ -38,7 +39,7 @@ bool check_tag( struct cons_pointer pointer, char *tag ) { result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; if ( result == false ) { - if ( strncmp( &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + if ( strncmp( &cell.tag.bytes[0], VECTORPOINTTAG, TAGLENGTH ) == 0 ) { struct vector_space_object *vec = pointer_to_vso( pointer ); if ( vec != NULL ) { @@ -55,13 +56,17 @@ bool check_tag( struct cons_pointer pointer, char *tag ) { * * You can't roll over the reference count. Once it hits the maximum * value you cannot increment further. + * + * Returns the `pointer`. */ -void inc_ref( struct cons_pointer pointer ) { +struct cons_pointer inc_ref( struct cons_pointer pointer ) { struct cons_space_object *cell = &pointer2cell( pointer ); if ( cell->count < MAXREFERENCE ) { cell->count++; } + + return pointer; } /** @@ -69,8 +74,10 @@ void inc_ref( struct cons_pointer pointer ) { * * If a count has reached MAXREFERENCE it cannot be decremented. * If a count is decremented to zero the cell should be freed. + * + * Returns the `pointer`, or, if the cell has been freed, NIL. */ -void dec_ref( struct cons_pointer pointer ) { +struct cons_pointer dec_ref( struct cons_pointer pointer ) { struct cons_space_object *cell = &pointer2cell( pointer ); if ( cell->count > 0 ) { @@ -78,8 +85,11 @@ void dec_ref( struct cons_pointer pointer ) { if ( cell->count == 0 ) { free_cell( pointer ); + pointer = NIL; } } + + return pointer; } @@ -108,38 +118,42 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { } /** - * Implementation of car in C. If arg is not a cons, does not error but returns nil. + * Implementation of car in C. If arg is not a cons, or the current user is not + * authorised to read it, does not error but returns nil. */ struct cons_pointer c_car( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( consp( arg ) ) { - result = pointer2cell( arg ).payload.cons.car; - } + if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.car; + } - return result; + return result; } /** - * Implementation of cdr in C. If arg is not a sequence, does not error but returns nil. + * Implementation of cdr in C. If arg is not a sequence, or the current user is + * not authorised to read it,does not error but returns nil. */ struct cons_pointer c_cdr( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; + if ( truep( authorised( arg, NIL ) ) ) { struct cons_space_object *cell = &pointer2cell( arg ); - switch (cell->tag.value) { - case CONSTV: + switch ( cell->tag.value ) { + case CONSTV: result = cell->payload.cons.cdr; break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: + case KEYTV: + case STRINGTV: + case SYMBOLTV: result = cell->payload.string.cdr; break; } + } - return result; + return result; } /** diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 486efe2..98a5a24 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -675,9 +675,9 @@ struct cons_space_object { bool check_tag( struct cons_pointer pointer, char *tag ); -void inc_ref( struct cons_pointer pointer ); +struct cons_pointer inc_ref( struct cons_pointer pointer ); -void dec_ref( struct cons_pointer pointer ); +struct cons_pointer dec_ref( struct cons_pointer pointer ); struct cons_pointer c_type( struct cons_pointer pointer ); diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index b8110e4..9be7d64 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -8,33 +8,89 @@ */ #include "arith/integer.h" +#include "arith/peano.h" +#include "authorise.h" +#include "debug.h" #include "memory/consspaceobject.h" #include "memory/hashmap.h" #include "memory/vectorspace.h" +/** + * Return a hash value for the structure indicated by `ptr` such that if + * `x`,`y` are two separate structures whose print representation is the same + * then `(sxhash x)` and `(sxhash y)` will always be equal. + */ +uint32_t sxhash( struct cons_pointer ptr ) { + // TODO: Not Yet Implemented + /* TODO: should look at the implementation of Common Lisp sxhash? + * My current implementation of `print` only addresses URL_FILE + * streams. It would be better if it also addressed strings but + * currently it doesn't. Creating a print string of the structure + * and taking the hash of that would be one simple (but not necessarily + * cheap) solution. + */ + /* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp + * and is EXTREMELY complex, and essentially has a different dispatch for + * every type of object. It's likely we need to do the same. + */ + return 0; +} + /** * Get the hash value for the cell indicated by this `ptr`; currently only - * implemented for string like things. + * implemented for string like things and integers. */ uint32_t get_hash(struct cons_pointer ptr) { struct cons_space_object *cell = &pointer2cell(ptr); uint32_t result = 0; - switch (cell->tag.value) - { - case KEYTV: - case STRINGTV: - case SYMBOLTV: + switch ( cell->tag.value ) { + case INTEGERTV: + /* Note that we're only hashing on the least significant word of an + * integer. */ + result = cell->payload.integer.value & 0xffffffff; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: result = cell->payload.string.hash; - default: - // TODO: Not Yet Implemented - result = 0; + break; + case TRUETV: + result = 1; // arbitrarily + break; + default: + result = sxhash( ptr ); + break; } return result; } +/** + * Free the hashmap indicated by this `pointer`. + */ +void free_hashmap( struct cons_pointer pointer ) { + struct cons_space_object *cell = &pointer2cell( pointer ); + + if ( hashmapp( pointer ) ) { + struct vector_space_object *vso = cell->payload.vectorp.address; + struct hashmap_payload payload = vso->payload.hashmap; + + dec_ref( payload.hash_fn ); + dec_ref( payload.write_acl ); + + for ( int i = 0; i < payload.n_buckets; i++ ) { + debug_printf( DEBUG_ALLOC, + L"Decrementing buckets[%d] of hashmap at 0x%lx\n", i, + cell->payload.vectorp.address ); + dec_ref( payload.buckets[i] ); + } + } else { + debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" ); + } +} + /** * A lisp function signature conforming wrapper around get_hash, q.v.. */ @@ -50,7 +106,8 @@ struct cons_pointer lisp_get_hash(struct stack_frame *frame, * `hash_fn` is `NIL`, use the standard hash funtion. */ struct cons_pointer make_hashmap( uint32_t n_buckets, - struct cons_pointer hash_fn ) { + struct cons_pointer hash_fn, + struct cons_pointer write_acl ) { struct cons_pointer result = make_vso( HASHTAG, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + ( sizeof( uint32_t ) * 2 ) ); @@ -58,7 +115,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct hashmap_payload *payload = (struct hashmap_payload *)&pointer_to_vso( result )->payload; - payload->hash_fn = hash_fn; + payload->hash_fn = inc_ref(hash_fn); + payload->write_acl = inc_ref(write_acl); + payload->n_buckets = n_buckets; for ( int i = 0; i < n_buckets; i++ ) { payload->buckets[i] = NIL; @@ -68,28 +127,170 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, } /** - * If this `ptr` is a pointer to a hashmap, return a new identical hashmap; - * else return `NIL`. TODO: should return an exception. + * Lisp funtion of up to four args (all optional), where + * + * first is expected to be an integer, the number of buckets, or nil; + * second is expected to be a hashing function, or nil; + * third is expected to be an assocable, or nil; + * fourth is a list of user tokens, to be used as a write ACL, or nil. */ -struct cons_pointer clone_hashmap(struct cons_pointer ptr) { - struct cons_pointer result = NIL; +struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + uint32_t n = 32; + struct cons_pointer hash_fn = NIL; + struct cons_pointer result = NIL; - if (hashmapp(ptr)) { - struct vector_space_object *from = pointer_to_vso( ptr ); + if ( frame->args > 0 ) { + if ( integerp( frame->arg[0] ) ) { + n = to_long_int( frame->arg[0] ) % UINT32_MAX; + } else if ( !nilp( frame->arg[0] ) ) { + result = make_exception( + c_string_to_lisp_string( L"First arg to `hashmap`, if passed, must " + L"be an integer or `nil`.`" ), + NIL ); + } + } + if ( frame->args > 1 ) { + hash_fn = frame->arg[1]; + } - if ( from != NULL ) { - struct hashmap_payload *from_pl = (struct hashmap_payload*)from->payload; - result = make_hashmap( from_pl->n_buckets, from_pl->hash_fn); - struct vector_space_object *to = pointer_to_vso(result); - struct hashmap_payload *to_pl = (struct hashmap_payload*)to->payload; + if ( nilp( result ) ) { + /* if there are fewer than 4 args, then arg[3] ought to be nil anyway, which + * is fine */ + result = make_hashmap( n, hash_fn, frame->arg[3] ); + struct vector_space_object *map = pointer_to_vso( result ); - for (int i = 0; i < to_pl->n_buckets; i++) { - to_pl->buckets[i] = from_pl->buckets[i]; - inc_ref(to_pl->buckets[i]); - } + if ( frame->args > 2 && + truep( authorised( result, map->payload.hashmap.write_acl ) ) ) { + // then arg[2] ought to be an assoc list which we should iterate down + // populating the hashmap. + for ( struct cons_pointer cursor = frame->arg[2]; !nilp( cursor ); + cursor = c_cdr( cursor ) ) { + struct cons_pointer pair = c_car( cursor ); + struct cons_pointer key = c_car( pair ); + struct cons_pointer val = c_cdr( pair ); + + uint32_t bucket_no = + get_hash( key ) % + ( (struct hashmap_payload *)&( map->payload ) )->n_buckets; + + map->payload.hashmap.buckets[bucket_no] = + inc_ref( make_cons( make_cons( key, val ), + map->payload.hashmap.buckets[bucket_no] )); } } + } - return result; + 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. + */ +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 ); + + 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 hashmap_payload to_pl = to->payload.hashmap; + + for ( int i = 0; i < to_pl.n_buckets; i++ ) { + to_pl.buckets[i] = from_pl.buckets[i]; + inc_ref( to_pl.buckets[i] ); + } + } + } + } + // TODO: else exception? + + return result; +} + +/** + * Store this `val` as the value of this `key` in this hashmap `mapp`. If + * current user is authorised to write to this hashmap, modifies the hashmap and + * returns it; if not, clones the hashmap, modifies the clone, and returns that. + */ +struct cons_pointer hashmap_put( struct cons_pointer mapp, + struct cons_pointer key, + struct cons_pointer val ) { + // TODO: if current user has write access to this hashmap + if ( hashmapp( mapp ) && !nilp( key ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); + + if (nilp(authorised(mapp, map->payload.hashmap.write_acl))) { + mapp = clone_hashmap( mapp); + map = pointer_to_vso( mapp ); + } + uint32_t bucket_no = + get_hash( key ) % + map->payload.hashmap.n_buckets; + + map->payload.hashmap.buckets[bucket_no] = + inc_ref( make_cons( make_cons( key, val ), + map->payload.hashmap.buckets[bucket_no] )); + } + + return mapp; +} + +/** + * Expects `frame->arg[1]` to be a hashmap or namespace; `frame->arg[2]` to be + * a string-like-thing (perhaps necessarily a keyword); frame->arg[3] to be + * any value. If + * current user is authorised to write to this hashmap, modifies the hashmap and + * returns it; if not, clones the hashmap, modifies the clone, and returns that. + */ +struct cons_pointer lisp_hashmap_put( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer mapp = frame->arg[0]; + struct cons_pointer key = frame->arg[1]; + struct cons_pointer val = frame->arg[2]; + + return hashmap_put(mapp, key, val); +} + +/** + * Copy all key/value pairs in this association list `assoc` into this hashmap `mapp`. If + * current user is authorised to write to this hashmap, modifies the hashmap and + * returns it; if not, clones the hashmap, modifies the clone, and returns that. + */ +struct cons_pointer hashmap_put_all( struct cons_pointer mapp, + struct cons_pointer assoc ) { + // TODO: if current user has write access to this hashmap + if ( hashmapp( mapp ) && !nilp( assoc ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); + + if ( hashmapp( mapp ) && consp( assoc ) ) { + for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair ); + pair = c_car( assoc ) ) { + /* TODO: this is really hammering the memory management system, because + * it will make a new lone for every key/value pair added. Fix. */ + mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) ); + } + } + } + + return mapp; +} + +/** + * Lisp function expecting two arguments, a hashmap and an assoc list. Copies all + * key/value pairs from the assoc list into the map. + */ +struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return hashmap_put_all( frame->arg[0], frame->arg[1] ); } diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index 813211b..579b56d 100644 --- a/src/memory/hashmap.h +++ b/src/memory/hashmap.h @@ -15,24 +15,24 @@ #include "memory/consspaceobject.h" #include "memory/vectorspace.h" -/** - * The payload of a hashmap. The number of buckets is assigned at run-time, - * and is stored in n_buckets. Each bucket is something ASSOC can consume: - * i.e. either an assoc list or a further hashmap. - */ -struct hashmap_payload { - struct cons_pointer hash_fn; - uint32_t n_buckets; - uint32_t unused; /* for word alignment and possible later expansion */ - struct cons_pointer buckets[]; -}; +uint32_t get_hash( struct cons_pointer ptr ); -uint32_t get_hash(struct cons_pointer ptr); +void free_hashmap( struct cons_pointer ptr ); -struct cons_pointer lisp_get_hash(struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env); +struct cons_pointer lisp_get_hash( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); -struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn); +struct cons_pointer lisp_hashmap_put( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); + +struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); + +struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif \ No newline at end of file diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 480effb..b3e64c6 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -22,6 +22,8 @@ #include "conspage.h" #include "consspaceobject.h" #include "debug.h" +#include "hashmap.h" +#include "stack.h" #include "vectorspace.h" @@ -112,3 +114,27 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { return result; } + +/** for vector space pointers, free the actual vector-space + * object. Dangerous! */ + +void free_vso( struct cons_pointer pointer ) { + struct cons_space_object * cell = &pointer2cell( pointer); + + debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n", + cell->payload.vectorp.address ); + struct vector_space_object *vso = cell->payload.vectorp.address; + + switch ( vso->header.tag.value ) { + case HASHTV: + free_hashmap( pointer ); + break; + case STACKFRAMETV: + free_stack_frame( get_stack_frame( pointer ) ); + break; + } + + free( (void *)cell->payload.vectorp.address ); + debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n", + cell->payload.vectorp.address ); +} \ No newline at end of file diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 15740ac..ed050bc 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -18,6 +18,7 @@ #include #include "consspaceobject.h" +#include "hashmap.h" #ifndef __vectorspace_h #define __vectorspace_h @@ -58,6 +59,8 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ); +void free_vso(struct cons_pointer pointer); + /** * the header which forms the start of every vector space object. */ @@ -75,6 +78,27 @@ struct vector_space_header { uint64_t size; }; +/** + * The payload of a hashmap. The number of buckets is assigned at run-time, + * and is stored in n_buckets. Each bucket is something ASSOC can consume: + * i.e. either an assoc list or a further hashmap. + */ +struct hashmap_payload { + struct cons_pointer + hash_fn; /* function for hashing values in this hashmap, or `NIL` to use + the default hashing function */ + struct cons_pointer write_acl; /* it seems to me that it is likely that the + * principal difference between a hashmap and a + * namespace is that a hashmap has a write ACL + * of `NIL`, meaning not writeable by anyone */ + uint32_t n_buckets; /* number of hash buckets */ + uint32_t unused; /* for word alignment and possible later expansion */ + struct cons_pointer + buckets[]; /* actual hash buckets, which should be `NIL` + * or assoc lists or (possibly) further hashmaps. */ +}; + + /** a vector_space_object is just a vector_space_header followed by a * lump of bytes; what we deem to be in there is a function of the tag, * and at this stage we don't have a good picture of what these may be. @@ -87,7 +111,11 @@ struct vector_space_object { struct vector_space_header header; /** we'll malloc `size` bytes for payload, `payload` is just the first of these. * \todo this is almost certainly not idiomatic C. */ - char payload; + union { + /** the payload considered as bytes */ + char bytes; + struct hashmap_payload hashmap; + } payload; }; #endif diff --git a/src/ops/intern.c b/src/ops/intern.c index cf86e6b..802bc82 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -23,6 +23,7 @@ #include "consspaceobject.h" #include "debug.h" #include "equal.h" +#include "hashmap.h" #include "lispops.h" #include "map.h" #include "print.h" @@ -107,8 +108,10 @@ struct cons_pointer c_assoc( struct cons_pointer key, break; } } - } else if (vectorpointp( store)) { + } else if (hashmapp( store)) { result = assoc_in_map( key, store); + } else { + result = throw_exception(c_string_to_lisp_string(L"Store is of unknown type"), NIL); } debug_print( L"c_assoc returning ", DEBUG_BIND); From 4fc9545be8610b94b4bc55e19cbcce696f576446 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 16 Aug 2021 18:55:02 +0100 Subject: [PATCH 09/90] Hashmaps sort-of work but there are still bugs and one test is failing that wasn't. --- src/init.c | 8 +- src/io/print.c | 46 +++---- src/io/read.c | 48 +++---- src/memory/dump.c | 8 +- src/memory/hashmap.c | 70 +++++++++- src/memory/hashmap.h | 17 +++ src/memory/map.c | 289 --------------------------------------- src/memory/map.h | 96 ------------- src/memory/vectorspace.h | 8 +- src/ops/intern.c | 8 +- src/ops/lispops.c | 23 +++- src/ops/lispops.h | 72 +++++----- 12 files changed, 206 insertions(+), 487 deletions(-) delete mode 100644 src/memory/map.c delete mode 100644 src/memory/map.h diff --git a/src/init.c b/src/init.c index dbfdd5d..7b1649c 100644 --- a/src/init.c +++ b/src/init.c @@ -23,10 +23,10 @@ #include "conspage.h" #include "consspaceobject.h" #include "debug.h" +#include "hashmap.h" #include "intern.h" #include "io.h" #include "lispops.h" -#include "map.h" #include "meta.h" #include "peano.h" #include "print.h" @@ -225,8 +225,10 @@ int main( int argc, char *argv[] ) { bind_function( L"equal", &lisp_equal ); bind_function( L"eval", &lisp_eval ); bind_function( L"exception", &lisp_exception ); + bind_function( L"gethash", &lisp_get_hash); + bind_function(L"hashmap", lisp_make_hashmap); bind_function( L"inspect", &lisp_inspect ); - bind_function( L"make-map", &lisp_make_map); + bind_function( L"keys", &lisp_keys); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); bind_function( L"multiply", &lisp_multiply ); @@ -235,6 +237,8 @@ int main( int argc, char *argv[] ) { bind_function( L"open", &lisp_open ); bind_function( L"print", &lisp_print ); bind_function( L"progn", &lisp_progn ); + bind_function( L"put", lisp_hashmap_put); + bind_function( L"put-all", &lisp_hashmap_put_all); bind_function( L"read", &lisp_read ); bind_function( L"read-char", &lisp_read_char ); bind_function( L"repl", &lisp_repl ); diff --git a/src/io/print.c b/src/io/print.c index c68c03e..3f33252 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -19,9 +19,9 @@ #include "conspage.h" #include "consspaceobject.h" +#include "hashmap.h" #include "integer.h" #include "intern.h" -#include "map.h" #include "stack.h" #include "print.h" #include "psse_time.h" @@ -88,40 +88,38 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) { url_fputws( L")", output ); } +void print_map( URL_FILE *output, struct cons_pointer map ) { + if ( hashmapp( map ) ) { + struct vector_space_object *vso = pointer_to_vso( map ); -void print_map( URL_FILE * output, struct cons_pointer map) { - if ( vectorpointp( map)) { - struct vector_space_object *vso = pointer_to_vso( map); + url_fputwc( btowc( '{' ), output ); - if ( mapp( vso ) ) { - url_fputwc( btowc( '{' ), output ); + for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); + ks = c_cdr( ks ) ) { + struct cons_pointer key = c_car( ks); + print( output, key ); + url_fputwc( btowc( ' ' ), output ); + print( output, hashmap_get( map, key ) ); - for ( struct cons_pointer ks = keys( map); - !nilp( ks); ks = c_cdr( ks)) { - print( output, c_car( ks)); - url_fputwc( btowc( ' ' ), output ); - print( output, c_assoc( c_car( ks), map)); - - if ( !nilp( c_cdr( ks))) { - url_fputws( L", ", output ); - } - } - - url_fputwc( btowc( '}' ), output ); - } + if ( !nilp( c_cdr( ks ) ) ) { + url_fputws( L", ", output ); + } } + + url_fputwc( btowc( '}' ), output ); + } } - void print_vso( URL_FILE * output, struct cons_pointer pointer) { - struct vector_space_object *vso = - pointer2cell( pointer ).payload.vectorp.address; - + struct vector_space_object *vso = pointer_to_vso(pointer); switch ( vso->header.tag.value) { - case MAPTV: + case HASHTV: print_map( output, pointer); break; // \todo: others. + default: + fwprintf( stderr, L"Unrecognised vector-space type '%d'\n", + vso->header.tag.value ); } } diff --git a/src/io/read.c b/src/io/read.c index 0f32815..ede44ad 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -20,11 +20,11 @@ #include "consspaceobject.h" #include "debug.h" #include "dump.h" +#include "hashmap.h" #include "integer.h" #include "intern.h" #include "io.h" #include "lispops.h" -#include "map.h" #include "peano.h" #include "print.h" #include "ratio.h" @@ -323,37 +323,39 @@ struct cons_pointer read_list( struct stack_frame *frame, return result; } - struct cons_pointer read_map( struct stack_frame *frame, - struct cons_pointer frame_pointer, - URL_FILE * input, wint_t initial ) { - struct cons_pointer result = make_empty_map( NIL); - wint_t c = initial; + struct cons_pointer frame_pointer, + URL_FILE *input, wint_t initial ) { + // set write ACL to true whilst creating to prevent GC churn + struct cons_pointer result = make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE ); + wint_t c = initial; - while ( c != L'}' ) { - struct cons_pointer key = - read_continuation( frame, frame_pointer, input, c ); + while ( c != L'}' ) { + struct cons_pointer key = + read_continuation( frame, frame_pointer, input, c ); - /* skip whitespace */ - for (c = url_fgetwc( input ); - iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input )); + /* skip whitespace */ + for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ) + ; - struct cons_pointer value = - read_continuation( frame, frame_pointer, input, c ); + struct cons_pointer value = + read_continuation( frame, frame_pointer, input, c ); - /* skip commaa and whitespace at this point. */ - for (c = url_fgetwc( input ); - c == L',' || iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input )); + /* skip commaa and whitespace at this point. */ + for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ) + ; - result = merge_into_map( result, make_cons( make_cons( key, value), NIL)); - } + result = hashmap_put( result, key, value ); + } - return result; + // default write ACL for maps should be NIL. + pointer_to_vso( result )->payload.hashmap.write_acl = NIL; + + return result; } - /** * Read a string. This means either a string delimited by double quotes * (is_quoted == true), in which case it may contain whitespace but may diff --git a/src/memory/dump.c b/src/memory/dump.c index 074d1c4..b992bb2 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -21,8 +21,8 @@ #include "conspage.h" #include "consspaceobject.h" #include "debug.h" +#include "hashmap.h" #include "intern.h" -#include "map.h" #include "print.h" #include "stack.h" #include "vectorspace.h" @@ -141,14 +141,12 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n", &vso->header.tag.bytes, vso->header.tag.value, vso->header.size ); - if ( stackframep( vso ) ) { - dump_frame( output, pointer ); - } + switch ( vso->header.tag.value ) { case STACKFRAMETV: dump_frame( output, pointer ); break; - case MAPTV: + case HASHTV: dump_map( output, pointer); break; } diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 9be7d64..11a03f0 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -11,6 +11,8 @@ #include "arith/peano.h" #include "authorise.h" #include "debug.h" +#include "intern.h" +#include "memory/conspage.h" #include "memory/consspaceobject.h" #include "memory/hashmap.h" #include "memory/vectorspace.h" @@ -81,10 +83,12 @@ void free_hashmap( struct cons_pointer pointer ) { dec_ref( payload.write_acl ); for ( int i = 0; i < payload.n_buckets; i++ ) { - debug_printf( DEBUG_ALLOC, - L"Decrementing buckets[%d] of hashmap at 0x%lx\n", i, - cell->payload.vectorp.address ); - dec_ref( payload.buckets[i] ); + if ( !nilp( payload.buckets[i] ) ) { + debug_printf( DEBUG_ALLOC, + L"Decrementing bucket [%d] of hashmap at 0x%lx\n", i, + cell->payload.vectorp.address ); + dec_ref( payload.buckets[i] ); + } } } else { debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" ); @@ -137,7 +141,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - uint32_t n = 32; + uint32_t n = DFLT_HASHMAP_BUCKETS; struct cons_pointer hash_fn = NIL; struct cons_pointer result = NIL; @@ -185,6 +189,8 @@ 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 @@ -243,6 +249,19 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp, return mapp; } +struct cons_pointer hashmap_get( struct cons_pointer mapp, + struct cons_pointer key ) { + struct cons_pointer result = NIL; + if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); + uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets; + + result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] ); + } + + return result; +} + /** * Expects `frame->arg[1]` to be a hashmap or namespace; `frame->arg[2]` to be * a string-like-thing (perhaps necessarily a keyword); frame->arg[3] to be @@ -294,3 +313,44 @@ struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame, return hashmap_put_all( frame->arg[0], frame->arg[1] ); } +/** + * return a flat list of all the keys in the hashmap indicated by `map`. + */ +struct cons_pointer hashmap_keys( struct cons_pointer mapp) { + struct cons_pointer result = NIL; + if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) )) { + struct vector_space_object *map = pointer_to_vso( mapp ); + + for (int i = 0; i < map->payload.hashmap.n_buckets; i++) { + for (struct cons_pointer c = map->payload.hashmap.buckets[i]; + !nilp(c); + c = c_cdr(c)) { + result = make_cons(c_car( c_car(c)), result); + } + + } + } + + return result; +} + +struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return hashmap_keys( frame->arg[0] ); +} + +void dump_map( URL_FILE *output, struct cons_pointer pointer ) { + struct hashmap_payload *payload = &pointer_to_vso( pointer )->payload.hashmap; + url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets ); + url_fwprintf( output, L"\tHash function: " ); + print( output, payload->hash_fn ); + url_fwprintf( output, L"\n\tWrite ACL: " ); + print( output, payload->write_acl ); + url_fwprintf( output, L"\n\tBuckets:" ); + for ( int i = 0; i < payload->n_buckets; i++ ) { + url_fwprintf( output, L"\n\t\t[%d]: ", i ); + print( output, payload->buckets[i] ); + } + url_fwprintf( output, L"\n" ); +} diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index 579b56d..4602f3e 100644 --- a/src/memory/hashmap.h +++ b/src/memory/hashmap.h @@ -15,14 +15,27 @@ #include "memory/consspaceobject.h" #include "memory/vectorspace.h" +#define DFLT_HASHMAP_BUCKETS 32 + uint32_t get_hash( struct cons_pointer ptr ); void free_hashmap( struct cons_pointer ptr ); +void dump_map( URL_FILE *output, struct cons_pointer pointer ); + +struct cons_pointer hashmap_get( struct cons_pointer mapp, + struct cons_pointer key ); + +struct cons_pointer hashmap_put( struct cons_pointer mapp, + struct cons_pointer key, + struct cons_pointer val ); + struct cons_pointer lisp_get_hash( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +struct cons_pointer hashmap_keys( struct cons_pointer map ); + struct cons_pointer lisp_hashmap_put( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); @@ -35,4 +48,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +struct cons_pointer make_hashmap( uint32_t n_buckets, + struct cons_pointer hash_fn, + struct cons_pointer write_acl ); + #endif \ No newline at end of file diff --git a/src/memory/map.c b/src/memory/map.c deleted file mode 100644 index cbad3df..0000000 --- a/src/memory/map.c +++ /dev/null @@ -1,289 +0,0 @@ -/* - * map.c - * - * An immutable hashmap in vector space. - * - * (c) 2019 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#include - -#include "consspaceobject.h" -#include "conspage.h" -#include "debug.h" -#include "dump.h" -#include "fopen.h" -#include "intern.h" -#include "io.h" -#include "lookup3.h" -#include "map.h" -#include "print.h" -#include "vectorspace.h" - -/* \todo: a lot of this will be inherited by namespaces, regularities and - * homogeneities. Exactly how I don't yet know. */ - -/** - * Get a hash value for this key. - */ -uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) { - uint32_t result = 0; - int l = c_length(key); - - if (keywordp(key) || stringp(key) || symbolp( key)) { - if ( l > 0) { - uint32_t buffer[l]; - - if (!nilp(f)) { - fputws(L"Custom hashing functions are not yet implemented.\n", stderr); - } - for (int i = 0; i < l; i++) { - buffer[i] = (uint32_t)pointer2cell(key).payload.string.character; - } - - result = hashword( buffer, l, 0); - } - } else { - fputws(L"Hashing is thus far implemented only for keys, strings and symbols.\n", stderr); - } - - return result; -} - -/** - * get the actual map object from this `pointer`, or NULL if - * `pointer` is not a map pointer. - */ -struct map_payload *get_map_payload( struct cons_pointer pointer ) { - struct map_payload *result = NULL; - struct vector_space_object *vso = - pointer2cell( pointer ).payload.vectorp.address; - - if (vectorpointp(pointer) && mapp( vso ) ) { - result = ( struct map_payload * ) &( vso->payload ); - debug_printf( DEBUG_BIND, - L"get_map_payload: all good, returning %p\n", result ); - } else { - debug_print( L"get_map_payload: fail, returning NULL\n", DEBUG_BIND ); - } - - return result; -} - - -/** - * Make an empty immutable map, and return it. - * - * @param hash_function a pointer to a function of one argument, which - * returns an integer; or (more usually) `nil`. - * @return the new map, or NULL if memory is exhausted. - */ -struct cons_pointer make_empty_map( struct cons_pointer hash_function ) { - debug_print( L"Entering make_empty_map\n", DEBUG_BIND ); - struct cons_pointer result = - make_vso( MAPTAG, sizeof( struct map_payload ) ); - - if ( !nilp( result ) ) { - struct map_payload *payload = get_map_payload( result ); - - payload->hash_function = functionp( hash_function) ? hash_function : NIL; - inc_ref(hash_function); - - for ( int i = 0; i < BUCKETSINMAP; i++) { - payload->buckets[i] = NIL; - } - } - - debug_print( L"Leaving make_empty_map\n", DEBUG_BIND ); - return result; -} - - -struct cons_pointer make_duplicate_map( struct cons_pointer parent) { - struct cons_pointer result = NIL; - struct map_payload * parent_payload = get_map_payload(parent); - - if (parent_payload != NULL) { - result = - make_vso( MAPTAG, sizeof( struct map_payload ) ); - - if ( !nilp( result ) ) { - struct map_payload *payload = get_map_payload( result ); - - payload->hash_function = parent_payload->hash_function; - inc_ref(payload->hash_function); - - for ( int i = 0; i < BUCKETSINMAP; i++) { - payload->buckets[i] = parent_payload->buckets[i]; - inc_ref(payload->buckets[i]); - } - } - } - - return result; -} - - -struct cons_pointer bind_in_map( struct cons_pointer parent, - struct cons_pointer key, - struct cons_pointer value) { - struct cons_pointer result = make_duplicate_map(parent); - - if ( !nilp( result)) { - struct map_payload * payload = get_map_payload( result ); - int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; - - payload->buckets[bucket] = make_cons( - make_cons(key, value), payload->buckets[bucket]); - - inc_ref(payload->buckets[bucket]); - } - - return result; -} - - -struct cons_pointer keys( struct cons_pointer store) { - debug_print( L"Entering keys\n", DEBUG_BIND ); - struct cons_pointer result = NIL; - - struct cons_space_object cell = pointer2cell( store ); - - switch (pointer2cell( store ).tag.value) { - case CONSTV: - for (struct cons_pointer c = store; !nilp(c); c = c_cdr(c)) { - result = make_cons( c_car( c_car( c)), result); - } - break; - case VECTORPOINTTV: { - struct vector_space_object *vso = - pointer2cell( store ).payload.vectorp.address; - - if ( mapp( vso ) ) { - struct map_payload * payload = get_map_payload( store ); - - for (int bucket = 0; bucket < BUCKETSINMAP; bucket++) { - for (struct cons_pointer c = payload->buckets[bucket]; - !nilp(c); c = c_cdr(c)) { - debug_print( L"keys: c is ", DEBUG_BIND); - debug_print_object( c, DEBUG_BIND); - - result = make_cons( c_car( c_car( c)), result); - debug_print( L"; result is ", DEBUG_BIND); - debug_print_object( result, DEBUG_BIND); - debug_println( DEBUG_BIND); - } - } - } - } - break; - } - debug_print( L"keys returning ", DEBUG_BIND ); - debug_print_object( result, DEBUG_BIND ); - debug_println( DEBUG_BIND); - - return result; -} - -/** - * Return a new map which represents the merger of `to_merge` into - * `parent`. `parent` must be a map, but `to_merge` may be a map or - * an assoc list. - * - * @param parent a map; - * @param to_merge an association from which key/value pairs will be merged. - * @result a new map, containing all key/value pairs from `to_merge` - * together with those key/value pairs from `parent` whose keys did not - * collide. - */ -struct cons_pointer merge_into_map( struct cons_pointer parent, - struct cons_pointer to_merge) { - debug_print( L"Entering merge_into_map\n", DEBUG_BIND ); - struct cons_pointer result = make_duplicate_map(parent); - - if (!nilp(result)) { - struct map_payload *payload = get_map_payload( result ); - for (struct cons_pointer c = keys(to_merge); - !nilp(c); c = c_cdr(c)) { - struct cons_pointer key = c_car( c); - int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; - - payload->buckets[bucket] = make_cons( - make_cons( key, c_assoc( key, to_merge)), - payload->buckets[bucket]); - } - } - - debug_print( L"Leaving merge_into_map\n", DEBUG_BIND ); - - return result; -} - - -struct cons_pointer assoc_in_map( struct cons_pointer key, - struct cons_pointer map) { - debug_print( L"Entering assoc_in_map\n", DEBUG_BIND ); - struct cons_pointer result = NIL; - struct map_payload *payload = get_map_payload( map ); - - if (payload != NULL) { - int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; - result = c_assoc(key, payload->buckets[bucket]); - } - - debug_print( L"assoc_in_map returning ", DEBUG_BIND ); - debug_print_object( result, DEBUG_BIND); - debug_println( DEBUG_BIND); - - return result; -} - - -/** - * Function: create a map initialised with key/value pairs from my - * first argument. - * - * * (make-map) - * * (make-map store) - * - * @param frame the stack frame in which the expression is to be interpreted; - * @param frame_pointer a pointer to my stack_frame. - * @param env the environment in which it is to be intepreted. - * @return a new containing all the key/value pairs from store. - */ -struct cons_pointer -lisp_make_map( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { - return merge_into_map( make_empty_map( NIL), frame->arg[0]); -} - -/** - * Dump a map to this stream for debugging - * @param output the stream - * @param map_pointer the pointer to the frame - */ -void dump_map( URL_FILE * output, struct cons_pointer map_pointer ) { - struct vector_space_object *vso = - pointer2cell( map_pointer ).payload.vectorp.address; - - if (vectorpointp(map_pointer) && mapp( vso ) ) { - struct map_payload *payload = get_map_payload( map_pointer ); - - if ( payload != NULL ) { - url_fputws( L"Immutable map; hash function: ", output ); - - if (nilp(payload->hash_function)) { - url_fputws( L"default", output); - } else { - dump_object( output, payload->hash_function); - } - - for (int i = 0; i < BUCKETSINMAP; i++) { - url_fwprintf(output, L"\n\tBucket %d: ", i); - print( output, payload->buckets[i]); - } - } - } -} - diff --git a/src/memory/map.h b/src/memory/map.h deleted file mode 100644 index c9b5cfc..0000000 --- a/src/memory/map.h +++ /dev/null @@ -1,96 +0,0 @@ -/* - * map.h - * - * An immutable hashmap in vector space. - * - * (c) 2019 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#ifndef __psse_map_h -#define __psse_map_h - -#include "consspaceobject.h" -#include "conspage.h" - -/** - * macros for the tag of a mutable map. - */ -#define MAPTAG "IMAP" -#define MAPTV 1346456905 - -/** - * Number of buckets in a single tier map. - */ -#define BUCKETSINMAP 256 - -/** - * Maximum number of entries in an association-list bucket. - */ -#define MAXENTRIESINASSOC 16 - -/** - * true if this vector_space_object is a map, else false. - */ -#define mapp( vso) (((struct vector_space_object *)vso)->header.tag.value == MAPTV) - -/** - * The vector-space payload of a map object. Essentially a vector of - * `BUCKETSINMAP` + 1 `cons_pointer`s, but the first one is considered - * special. - */ -struct map_payload { - /** - * There is a default hash function, which is used if `hash_function` is - * `nil` (which it normally should be); and keywords will probably carry - * their own hash values. But it will be possible to override the hash - * function by putting a function of one argument returning an integer - * here. */ - struct cons_pointer hash_function; - - /** - * Obviously the number of buckets in a map is a trade off, and this may need - * tuning - or it may even be necessary to have different sized base maps. The - * idea here is that the value of a bucket is - * - * 1. `nil`; or - * 2. an association list; or - * 3. a map. - * - * All buckets are initially `nil`. Adding a value to a `nil` bucket returns - * a map with a new bucket in the form of an assoc list. Subsequent additions - * cons new key/value pairs onto the assoc list, until there are - * `MAXENTRIESINASSOC` pairs, at which point if a further value is added to - * the same bucket the bucket returned will be in the form of a second level - * map. My plan is that buckets the first level map will be indexed on the - * first sixteen bits of the hash value, those in the second on the second - * sixteen, and, potentially, so on. - */ - struct cons_pointer buckets[BUCKETSINMAP]; -}; - -uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key); - -struct map_payload *get_map_payload( struct cons_pointer pointer ); - -struct cons_pointer make_empty_map( struct cons_pointer hash_function ); - -struct cons_pointer bind_in_map( struct cons_pointer parent, - struct cons_pointer key, - struct cons_pointer value); - -struct cons_pointer keys( struct cons_pointer store); - -struct cons_pointer merge_into_map( struct cons_pointer parent, - struct cons_pointer to_merge); - -struct cons_pointer assoc_in_map( struct cons_pointer key, - struct cons_pointer map); - -struct cons_pointer lisp_make_map( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); - -void dump_map( URL_FILE * output, struct cons_pointer map_pointer ); - -#endif diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index ed050bc..2c163e8 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -27,15 +27,17 @@ * part of the implementation structure of a namespace. */ #define HASHTAG "HASH" -#define HASHTV 0 +#define HASHTV 1213415752 #define hashmapp(conspoint)((check_tag(conspoint,HASHTAG))) /* * a namespace (i.e. a binding of names to values, implemented as a hashmap) + * TODO: but note that a namespace is now essentially a hashmap with a write ACL + * whose name is interned. */ #define NAMESPACETAG "NMSP" -#define NAMESPACETV 0 +#define NAMESPACETV 1347636558 #define namespacep(conspoint)(check_tag(conspoint,NAMESPACETAG)) @@ -43,7 +45,7 @@ * a vector of cons pointers. */ #define VECTORTAG "VECT" -#define VECTORTV 0 +#define VECTORTV 1413694806 #define vectorp(conspoint)(check_tag(conspoint,VECTORTAG)) diff --git a/src/ops/intern.c b/src/ops/intern.c index 802bc82..07b9693 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -25,7 +25,6 @@ #include "equal.h" #include "hashmap.h" #include "lispops.h" -#include "map.h" #include "print.h" /** @@ -109,7 +108,7 @@ struct cons_pointer c_assoc( struct cons_pointer key, } } } else if (hashmapp( store)) { - result = assoc_in_map( key, store); + result = hashmap_get( store, key); } else { result = throw_exception(c_string_to_lisp_string(L"Store is of unknown type"), NIL); } @@ -140,8 +139,8 @@ struct cons_pointer if (nilp( store) || consp(store)) { result = make_cons( make_cons( key, value ), store ); - } else if (vectorpointp( store)) { - result = bind_in_map( store, key, value); + } else if (hashmapp( store)) { + result = hashmap_put( store, key, value); } debug_print( L"set returning ", DEBUG_BIND); @@ -196,3 +195,4 @@ intern( struct cons_pointer key, struct cons_pointer environment ) { return result; } + diff --git a/src/ops/lispops.c b/src/ops/lispops.c index c96b1be..3a972a5 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -33,7 +33,6 @@ #include "intern.h" #include "io.h" #include "lispops.h" -#include "map.h" #include "print.h" #include "read.h" #include "stack.h" @@ -378,7 +377,7 @@ struct cons_pointer case VECTORPOINTTV: switch ( pointer_to_vso(fn_pointer)->header.tag.value) { - case MAPTV: + case HASHTV: /* \todo: if arg[0] is a CONS, treat it as a path */ result = c_assoc( eval_form(frame, frame_pointer, @@ -803,6 +802,26 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, return c_assoc( frame->arg[0], frame->arg[1] ); } +struct cons_pointer c_keys(struct cons_pointer store) { + struct cons_pointer result = NIL; + + if ( hashmapp( store ) ) { + result = hashmap_keys( store ); + } else if ( consp( store ) ) { + for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) { + result = make_cons( c_car( c ), result ); + } + } + + return result; +} + +struct cons_pointer lisp_keys( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return c_keys( frame->arg[0]); +} + /** * Function; are these two objects the same object? Shallow, cheap equality. * diff --git a/src/ops/lispops.h b/src/ops/lispops.h index f359252..4669493 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -26,12 +26,14 @@ * utilities */ +struct cons_pointer c_keys( struct cons_pointer store ); struct cons_pointer c_reverse( struct cons_pointer arg ); -struct cons_pointer -c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer expressions, struct cons_pointer env ); +struct cons_pointer c_progn( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer expressions, + struct cons_pointer env ); /** * Useful building block; evaluate this single form in the context of this @@ -56,7 +58,6 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer list, struct cons_pointer env ); - /* * special forms */ @@ -67,17 +68,21 @@ struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer -lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_keys( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); -struct cons_pointer -lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_oblist( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); -struct cons_pointer -lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_set( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); + +struct cons_pointer lisp_set_shriek( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Construct an interpretable function. @@ -90,17 +95,17 @@ struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer lisp_length( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Construct an interpretable special form. * * @param frame the stack frame in which the expression is to be interpreted; * @param env the environment in which it is to be intepreted. */ -struct cons_pointer -lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_nlambda( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -146,10 +151,9 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, * @param env My environment (ignored). * @return As a Lisp string, the tag of the object which is the argument. */ -struct cons_pointer -lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); - +struct cons_pointer lisp_type( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Function; evaluate the forms which are listed in my single argument @@ -161,9 +165,9 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, * @return the value of the last form on the sequence which is my single * argument. */ -struct cons_pointer -lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_progn( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Special form: conditional. Each arg is expected to be a list; if the first @@ -174,22 +178,22 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, * @param env My environment (ignored). * @return the value of the last form of the first successful clause. */ -struct cons_pointer -lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_cond( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Throw an exception. - * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a - * lisp function; but it is nevertheless to be preferred to make_exception. A - * real `throw_exception`, which does, will be needed. + * `throw_exception` is a misnomer, because it doesn't obey the calling + * signature of a lisp function; but it is nevertheless to be preferred to + * make_exception. A real `throw_exception`, which does, will be needed. */ struct cons_pointer throw_exception( struct cons_pointer message, struct cons_pointer frame_pointer ); -struct cons_pointer -lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_exception( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer, From eadb125b83665f60dba28b97e92ebc2bc05c2eed Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 16 Aug 2021 23:23:03 +0100 Subject: [PATCH 10/90] Hashmaps now *mostly* work --- .gitignore | 2 + src/init.c | 2 +- src/io/io.c | 30 ++++- src/io/io.h | 2 + src/memory/consspaceobject.c | 9 +- src/memory/dump.c | 208 +++++++++++++++++------------------ src/memory/hashmap.c | 1 + src/memory/vectorspace.c | 23 +++- src/ops/lispops.c | 134 ++++++++++++---------- src/ops/lispops.h | 13 +-- 10 files changed, 238 insertions(+), 186 deletions(-) diff --git a/.gitignore b/.gitignore index 3bf3906..a85ac01 100644 --- a/.gitignore +++ b/.gitignore @@ -40,3 +40,5 @@ src/io/fopen hi\.* .vscode/ + +core diff --git a/src/init.c b/src/init.c index 7b1649c..4126783 100644 --- a/src/init.c +++ b/src/init.c @@ -225,7 +225,7 @@ int main( int argc, char *argv[] ) { bind_function( L"equal", &lisp_equal ); bind_function( L"eval", &lisp_eval ); bind_function( L"exception", &lisp_exception ); - bind_function( L"gethash", &lisp_get_hash); + bind_function( L"get-hash", &lisp_get_hash); bind_function(L"hashmap", lisp_make_hashmap); bind_function( L"inspect", &lisp_inspect ); bind_function( L"keys", &lisp_keys); diff --git a/src/io/io.c b/src/io/io.c index 5065044..9976373 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -177,13 +177,13 @@ wint_t url_fgetwc( URL_FILE * input ) { * E0 to EF hex (224 to 239): first byte of a three-byte sequence. * F0 to FF hex (240 to 255): first byte of a four-byte sequence. */ - if ( c <= 0x07 ) { + if ( c <= 0xf7 ) { count = 1; - } else if ( c >= '0xc2' && c <= '0xdf' ) { + } else if ( c >= 0xc2 && c <= 0xdf ) { count = 2; - } else if ( c >= '0xe0' && c <= '0xef' ) { + } else if ( c >= 0xe0 && c <= 0xef ) { count = 3; - } else if ( c >= '0xf0' && c <= '0xff' ) { + } else if ( c >= 0xf0 && c <= 0xff ) { count = 4; } @@ -395,6 +395,24 @@ void collect_meta( struct cons_pointer stream, char *url ) { cell->payload.stream.meta = meta; } +/** + * Resutn the current default input, or of `inputp` is false, output stream from + * this `env`ironment. + */ +struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) { + struct cons_pointer result = NIL; + struct cons_pointer stream_name = + c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" ); + + inc_ref( stream_name ); + + result = c_assoc( stream_name, env ); + + dec_ref( stream_name ); + + return result; +} + /** * Function: return a stream open on the URL indicated by the first argument; @@ -423,8 +441,8 @@ lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE *stream = url_fopen( url, "r" ); debug_printf( DEBUG_IO, - L"lisp_open: stream @ %d, stream type = %d, stream handle = %d\n", - (int) &stream, (int)stream->type, (int)stream->handle.file); + L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n", + (long int) &stream, (int)stream->type, (long int)stream->handle.file); switch (stream->type) { case CFTYPE_NONE: diff --git a/src/io/io.h b/src/io/io.h index 33f733f..f350c13 100644 --- a/src/io/io.h +++ b/src/io/io.h @@ -21,6 +21,8 @@ URL_FILE *file_to_url_file( FILE * f ); wint_t url_fgetwc( URL_FILE * input ); wint_t url_ungetwc( wint_t wc, URL_FILE * input ); +struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ); + struct cons_pointer lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index ee82956..9e956f4 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -35,15 +35,15 @@ bool check_tag( struct cons_pointer pointer, char *tag ) { bool result = false; struct cons_space_object cell = pointer2cell( pointer ); - + result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; if ( result == false ) { - if ( strncmp( &cell.tag.bytes[0], VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + if ( cell.tag.value == VECTORPOINTTV ) { struct vector_space_object *vec = pointer_to_vso( pointer ); if ( vec != NULL ) { - result = strncmp( &vec->header.tag.bytes[0], tag, TAGLENGTH ) == 0; + result = strncmp( &(vec->header.tag.bytes[0]), tag, TAGLENGTH ) == 0; } } } @@ -286,7 +286,7 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) case KEYTV: case STRINGTV: case SYMBOLTV: - if (nilp(ptr)) + if (nilp(cell->payload.string.cdr)) { result = (uint32_t)c; } @@ -296,6 +296,7 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) cell->payload.string.hash) & 0xffffffff; } + break; } return result; diff --git a/src/memory/dump.c b/src/memory/dump.c index b992bb2..2dc6658 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -23,6 +23,7 @@ #include "debug.h" #include "hashmap.h" #include "intern.h" +#include "io.h" #include "print.h" #include "stack.h" #include "vectorspace.h" @@ -39,12 +40,14 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix, cell.payload.string.cdr.offset, cell.count ); } else { url_fwprintf( output, - L"\t\t%ls cell: character '%lc' (%d) next at page %d offset %d, count %u\n", + L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n", prefix, ( wint_t ) cell.payload.string.character, cell.payload.string.character, + cell.payload.string.hash, cell.payload.string.cdr.page, - cell.payload.string.cdr.offset, cell.count ); + cell.payload.string.cdr.offset, + cell.count ); url_fwprintf( output, L"\t\t value: " ); print( output, pointer ); url_fwprintf( output, L"\n" ); @@ -54,108 +57,105 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix, /** * dump the object at this cons_pointer to this output stream. */ -void dump_object( URL_FILE * output, struct cons_pointer pointer ) { - struct cons_space_object cell = pointer2cell( pointer ); - url_fwprintf( output, - L"\t%4.4s (%d) at page %d, offset %d count %u\n", - cell.tag.bytes, - cell.tag.value, pointer.page, pointer.offset, cell.count ); +void dump_object( URL_FILE *output, struct cons_pointer pointer ) { + struct cons_space_object cell = pointer2cell( pointer ); + url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n", + cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset, + cell.count ); - switch ( cell.tag.value ) { - case CONSTV: - url_fwprintf( output, - L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u :", - cell.payload.cons.car.page, - cell.payload.cons.car.offset, - cell.payload.cons.cdr.page, - cell.payload.cons.cdr.offset, cell.count ); - print( output, pointer ); - url_fputws( L"\n", output ); - break; - case EXCEPTIONTV: - url_fwprintf( output, L"\t\tException cell: " ); - dump_stack_trace( output, pointer ); - break; - case FREETV: - url_fwprintf( output, - L"\t\tFree cell: next at page %d offset %d\n", - cell.payload.cons.cdr.page, - cell.payload.cons.cdr.offset ); - break; - case INTEGERTV: - url_fwprintf( output, - L"\t\tInteger cell: value %ld, count %u\n", - cell.payload.integer.value, cell.count ); - if ( !nilp( cell.payload.integer.more ) ) { - url_fputws( L"\t\tBIGNUM! More at:\n", output ); - dump_object( output, cell.payload.integer.more ); - } - break; - case LAMBDATV: - url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); - print( output, cell.payload.lambda.args ); - url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); - url_fputws( L"\n", output ); - break; - case NILTV: - break; - case NLAMBDATV: - url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); - print( output, cell.payload.lambda.args ); - url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); - url_fputws( L"\n", output ); - break; - case RATIOTV: - url_fwprintf( output, - L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ). - payload.integer.value, - pointer2cell( cell.payload.ratio.divisor ). - payload.integer.value, cell.count ); - break; - case READTV: - url_fputws( L"\t\tInput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); - url_fputws( L"\n", output ); - break; - case REALTV: - url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", - cell.payload.real.value, cell.count ); - break; - case STRINGTV: - dump_string_cell( output, L"String", pointer ); - break; - case SYMBOLTV: - dump_string_cell( output, L"Symbol", pointer ); - break; - case TRUETV: - break; - case VECTORPOINTTV:{ - url_fwprintf( output, - L"\t\tPointer to vector-space object at %p\n", - cell.payload.vectorp.address ); - struct vector_space_object *vso = cell.payload.vectorp.address; - url_fwprintf( output, - L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n", - &vso->header.tag.bytes, vso->header.tag.value, - vso->header.size ); + switch ( cell.tag.value ) { + case CONSTV: + url_fwprintf( output, + L"\t\tCons cell: car at page %d offset %d, cdr at page %d " + L"offset %d, count %u :", + cell.payload.cons.car.page, cell.payload.cons.car.offset, + cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset, + cell.count ); + print( output, pointer ); + url_fputws( L"\n", output ); + break; + case EXCEPTIONTV: + url_fwprintf( output, L"\t\tException cell: " ); + dump_stack_trace( output, pointer ); + break; + case FREETV: + url_fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", + cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); + break; + case INTEGERTV: + url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n", + cell.payload.integer.value, cell.count ); + if ( !nilp( cell.payload.integer.more ) ) { + url_fputws( L"\t\tBIGNUM! More at:\n", output ); + dump_object( output, cell.payload.integer.more ); + } + break; + case KEYTV: + dump_string_cell( output, L"Keyword", pointer ); + break; + case LAMBDATV: + url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); + print( output, cell.payload.lambda.args ); + url_fwprintf( output, L";\n\t\t\tbody: " ); + print( output, cell.payload.lambda.body ); + url_fputws( L"\n", output ); + break; + case NILTV: + break; + case NLAMBDATV: + url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); + print( output, cell.payload.lambda.args ); + url_fwprintf( output, L";\n\t\t\tbody: " ); + print( output, cell.payload.lambda.body ); + url_fputws( L"\n", output ); + break; + case RATIOTV: + url_fwprintf( + output, L"\t\tRational cell: value %ld/%ld, count %u\n", + pointer2cell( cell.payload.ratio.dividend ).payload.integer.value, + pointer2cell( cell.payload.ratio.divisor ).payload.integer.value, + cell.count ); + break; + case READTV: + url_fputws( L"\t\tInput stream; metadata: ", output ); + print( output, cell.payload.stream.meta ); + url_fputws( L"\n", output ); + break; + case REALTV: + url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", + cell.payload.real.value, cell.count ); + break; + case STRINGTV: + dump_string_cell( output, L"String", pointer ); + break; + case SYMBOLTV: + dump_string_cell( output, L"Symbol", pointer ); + break; + case TRUETV: + break; + case VECTORPOINTTV: { + url_fwprintf( output, L"\t\tPointer to vector-space object at %p\n", + cell.payload.vectorp.address ); + struct vector_space_object *vso = cell.payload.vectorp.address; + url_fwprintf( output, + L"\t\tVector space object of type %4.4s (%d), payload size " + L"%d bytes\n", + &vso->header.tag.bytes, vso->header.tag.value, + vso->header.size ); - switch ( vso->header.tag.value ) { - case STACKFRAMETV: - dump_frame( output, pointer ); - break; - case HASHTV: - dump_map( output, pointer); - break; - } - } - break; - case WRITETV: - url_fputws( L"\t\tOutput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); - url_fputws( L"\n", output ); - break; - } + switch ( vso->header.tag.value ) { + case STACKFRAMETV: + dump_frame( output, pointer ); + break; + case HASHTV: + dump_map( output, pointer ); + break; + } + } break; + case WRITETV: + url_fputws( L"\t\tOutput stream; metadata: ", output ); + print( output, cell.payload.stream.meta ); + url_fputws( L"\n", output ); + break; + } } diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 11a03f0..73d3905 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -12,6 +12,7 @@ #include "authorise.h" #include "debug.h" #include "intern.h" +#include "io/print.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" #include "memory/hashmap.h" diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index b3e64c6..a6e292d 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -119,11 +119,11 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { * object. Dangerous! */ void free_vso( struct cons_pointer pointer ) { - struct cons_space_object * cell = &pointer2cell( pointer); + struct cons_space_object cell = pointer2cell( pointer ); debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); - struct vector_space_object *vso = cell->payload.vectorp.address; + cell.payload.vectorp.address ); + struct vector_space_object *vso = cell.payload.vectorp.address; switch ( vso->header.tag.value ) { case HASHTV: @@ -134,7 +134,18 @@ void free_vso( struct cons_pointer pointer ) { break; } - free( (void *)cell->payload.vectorp.address ); +// free( (void *)cell.payload.vectorp.address ); debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n", - cell->payload.vectorp.address ); -} \ No newline at end of file + cell.payload.vectorp.address ); +} + +// bool check_vso_tag( struct cons_pointer pointer, char * tag) { +// bool result = false; + +// if (check_tag(pointer, VECTORPOINTTAG)) { +// struct vector_space_object * vso = pointer_to_vso(pointer); +// result = strncmp( vso->header.tag.bytes[0], tag, TAGLENGTH); +// } + +// return result; +// } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 3a972a5..0c495f9 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -854,26 +854,6 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } - -/** - * Resutn the current default input, or of `inputp` is false, output stream from - * this `env`ironment. - */ -struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) { - struct cons_pointer result = NIL; - struct cons_pointer stream_name = - c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" ); - - inc_ref( stream_name ); - - result = c_assoc( stream_name, env ); - - dec_ref( stream_name ); - - return result; -} - - /** * Function; read one complete lisp form and return it. If read-stream is specified and * is a read stream, then read from that stream, else the stream which is the value of @@ -965,6 +945,44 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, return c_reverse( frame->arg[0] ); } +/** + * Function: dump/inspect one complete lisp expression and return NIL. If + * write-stream is specified and is a write stream, then print to that stream, + * else the stream which is the value of + * `*out*` in the environment. + * + * * (inspect expr) + * * (inspect expr write-stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (from which the stream may be extracted). + * @return NIL. + */ +struct cons_pointer lisp_inspect( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + debug_print( L"Entering lisp_inspect\n", DEBUG_IO ); + struct cons_pointer result = NIL; + struct cons_pointer out_stream = writep( frame->arg[1] ) + ? frame->arg[1] + : get_default_stream( false, env ); + URL_FILE *output; + + if ( writep( out_stream ) ) { + debug_print( L"lisp_inspect: setting output stream\n", DEBUG_IO ); + debug_dump_object( out_stream, DEBUG_IO ); + output = pointer2cell( out_stream ).payload.stream.stream; + } else { + output = file_to_url_file( stderr ); + } + + dump_object( output, frame->arg[0] ); + + debug_print( L"Leaving lisp_inspect", DEBUG_IO ); + + return result; +} /** * Function; print one complete lisp expression and return NIL. If write-stream is specified and @@ -976,8 +994,8 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, * * @param frame my stack_frame. * @param frame_pointer a pointer to my stack_frame. - * @param env my environment (ignored). - * @return the value of `expr`. + * @param env my environment (from which the stream may be extracted). + * @return NIL. */ struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -1332,43 +1350,43 @@ struct cons_pointer lisp_source( struct stack_frame *frame, } -/** - * Function; print the internal representation of the object indicated by `frame->arg[0]` to the - * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. - * - * * (inspect expression) - * * (inspect expression ) - * - * @param frame my stack frame. - * @param frame_pointer a pointer to my stack_frame. - * @param env the environment. - * @return the value of the first argument - `expression`. - */ -struct cons_pointer lisp_inspect( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ) { - debug_print( L"Entering print\n", DEBUG_IO ); - URL_FILE *output; - struct cons_pointer out_stream = writep( frame->arg[1] ) ? - frame->arg[1] : get_default_stream( false, env ); +// /** +// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the +// * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. +// * +// * * (inspect expression) +// * * (inspect expression ) +// * +// * @param frame my stack frame. +// * @param frame_pointer a pointer to my stack_frame. +// * @param env the environment. +// * @return the value of the first argument - `expression`. +// */ +// struct cons_pointer lisp_inspect( struct stack_frame *frame, +// struct cons_pointer frame_pointer, +// struct cons_pointer env ) { +// debug_print( L"Entering print\n", DEBUG_IO ); +// URL_FILE *output; +// struct cons_pointer out_stream = writep( frame->arg[1] ) ? +// frame->arg[1] : get_default_stream( false, env ); - if ( writep( out_stream ) ) { - debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); - debug_dump_object( out_stream, DEBUG_IO ); - output = pointer2cell( out_stream ).payload.stream.stream; - inc_ref( out_stream ); - } else { - output = file_to_url_file( stdout ); - } +// if ( writep( out_stream ) ) { +// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); +// debug_dump_object( out_stream, DEBUG_IO ); +// output = pointer2cell( out_stream ).payload.stream.stream; +// inc_ref( out_stream ); +// } else { +// output = file_to_url_file( stdout ); +// } - dump_object( output, frame->arg[0] ); - url_fputws( L"\n", output ); +// dump_object( output, frame->arg[0] ); +// url_fputws( L"\n", output ); - if ( writep( out_stream ) ) { - dec_ref( out_stream ); - } else { - free( output ); - } +// if ( writep( out_stream ) ) { +// dec_ref( out_stream ); +// } else { +// free( output ); +// } - return frame->arg[0]; -} +// return frame->arg[0]; +// } diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 4669493..014df2e 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -114,6 +114,9 @@ struct cons_pointer lisp_quote( struct stack_frame *frame, /* * functions */ +struct cons_pointer lisp_assoc( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); @@ -123,9 +126,9 @@ struct cons_pointer lisp_car( struct stack_frame *frame, struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_assoc( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_inspect( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); @@ -199,8 +202,4 @@ struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer lisp_inspect( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); - #endif From 93d4bd14a081783c5ff082579ac6fddb159ccc74 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 17 Aug 2021 16:09:00 +0100 Subject: [PATCH 11/90] Generally, changed working with tags as strings to as values. This seems both cheaper and safer; what's not to like? --- Makefile | 5 ++-- src/arith/integer.c | 3 +-- src/arith/ratio.c | 2 +- src/arith/real.c | 2 +- src/io/read.c | 12 ++++----- src/memory/conspage.c | 6 ++--- src/memory/conspage.h | 2 +- src/memory/consspaceobject.c | 40 +++++++++++++-------------- src/memory/consspaceobject.h | 52 ++++++++++++++++++------------------ src/memory/hashmap.c | 13 +++++---- src/memory/stack.c | 2 +- src/memory/vectorspace.c | 12 ++++----- src/memory/vectorspace.h | 8 +++--- src/ops/lispops.c | 2 +- src/time/psse_time.c | 2 +- unit-tests/lambda.sh | 2 +- unit-tests/map.sh | 10 +++---- 17 files changed, 87 insertions(+), 88 deletions(-) diff --git a/Makefile b/Makefile index c4c4ef3..d8e6e81 100644 --- a/Makefile +++ b/Makefile @@ -17,11 +17,12 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG LDFLAGS := -lm -lcurl +DEBUGFLAGS := -g3 all: $(TARGET) $(TARGET): $(OBJS) Makefile - $(CC) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) + $(CC) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) doc: $(SRCS) Makefile Doxyfile doxygen @@ -38,7 +39,7 @@ test: $(OBJS) $(TESTS) Makefile .PHONY: clean clean: - $(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ + $(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core repl: $(TARGET) -p 2> psse.log diff --git a/src/arith/integer.c b/src/arith/integer.c index e02d30e..5f47532 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -46,11 +46,10 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) { debug_print( L"Entering make_integer\n", DEBUG_ALLOC ); if ( integerp( more ) || nilp( more ) ) { - result = allocate_cell( INTEGERTAG ); + 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 ); diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 8976e38..f4c8056 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -315,7 +315,7 @@ struct cons_pointer make_ratio( struct cons_pointer dividend, if ( integerp( dividend ) && integerp( divisor ) ) { inc_ref( dividend ); inc_ref( divisor ); - result = allocate_cell( RATIOTAG ); + result = allocate_cell( RATIOTV ); struct cons_space_object *cell = &pointer2cell( result ); cell->payload.ratio.dividend = dividend; cell->payload.ratio.divisor = divisor; diff --git a/src/arith/real.c b/src/arith/real.c index 84ba899..a59a125 100644 --- a/src/arith/real.c +++ b/src/arith/real.c @@ -19,7 +19,7 @@ * @return a real number cell wrapping this value. */ struct cons_pointer make_real( long double value ) { - struct cons_pointer result = allocate_cell( REALTAG ); + struct cons_pointer result = allocate_cell( REALTV ); struct cons_space_object *cell = &pointer2cell( result ); cell->payload.real.value = value; diff --git a/src/io/read.c b/src/io/read.c index ede44ad..2395cbc 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -49,7 +49,7 @@ struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); -struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag, +struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, wint_t initial ); /** @@ -119,7 +119,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, read_number( frame, frame_pointer, input, c, false ); } else { - result = read_symbol_or_key( input, SYMBOLTAG, c ); + result = read_symbol_or_key( input, SYMBOLTV, c ); } } break; @@ -139,20 +139,20 @@ struct cons_pointer read_continuation( struct stack_frame *frame, debug_print( L"read_continuation: dotted pair; read cdr ", DEBUG_IO); } else { - read_symbol_or_key( input, SYMBOLTAG, c ); + read_symbol_or_key( input, SYMBOLTV, c ); } } break; case ':': result = - read_symbol_or_key( input, KEYTAG, url_fgetwc( input ) ); + read_symbol_or_key( input, KEYTV, url_fgetwc( input ) ); break; default: if ( iswdigit( c ) ) { result = read_number( frame, frame_pointer, input, c, false ); } else if ( iswprint( c ) ) { - result = read_symbol_or_key( input, SYMBOLTAG, c ); + result = read_symbol_or_key( input, SYMBOLTV, c ); } else { result = throw_exception( make_cons( c_string_to_lisp_string @@ -386,7 +386,7 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) { return result; } -struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag, +struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, wint_t initial ) { struct cons_pointer cdr = NIL; struct cons_pointer result; diff --git a/src/memory/conspage.c b/src/memory/conspage.c index c9c224d..0b4bf7d 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -140,7 +140,7 @@ void free_cell( struct cons_pointer pointer ) { debug_printf( DEBUG_ALLOC, L"Freeing cell " ); debug_dump_object( pointer, DEBUG_ALLOC ); - if ( !check_tag( pointer, FREETAG ) ) { + if ( !check_tag( pointer, FREETV ) ) { if ( cell->count == 0 ) { switch ( cell->tag.value ) { case CONSTV: @@ -209,7 +209,7 @@ void free_cell( struct cons_pointer pointer ) { * return an exception. Which, as we cannot create such an exception when * cons space is exhausted, means we must construct it at init time. */ -struct cons_pointer allocate_cell( char *tag ) { +struct cons_pointer allocate_cell( uint32_t tag ) { struct cons_pointer result = freelist; @@ -222,7 +222,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, TAGLENGTH ); + cell->tag.value = tag; cell->count = 0; cell->payload.cons.car = NIL; diff --git a/src/memory/conspage.h b/src/memory/conspage.h index 9eab748..260794e 100644 --- a/src/memory/conspage.h +++ b/src/memory/conspage.h @@ -55,7 +55,7 @@ extern struct cons_page *conspages[NCONSPAGES]; void free_cell( struct cons_pointer pointer ); -struct cons_pointer allocate_cell( char *tag ); +struct cons_pointer allocate_cell( uint32_t tag ); void initialise_cons_pages( ); diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 9e956f4..32c777f 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -28,22 +28,22 @@ #include "vectorspace.h" /** - * True if the tag on the cell at this `pointer` is this `tag`, or, if the tag - * of the cell is `VECP`, if the tag of the vectorspace object indicated by the - * cell is this `tag`, else false. + * True if the value of the tag on the cell at this `pointer` is this `value`, + * or, if the tag of the cell is `VECP`, if the value of the tag of the + * vectorspace object indicated by the cell is this `value`, else false. */ -bool check_tag( struct cons_pointer pointer, char *tag ) { +bool check_tag( struct cons_pointer pointer, uint32_t value ) { bool result = false; + struct cons_space_object cell = pointer2cell( pointer ); - - result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; + result = cell.tag.value == value; if ( result == false ) { if ( cell.tag.value == VECTORPOINTTV ) { struct vector_space_object *vec = pointer_to_vso( pointer ); if ( vec != NULL ) { - result = strncmp( &(vec->header.tag.bytes[0]), tag, TAGLENGTH ) == 0; + result = vec->header.tag.value == value; } } } @@ -177,7 +177,7 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr ) { struct cons_pointer pointer = NIL; - pointer = allocate_cell( CONSTAG ); + pointer = allocate_cell( CONSTV ); struct cons_space_object *cell = &pointer2cell( pointer ); @@ -197,7 +197,7 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer frame_pointer ) { struct cons_pointer result = NIL; - struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG ); + struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); struct cons_space_object *cell = &pointer2cell( pointer ); inc_ref( message ); @@ -218,7 +218,7 @@ struct cons_pointer make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ) { - struct cons_pointer pointer = allocate_cell( FUNCTIONTAG ); + struct cons_pointer pointer = allocate_cell( FUNCTIONTV ); struct cons_space_object *cell = &pointer2cell( pointer ); inc_ref( meta ); @@ -233,7 +233,7 @@ make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) */ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( LAMBDATAG ); + struct cons_pointer pointer = allocate_cell( LAMBDATV ); struct cons_space_object *cell = &pointer2cell( pointer ); inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ @@ -252,7 +252,7 @@ struct cons_pointer make_lambda( struct cons_pointer args, */ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( NLAMBDATAG ); + struct cons_pointer pointer = allocate_cell( NLAMBDATV ); inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ @@ -309,10 +309,10 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) * pointer to next is NIL. */ struct cons_pointer -make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { +make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { struct cons_pointer pointer = NIL; - if ( check_tag( tail, tag ) || check_tag( tail, NILTAG ) ) { + if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) { pointer = allocate_cell( tag ); struct cons_space_object *cell = &pointer2cell( pointer ); @@ -344,7 +344,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) { * @param tail the string which is being built. */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { - return make_string_like_thing( c, tail, STRINGTAG ); + return make_string_like_thing( c, tail, STRINGTV ); } /** @@ -356,10 +356,10 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { * @param tag the tag to use: expected to be "SYMB" or "KEYW" */ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, - char *tag ) { + uint32_t tag ) { struct cons_pointer result = make_string_like_thing( c, tail, tag ); - if ( strncmp( tag, KEYTAG, 4 ) == 0 ) { + if ( tag == KEYTV ) { struct cons_pointer r = internedp( result, oblist ); if ( nilp( r ) ) { @@ -379,7 +379,7 @@ struct cons_pointer make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) ( struct stack_frame * frame, struct cons_pointer, struct cons_pointer env ) ) { - struct cons_pointer pointer = allocate_cell( SPECIALTAG ); + struct cons_pointer pointer = allocate_cell( SPECIALTV ); struct cons_space_object *cell = &pointer2cell( pointer ); inc_ref( meta ); @@ -397,7 +397,7 @@ make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) */ struct cons_pointer make_read_stream( URL_FILE * input, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( READTAG ); + struct cons_pointer pointer = allocate_cell( READTV ); struct cons_space_object *cell = &pointer2cell( pointer ); cell->payload.stream.stream = input; @@ -414,7 +414,7 @@ struct cons_pointer make_read_stream( URL_FILE * input, */ struct cons_pointer make_write_stream( URL_FILE * output, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( WRITETAG ); + struct cons_pointer pointer = allocate_cell( WRITETV ); struct cons_space_object *cell = &pointer2cell( pointer ); cell->payload.stream.stream = output; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 98a5a24..0efa0a6 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -276,114 +276,114 @@ * true if `conspoint` points to the special cell NIL, else false * (there should only be one of these so it's slightly redundant). */ -#define nilp(conspoint) (check_tag(conspoint,NILTAG)) +#define nilp(conspoint) (check_tag(conspoint,NILTV)) /** * true if `conspoint` points to a cons cell, else false */ -#define consp(conspoint) (check_tag(conspoint,CONSTAG)) +#define consp(conspoint) (check_tag(conspoint,CONSTV)) /** * true if `conspoint` points to an exception, else false */ -#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTAG)) +#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV)) /** * true if `conspoint` points to a function cell, else false */ -#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG)) +#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTV)) /** * true if `conspoint` points to a keyword, else false */ -#define keywordp(conspoint) (check_tag(conspoint,KEYTAG)) +#define keywordp(conspoint) (check_tag(conspoint,KEYTV)) /** * true if `conspoint` points to a Lambda binding cell, else false */ -#define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG)) +#define lambdap(conspoint) (check_tag(conspoint,LAMBDATV)) /** * true if `conspoint` points to a loop exit exception, else false. */ -#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTAG)) +#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTV)) /** * true if `conspoint` points to a special form cell, else false */ -#define specialp(conspoint) (check_tag(conspoint,SPECIALTAG)) +#define specialp(conspoint) (check_tag(conspoint,SPECIALTV)) /** * true if `conspoint` points to a string cell, else false */ -#define stringp(conspoint) (check_tag(conspoint,STRINGTAG)) +#define stringp(conspoint) (check_tag(conspoint,STRINGTV)) /** * true if `conspoint` points to a symbol cell, else false */ -#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG)) +#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTV)) /** * true if `conspoint` points to an integer cell, else false */ -#define integerp(conspoint) (check_tag(conspoint,INTEGERTAG)) +#define integerp(conspoint) (check_tag(conspoint,INTEGERTV)) /** * true if `conspoint` points to a rational number cell, else false */ -#define ratiop(conspoint) (check_tag(conspoint,RATIOTAG)) +#define ratiop(conspoint) (check_tag(conspoint,RATIOTV)) /** * true if `conspoint` points to a read stream cell, else false */ -#define readp(conspoint) (check_tag(conspoint,READTAG)) +#define readp(conspoint) (check_tag(conspoint,READTV)) /** * true if `conspoint` points to a real number cell, else false */ -#define realp(conspoint) (check_tag(conspoint,REALTAG)) +#define realp(conspoint) (check_tag(conspoint,REALTV)) /** * true if `conspoint` points to some sort of a number cell, * else false */ -#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)) +#define numberp(conspoint) (check_tag(conspoint,INTEGERTV)||check_tag(conspoint,RATIOTV)||check_tag(conspoint,REALTV)) /** * true if `conspoint` points to a sequence (list, string or, later, vector), * else false. */ -#define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG)) +#define sequencep(conspoint) (check_tag(conspoint,CONSTV)||check_tag(conspoint,STRINGTV)||check_tag(conspoint,SYMBOLTV)) /** * true if `conspoint` points to a vector pointer, else false. */ -#define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTAG)) +#define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTV)) /** * true if `conspoint` points to a write stream cell, else false. */ -#define writep(conspoint) (check_tag(conspoint,WRITETAG)) +#define writep(conspoint) (check_tag(conspoint,WRITETV)) -#define streamp(conspoint) (check_tag(conspoint,READTAG)||check_tag(conspoint,WRITETAG)) +#define streamp(conspoint) (check_tag(conspoint,READTV)||check_tag(conspoint,WRITETV)) /** * true if `conspoint` points to a true cell, else false * (there should only be one of these so it's slightly redundant). * Also note that anything that is not NIL is truthy. */ -#define tp(conspoint) (check_tag(conspoint,TRUETAG)) +#define tp(conspoint) (check_tag(conspoint,TRUETV)) /** * true if `conspoint` points to a time cell, else false. */ -#define timep(conspoint) (check_tag(conspoint,TIMETAG)) +#define timep(conspoint) (check_tag(conspoint,TIMETV)) /** * true if `conspoint` points to something that is truthy, i.e. * anything but NIL. */ -#define truep(conspoint) (!check_tag(conspoint,NILTAG)) +#define truep(conspoint) (!check_tag(conspoint,NILTV)) /** * An indirect pointer to a cons cell @@ -673,7 +673,7 @@ struct cons_space_object { } payload; }; -bool check_tag( struct cons_pointer pointer, char *tag ); +bool check_tag( struct cons_pointer pointer, uint32_t value ); struct cons_pointer inc_ref( struct cons_pointer pointer ); @@ -716,11 +716,11 @@ struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, - char *tag ); + uint32_t tag ); -#define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTAG)) +#define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTV)) -#define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTAG)) +#define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTV)) struct cons_pointer make_read_stream( URL_FILE * input, struct cons_pointer metadata ); diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 73d3905..ae15461 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -78,17 +78,16 @@ void free_hashmap( struct cons_pointer pointer ) { if ( hashmapp( pointer ) ) { struct vector_space_object *vso = cell->payload.vectorp.address; - struct hashmap_payload payload = vso->payload.hashmap; - dec_ref( payload.hash_fn ); - dec_ref( payload.write_acl ); + dec_ref( vso->payload.hashmap.hash_fn ); + dec_ref( vso->payload.hashmap.write_acl ); - for ( int i = 0; i < payload.n_buckets; i++ ) { - if ( !nilp( payload.buckets[i] ) ) { + for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) { + if ( !nilp( vso->payload.hashmap.buckets[i] ) ) { debug_printf( DEBUG_ALLOC, L"Decrementing bucket [%d] of hashmap at 0x%lx\n", i, cell->payload.vectorp.address ); - dec_ref( payload.buckets[i] ); + dec_ref( vso->payload.hashmap.buckets[i] ); } } } else { @@ -114,7 +113,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn, struct cons_pointer write_acl ) { struct cons_pointer result = - make_vso( HASHTAG, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + + make_vso( HASHTV, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + ( sizeof( uint32_t ) * 2 ) ); struct hashmap_payload *payload = diff --git a/src/memory/stack.c b/src/memory/stack.c index e26bd0e..8b0e610 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -75,7 +75,7 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) { struct cons_pointer make_empty_frame( struct cons_pointer previous ) { debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC ); struct cons_pointer result = - make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) ); + make_vso( STACKFRAMETV, sizeof( struct stack_frame ) ); debug_dump_object( result, DEBUG_ALLOC ); diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index a6e292d..02fd239 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -33,15 +33,15 @@ * * @address the address of the vector_space_object to point to. * @tag the vector-space tag of the particular type of vector-space object, - * NOT `VECTORPOINTTAG`. + * NOT `VECTORPOINTTV`. * * @return a cons_pointer to the object, or NIL if the object could not be * allocated due to memory exhaustion. */ struct cons_pointer make_vec_pointer( struct vector_space_object *address, - char *tag ) { + uint32_t tag ) { debug_print( L"Entered make_vec_pointer\n", DEBUG_ALLOC ); - struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG ); + struct cons_pointer pointer = allocate_cell( VECTORPOINTTV ); struct cons_space_object *cell = &pointer2cell( pointer ); debug_printf( DEBUG_ALLOC, @@ -49,7 +49,7 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address, address ); cell->payload.vectorp.address = address; - strncpy( &cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH ); + cell->payload.vectorp.tag.value = tag; debug_printf( DEBUG_ALLOC, L"make_vec_pointer: all good, returning pointer to %p\n", @@ -71,7 +71,7 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address, * @return a cons_pointer to the object, or NIL if the object could not be * allocated due to memory exhaustion. */ -struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { +struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) { debug_print( L"Entered make_vso\n", DEBUG_ALLOC ); struct cons_pointer result = NIL; int64_t total_size = sizeof( struct vector_space_header ) + payload_size; @@ -87,7 +87,7 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) { debug_printf( DEBUG_ALLOC, L"make_vso: about to write tag '%s' into vso at %p\n", tag, vso ); - strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH ); + vso->header.tag.value = tag; result = make_vec_pointer( vso, tag ); debug_dump_object( result, DEBUG_ALLOC ); vso->header.vecp = result; diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 2c163e8..2eea84d 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -29,7 +29,7 @@ #define HASHTAG "HASH" #define HASHTV 1213415752 -#define hashmapp(conspoint)((check_tag(conspoint,HASHTAG))) +#define hashmapp(conspoint)((check_tag(conspoint,HASHTV))) /* * a namespace (i.e. a binding of names to values, implemented as a hashmap) @@ -39,7 +39,7 @@ #define NAMESPACETAG "NMSP" #define NAMESPACETV 1347636558 -#define namespacep(conspoint)(check_tag(conspoint,NAMESPACETAG)) +#define namespacep(conspoint)(check_tag(conspoint,NAMESPACETV)) /* * a vector of cons pointers. @@ -47,7 +47,7 @@ #define VECTORTAG "VECT" #define VECTORTV 1413694806 -#define vectorp(conspoint)(check_tag(conspoint,VECTORTAG)) +#define vectorp(conspoint)(check_tag(conspoint,VECTORTV)) /** * given a pointer to a vector space object, return the object. @@ -59,7 +59,7 @@ */ #define vso_get_vecp(vso)((((vector_space_object)vso)->header.vecp)) -struct cons_pointer make_vso( char *tag, uint64_t payload_size ); +struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ); void free_vso(struct cons_pointer pointer); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 0c495f9..474784d 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -920,7 +920,7 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) { case SYMBOLTV: result = make_symbol_or_key( o.payload.string.character, result, - SYMBOLTAG ); + SYMBOLTV ); break; } } diff --git a/src/time/psse_time.c b/src/time/psse_time.c index 76f52a9..e37e522 100644 --- a/src/time/psse_time.c +++ b/src/time/psse_time.c @@ -56,7 +56,7 @@ unsigned __int128 unix_time_to_lisp_time( time_t t) { } struct cons_pointer make_time( struct cons_pointer integer_or_nil) { - struct cons_pointer pointer = allocate_cell( TIMETAG ); + struct cons_pointer pointer = allocate_cell( TIMETV ); struct cons_space_object *cell = &pointer2cell( pointer ); if (integerp(integer_or_nil)) { diff --git a/unit-tests/lambda.sh b/unit-tests/lambda.sh index b7f1707..9695e6c 100755 --- a/unit-tests/lambda.sh +++ b/unit-tests/lambda.sh @@ -1,6 +1,6 @@ #!/bin/bash -expected='(lambda (l) l) (1 2 3 4 5 6 7 8 9 10)' +expected=' (1 2 3 4 5 6 7 8 9 10)' output=`target/psse 2>/dev/null < Date: Tue, 17 Aug 2021 16:37:04 +0100 Subject: [PATCH 12/90] Restandardised formatting. --- src/arith/integer.c | 85 +- src/arith/integer.h | 18 +- src/arith/peano.c | 49 +- src/arith/peano.h | 2 +- src/arith/ratio.c | 80 +- src/arith/ratio.h | 2 +- src/authorise.c | 8 +- src/authorise.h | 5 +- src/init.c | 57 +- src/io/fopen.c | 2 +- src/io/io.c | 36 +- src/io/print.c | 88 +- src/io/read.c | 83 +- src/memory/conspage.c | 2 +- src/memory/consspaceobject.c | 142 ++- src/memory/consspaceobject.h | 2 +- src/memory/dump.c | 207 ++--- src/memory/hashmap.c | 369 ++++---- src/memory/hashmap.h | 6 +- src/memory/lookup3.c | 1594 ++++++++++++++++++++-------------- src/memory/lookup3.h | 5 +- src/memory/vectorspace.c | 28 +- src/memory/vectorspace.h | 24 +- src/ops/equal.c | 169 ++-- src/ops/intern.c | 45 +- src/ops/lispops.c | 295 +++---- src/ops/lispops.h | 4 +- src/time/psse_time.c | 51 +- src/time/psse_time.h | 7 +- 29 files changed, 1861 insertions(+), 1604 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index 5f47532..db486d2 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -218,18 +218,19 @@ struct cons_pointer base_partial( int depth ) { /** * destructively modify this `partial` by appending this `digit`. */ -struct cons_pointer append_digit( struct cons_pointer partial, struct cons_pointer digit) { +struct cons_pointer append_digit( struct cons_pointer partial, + struct cons_pointer digit ) { struct cons_pointer c = partial; struct cons_pointer result = partial; - if (nilp( partial)) { + if ( nilp( partial ) ) { result = digit; } else { - while ( !nilp( pointer2cell(c).payload.integer.more)) { - c = pointer2cell(c).payload.integer.more; + while ( !nilp( pointer2cell( c ).payload.integer.more ) ) { + c = pointer2cell( c ).payload.integer.more; } - (&pointer2cell(c))->payload.integer.more = digit; + ( &pointer2cell( c ) )->payload.integer.more = digit; } return result; } @@ -248,8 +249,8 @@ struct cons_pointer append_digit( struct cons_pointer partial, struct cons_point * @param b an integer. */ struct cons_pointer multiply_integers( struct cons_pointer a, - struct cons_pointer b ) { - struct cons_pointer result = make_integer( 0, NIL); + struct cons_pointer b ) { + struct cons_pointer result = make_integer( 0, NIL ); bool neg = is_negative( a ) != is_negative( b ); bool is_first_b = true; int i = 0; @@ -264,7 +265,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* for each digit in a, starting with the least significant (ai) */ for ( struct cons_pointer ai = a; !nilp( ai ); - ai = pointer2cell(ai).payload.integer.more) { + ai = pointer2cell( ai ).payload.integer.more ) { /* set carry to 0 */ __int128_t carry = 0; @@ -274,41 +275,41 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* for each digit in b, starting with the least significant (bj) */ for ( struct cons_pointer bj = b; !nilp( bj ); - bj = pointer2cell(bj).payload.integer.more) { + bj = pointer2cell( bj ).payload.integer.more ) { debug_printf( DEBUG_ARITH, - L"multiply_integers: a[i] = %Ld, b[j] = %Ld, i = %d\n", - pointer2cell(ai).payload.integer.value, - pointer2cell(bj).payload.integer.value, i); + L"multiply_integers: a[i] = %Ld, b[j] = %Ld, i = %d\n", + pointer2cell( ai ).payload.integer.value, + pointer2cell( bj ).payload.integer.value, i ); /* multiply ai with bj and add the carry, resulting in a * value xj which may exceed one digit */ - __int128_t xj = pointer2cell(ai).payload.integer.value * - pointer2cell(bj).payload.integer.value; + __int128_t xj = pointer2cell( ai ).payload.integer.value * + pointer2cell( bj ).payload.integer.value; xj += carry; /* if xj exceeds one digit, break it into the digit dj and * the carry */ carry = xj >> 60; - struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL); + struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL ); /* destructively modify ri by appending dj */ - ri = append_digit( ri, dj); - } /* end for bj */ + ri = append_digit( ri, dj ); + } /* end for bj */ /* if carry is not equal to zero, append it as a final digit * to ri */ - if (carry != 0) { - ri = append_digit( ri, make_integer( carry, NIL)); + if ( carry != 0 ) { + ri = append_digit( ri, make_integer( carry, NIL ) ); } /* add ri to result */ - result = add_integers( result, ri); + result = add_integers( result, ri ); debug_print( L"multiply_integers: result is ", DEBUG_ARITH ); debug_print_object( result, DEBUG_ARITH ); debug_println( DEBUG_ARITH ); - } /* end for ai */ + } /* end for ai */ } debug_print( L"multiply_integers returning: ", DEBUG_ARITH ); @@ -342,13 +343,16 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits, * to be looking to the next. H'mmmm. */ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, - int base ) { + int base ) { struct cons_pointer result = NIL; if ( integerp( int_pointer ) ) { - struct cons_pointer next = pointer2cell( int_pointer ).payload.integer.more; - __int128_t accumulator = llabs( pointer2cell( int_pointer ).payload.integer.value ); - bool is_negative = pointer2cell( int_pointer ).payload.integer.value < 0; + struct cons_pointer next = + pointer2cell( int_pointer ).payload.integer.more; + __int128_t accumulator = + llabs( pointer2cell( int_pointer ).payload.integer.value ); + bool is_negative = + pointer2cell( int_pointer ).payload.integer.value < 0; int digits = 0; if ( accumulator == 0 && nilp( next ) ) { @@ -356,13 +360,14 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, } else { while ( accumulator > 0 || !nilp( next ) ) { if ( accumulator < MAX_INTEGER && !nilp( next ) ) { - accumulator += (pointer2cell(next).payload.integer.value << 60); - next = pointer2cell(next).payload.integer.more; + accumulator += + ( pointer2cell( next ).payload.integer.value << 60 ); + next = pointer2cell( next ).payload.integer.more; } int offset = ( int ) ( accumulator % base ); debug_printf( DEBUG_IO, - L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ", - offset, hex_digits[offset] ); + L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ", + offset, hex_digits[offset] ); debug_print_128bit( accumulator, DEBUG_IO ); debug_print( L"; result is: ", DEBUG_IO ); debug_print_object( result, DEBUG_IO ); @@ -374,7 +379,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, } if ( stringp( result ) - && pointer2cell( result ).payload.string.character == L',' ) { + && pointer2cell( result ).payload.string.character == L',' ) { /* if the number of digits in the string is divisible by 3, there will be * an unwanted comma on the front. */ result = pointer2cell( result ).payload.string.cdr; @@ -393,14 +398,15 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer, /** * true if a and be are both integers whose value is the same value. */ -bool equal_integer_integer(struct cons_pointer a, struct cons_pointer b) { +bool equal_integer_integer( struct cons_pointer a, struct cons_pointer b ) { bool result = false; - if (integerp(a) && integerp(b)){ + if ( integerp( a ) && integerp( b ) ) { struct cons_space_object *cell_a = &pointer2cell( a ); struct cons_space_object *cell_b = &pointer2cell( b ); - result = cell_a->payload.integer.value == cell_b->payload.integer.value; + result = + cell_a->payload.integer.value == cell_b->payload.integer.value; } return result; @@ -410,17 +416,16 @@ bool equal_integer_integer(struct cons_pointer a, struct cons_pointer b) { * true if `a` is an integer, and `b` is a real number whose value is the * value of that integer. */ -bool equal_integer_real(struct cons_pointer a, struct cons_pointer b) { +bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) { bool result = false; - if (integerp(a) && realp(b)) - { - long double bv = pointer2cell(b).payload.real.value; + if ( integerp( a ) && realp( b ) ) { + long double bv = pointer2cell( b ).payload.real.value; - if (floor(bv) == bv) { - result = pointer2cell(a).payload.integer.value == (int64_t)bv; + if ( floor( bv ) == bv ) { + result = pointer2cell( a ).payload.integer.value == ( int64_t ) bv; } } return result; -} \ No newline at end of file +} diff --git a/src/arith/integer.h b/src/arith/integer.h index 4ce58d5..09a7a83 100644 --- a/src/arith/integer.h +++ b/src/arith/integer.h @@ -14,19 +14,19 @@ #include #include -struct cons_pointer make_integer(int64_t value, struct cons_pointer more); +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 add_integers( struct cons_pointer a, + struct cons_pointer b ); -struct cons_pointer multiply_integers(struct cons_pointer a, - struct cons_pointer b); +struct cons_pointer multiply_integers( struct cons_pointer a, + struct cons_pointer b ); -struct cons_pointer integer_to_string(struct cons_pointer int_pointer, - int base); +struct cons_pointer integer_to_string( struct cons_pointer int_pointer, + int base ); -bool equal_integer_integer(struct cons_pointer a, struct cons_pointer b); +bool equal_integer_integer( struct cons_pointer a, struct cons_pointer b ); -bool equal_integer_real(struct cons_pointer a, struct cons_pointer b); +bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ); #endif diff --git a/src/arith/peano.c b/src/arith/peano.c index 8fe63fb..5589f1f 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -247,8 +247,7 @@ struct cons_pointer add_2( struct stack_frame *frame, result = add_integers( arg1, arg2 ); break; case RATIOTV: - result = - add_integer_ratio( arg1, arg2 ); + result = add_integer_ratio( arg1, arg2 ); break; case REALTV: result = @@ -268,8 +267,7 @@ struct cons_pointer add_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV: - result = - add_integer_ratio( arg2, arg1 ); + result = add_integer_ratio( arg2, arg1 ); break; case RATIOTV: result = add_ratio_ratio( arg1, arg2 ); @@ -380,9 +378,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame, result = multiply_integers( arg1, arg2 ); break; case RATIOTV: - result = - multiply_integer_ratio( arg1, - arg2 ); + result = multiply_integer_ratio( arg1, arg2 ); break; case REALTV: result = @@ -405,13 +401,10 @@ struct cons_pointer multiply_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV: - result = - multiply_integer_ratio( arg2, - arg1 ); + result = multiply_integer_ratio( arg2, arg1 ); break; case RATIOTV: - result = - multiply_ratio_ratio( arg1, arg2 ); + result = multiply_ratio_ratio( arg1, arg2 ); break; case REALTV: result = @@ -564,20 +557,18 @@ struct cons_pointer subtract_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV:{ - struct cons_pointer i = - negative( arg2 ); + struct cons_pointer i = negative( arg2 ); inc_ref( i ); result = add_integers( arg1, i ); dec_ref( i ); } break; case RATIOTV:{ - struct cons_pointer tmp = - make_ratio( arg1, - make_integer( 1, NIL ) ); + struct cons_pointer tmp = make_ratio( arg1, + make_integer( 1, + NIL ) ); inc_ref( tmp ); - result = - subtract_ratio_ratio( tmp, arg2 ); + result = subtract_ratio_ratio( tmp, arg2 ); dec_ref( tmp ); } break; @@ -599,12 +590,11 @@ struct cons_pointer subtract_2( struct stack_frame *frame, result = arg2; break; case INTEGERTV:{ - struct cons_pointer tmp = - make_ratio( arg2, - make_integer( 1, NIL ) ); + struct cons_pointer tmp = make_ratio( arg2, + make_integer( 1, + NIL ) ); inc_ref( tmp ); - result = - subtract_ratio_ratio( arg1, tmp ); + result = subtract_ratio_ratio( arg1, tmp ); dec_ref( tmp ); } break; @@ -696,9 +686,7 @@ struct cons_pointer lisp_divide( struct struct cons_pointer ratio = make_ratio( frame->arg[0], one ); inc_ref( ratio ); - result = - divide_ratio_ratio( ratio, - frame->arg[1] ); + result = divide_ratio_ratio( ratio, frame->arg[1] ); dec_ref( ratio ); } break; @@ -725,17 +713,14 @@ struct cons_pointer lisp_divide( struct struct cons_pointer ratio = make_ratio( frame->arg[1], one ); inc_ref( ratio ); - result = - divide_ratio_ratio( frame->arg[0], - ratio ); + result = divide_ratio_ratio( frame->arg[0], ratio ); dec_ref( ratio ); dec_ref( one ); } break; case RATIOTV: result = - divide_ratio_ratio( frame->arg[0], - frame->arg[1] ); + divide_ratio_ratio( frame->arg[0], frame->arg[1] ); break; case REALTV: result = diff --git a/src/arith/peano.h b/src/arith/peano.h index 9bcd9e4..3076391 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -27,7 +27,7 @@ struct cons_pointer absolute( struct cons_pointer arg ); long double to_long_double( struct cons_pointer arg ); -int64_t to_long_int( struct cons_pointer arg ) ; +int64_t to_long_int( struct cons_pointer arg ); struct cons_pointer lisp_absolute( struct stack_frame *frame, struct cons_pointer frame_pointer, struct diff --git a/src/arith/ratio.c b/src/arith/ratio.c index f4c8056..8100ec2 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -43,42 +43,36 @@ int64_t least_common_multiple( int64_t m, int64_t n ) { return m / greatest_common_divisor( m, n ) * n; } -struct cons_pointer simplify_ratio( struct cons_pointer pointer) { +struct cons_pointer simplify_ratio( struct cons_pointer pointer ) { struct cons_pointer result = pointer; - struct cons_space_object cell = pointer2cell(pointer); - struct cons_space_object dividend = pointer2cell(cell.payload.ratio.dividend); - struct cons_space_object divisor = pointer2cell(cell.payload.ratio.divisor); + struct cons_space_object cell = pointer2cell( pointer ); + struct cons_space_object dividend = + pointer2cell( cell.payload.ratio.dividend ); + struct cons_space_object divisor = + pointer2cell( cell.payload.ratio.divisor ); - if (divisor.payload.integer.value == 1) - { - result = pointer2cell(pointer).payload.ratio.dividend; - } - else - { - if (ratiop(pointer)) - { + if ( divisor.payload.integer.value == 1 ) { + result = pointer2cell( pointer ).payload.ratio.dividend; + } else { + if ( ratiop( pointer ) ) { int64_t ddrv = dividend.payload.integer.value, - drrv = divisor.payload.integer.value, - gcd = greatest_common_divisor(ddrv, drrv); + drrv = divisor.payload.integer.value, + gcd = greatest_common_divisor( ddrv, drrv ); - if (gcd > 1) - { - if (drrv / gcd == 1) - { - result = make_integer(ddrv / gcd, NIL); - } - else - { + if ( gcd > 1 ) { + if ( drrv / gcd == 1 ) { + result = make_integer( ddrv / gcd, NIL ); + } else { result = - make_ratio(make_integer(ddrv / gcd, NIL), - make_integer(drrv / gcd, NIL)); + make_ratio( make_integer( ddrv / gcd, NIL ), + make_integer( drrv / gcd, NIL ) ); } } } } return result; - + } @@ -181,8 +175,7 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, ( L"Shouldn't happen: bad arg to add_integer_ratio" ), make_cons( intarg, make_cons( ratarg, - NIL ) ) ), - NIL ); + NIL ) ) ), NIL ); } return result; @@ -196,11 +189,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - // TODO: this now has to work if `arg1` is an integer - struct cons_pointer i = make_ratio( pointer2cell( arg2 ).payload. - ratio.divisor, - pointer2cell( arg2 ).payload. - ratio.dividend ), result = + // TODO: this now has to work if `arg1` is an integer + struct cons_pointer i = + make_ratio( pointer2cell( arg2 ).payload.ratio.divisor, + pointer2cell( arg2 ).payload.ratio.dividend ), result = multiply_ratio_ratio( arg1, i ); dec_ref( i ); @@ -217,7 +209,7 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1, struct cons_pointer multiply_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - // TODO: this now has to work if arg1 is an integer + // TODO: this now has to work if arg1 is an integer struct cons_pointer result; debug_print( L"multiply_ratio_ratio( arg1 = ", DEBUG_ARITH ); @@ -294,7 +286,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg, */ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer arg2 ) { - struct cons_pointer i = negative( arg2), + struct cons_pointer i = negative( arg2 ), result = add_ratio_ratio( arg1, i ); dec_ref( i ); @@ -333,20 +325,18 @@ struct cons_pointer make_ratio( struct cons_pointer dividend, /** * True if a and be are identical ratios, else false. */ -bool equal_ratio_ratio(struct cons_pointer a, struct cons_pointer b) -{ +bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) { bool result = false; - if (ratiop(a) && ratiop(b)) - { - struct cons_space_object *cell_a = &pointer2cell(a); - struct cons_space_object *cell_b = &pointer2cell(b); + if ( ratiop( a ) && ratiop( b ) ) { + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); - result = equal_integer_integer(cell_a->payload.ratio.dividend, - cell_b->payload.ratio.dividend) && - equal_integer_integer(cell_a->payload.ratio.divisor, - cell_b->payload.ratio.divisor); + result = equal_integer_integer( cell_a->payload.ratio.dividend, + cell_b->payload.ratio.dividend ) && + equal_integer_integer( cell_a->payload.ratio.divisor, + cell_b->payload.ratio.divisor ); } return result; -} \ No newline at end of file +} diff --git a/src/arith/ratio.h b/src/arith/ratio.h index d440530..9068bfb 100644 --- a/src/arith/ratio.h +++ b/src/arith/ratio.h @@ -34,6 +34,6 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1, struct cons_pointer make_ratio( struct cons_pointer dividend, struct cons_pointer divisor ); -bool equal_ratio_ratio(struct cons_pointer a, struct cons_pointer b); +bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ); #endif diff --git a/src/authorise.c b/src/authorise.c index 5574db9..afd730d 100644 --- a/src/authorise.c +++ b/src/authorise.c @@ -15,10 +15,10 @@ * TODO: does nothing, yet. What it should do is access a magic value in the * runtime environment and check that it is identical to something on this `acl` */ -struct cons_pointer authorised(struct cons_pointer target, struct cons_pointer acl) { - if (nilp(acl)) { - acl = pointer2cell(target).access; +struct cons_pointer authorised( struct cons_pointer target, + struct cons_pointer acl ) { + if ( nilp( acl ) ) { + acl = pointer2cell( target ).access; } return TRUE; } - diff --git a/src/authorise.h b/src/authorise.h index c67977d..6c55b32 100644 --- a/src/authorise.h +++ b/src/authorise.h @@ -10,6 +10,7 @@ #ifndef __psse_authorise_h #define __psse_authorise_h -struct cons_pointer authorised(struct cons_pointer target, struct cons_pointer acl); +struct cons_pointer authorised( struct cons_pointer target, + struct cons_pointer acl ); -#endif \ No newline at end of file +#endif diff --git a/src/init.c b/src/init.c index 4126783..ca48b9d 100644 --- a/src/init.c +++ b/src/init.c @@ -84,8 +84,9 @@ void bind_value( wchar_t *name, struct cons_pointer value ) { dec_ref( n ); } -void print_banner() { - fwprintf(stdout, L"Post-Scarcity Software Environment version %s\n\n", VERSION); +void print_banner( ) { + fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n", + VERSION ); } /** @@ -93,22 +94,24 @@ void print_banner() { * * @stream the stream to print to. */ -void print_options(FILE* stream) { - fwprintf(stream, L"Expected options are:\n"); - fwprintf(stream, L"\t-d\tDump memory to standard out at end of run (copious!);\n"); - fwprintf(stream, L"\t-h\tPrint this message and exit;\n"); - fwprintf(stream, L"\t-p\tShow a prompt (default is no prompt);\n"); - fwprintf(stream, L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n"); - fwprintf(stream, L"\t\tWhere bits are interpreted as follows:\n"); - fwprintf(stream, L"\t\t1\tALLOC;\n"); - fwprintf(stream, L"\t\t2\tARITH;\n"); - fwprintf(stream, L"\t\t4\tBIND;\n"); - fwprintf(stream, L"\t\t8\tBOOTSTRAP;\n"); - fwprintf(stream, L"\t\t16\tEVAL;\n"); - fwprintf(stream, L"\t\t32\tINPUT/OUTPUT;\n"); - fwprintf(stream, L"\t\t64\tLAMBDA;\n"); - fwprintf(stream, L"\t\t128\tREPL;\n"); - fwprintf(stream, L"\t\t256\tSTACK.\n"); +void print_options( FILE * stream ) { + fwprintf( stream, L"Expected options are:\n" ); + fwprintf( stream, + L"\t-d\tDump memory to standard out at end of run (copious!);\n" ); + fwprintf( stream, L"\t-h\tPrint this message and exit;\n" ); + fwprintf( stream, L"\t-p\tShow a prompt (default is no prompt);\n" ); + fwprintf( stream, + L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" ); + fwprintf( stream, L"\t\tWhere bits are interpreted as follows:\n" ); + fwprintf( stream, L"\t\t1\tALLOC;\n" ); + fwprintf( stream, L"\t\t2\tARITH;\n" ); + fwprintf( stream, L"\t\t4\tBIND;\n" ); + fwprintf( stream, L"\t\t8\tBOOTSTRAP;\n" ); + fwprintf( stream, L"\t\t16\tEVAL;\n" ); + fwprintf( stream, L"\t\t32\tINPUT/OUTPUT;\n" ); + fwprintf( stream, L"\t\t64\tLAMBDA;\n" ); + fwprintf( stream, L"\t\t128\tREPL;\n" ); + fwprintf( stream, L"\t\t256\tSTACK.\n" ); } /** @@ -132,8 +135,8 @@ int main( int argc, char *argv[] ) { dump_at_end = true; break; case 'h': - print_banner(); - print_options(stdout); + print_banner( ); + print_options( stdout ); exit( 0 ); break; case 'p': @@ -144,14 +147,14 @@ int main( int argc, char *argv[] ) { break; default: fwprintf( stderr, L"Unexpected option %c\n", option ); - print_options(stderr); + print_options( stderr ); exit( 1 ); break; } } if ( show_prompt ) { - print_banner(); + print_banner( ); } debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP ); @@ -225,10 +228,10 @@ int main( int argc, char *argv[] ) { bind_function( L"equal", &lisp_equal ); bind_function( L"eval", &lisp_eval ); bind_function( L"exception", &lisp_exception ); - bind_function( L"get-hash", &lisp_get_hash); - bind_function(L"hashmap", lisp_make_hashmap); + bind_function( L"get-hash", &lisp_get_hash ); + bind_function( L"hashmap", lisp_make_hashmap ); bind_function( L"inspect", &lisp_inspect ); - bind_function( L"keys", &lisp_keys); + bind_function( L"keys", &lisp_keys ); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); bind_function( L"multiply", &lisp_multiply ); @@ -237,8 +240,8 @@ int main( int argc, char *argv[] ) { bind_function( L"open", &lisp_open ); bind_function( L"print", &lisp_print ); bind_function( L"progn", &lisp_progn ); - bind_function( L"put", lisp_hashmap_put); - bind_function( L"put-all", &lisp_hashmap_put_all); + bind_function( L"put", lisp_hashmap_put ); + bind_function( L"put-all", &lisp_hashmap_put_all ); bind_function( L"read", &lisp_read ); bind_function( L"read-char", &lisp_read_char ); bind_function( L"repl", &lisp_repl ); diff --git a/src/io/fopen.c b/src/io/fopen.c index d3ece5c..3a66806 100644 --- a/src/io/fopen.c +++ b/src/io/fopen.c @@ -213,7 +213,7 @@ URL_FILE *url_fopen( const char *url, const char *operation ) { file->handle.file = fopen( url, operation ); if ( file->handle.file ) { file->type = CFTYPE_FILE; /* marked as file */ - } else if ( index_of(':', url ) > -1 ) { + } else if ( index_of( ':', url ) > -1 ) { file->type = CFTYPE_CURL; /* marked as URL */ file->handle.curl = curl_easy_init( ); diff --git a/src/io/io.c b/src/io/io.c index 9976373..f621539 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -265,7 +265,7 @@ struct cons_pointer add_meta_integer( struct cons_pointer meta, wchar_t *key, struct cons_pointer add_meta_string( struct cons_pointer meta, wchar_t *key, char *value ) { - value = trim( value); + value = trim( value ); wchar_t buffer[strlen( value ) + 1]; mbstowcs( buffer, value, strlen( value ) + 1 ); @@ -280,9 +280,8 @@ struct cons_pointer add_meta_time( struct cons_pointer meta, wchar_t *key, char datestring[256]; strftime( datestring, - sizeof( datestring ), - nl_langinfo( D_T_FMT ), - localtime( value ) ); + sizeof( datestring ), + nl_langinfo( D_T_FMT ), localtime( value ) ); return add_meta_string( meta, key, datestring ); } @@ -391,7 +390,7 @@ void collect_meta( struct cons_pointer stream, char *url ) { } /* this is destructive change before the cell is released into the - * wild, and consequently permissible, just. */ + * wild, and consequently permissible, just. */ cell->payload.stream.meta = meta; } @@ -441,20 +440,23 @@ lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE *stream = url_fopen( url, "r" ); debug_printf( DEBUG_IO, - L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n", - (long int) &stream, (int)stream->type, (long int)stream->handle.file); + L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n", + ( long int ) &stream, ( int ) stream->type, + ( long int ) stream->handle.file ); - switch (stream->type) { + switch ( stream->type ) { case CFTYPE_NONE: - return make_exception( - c_string_to_lisp_string( L"Could not open stream"), - frame_pointer); + return + make_exception( c_string_to_lisp_string + ( L"Could not open stream" ), + frame_pointer ); break; case CFTYPE_FILE: - if (stream->handle.file == NULL) { - return make_exception( - c_string_to_lisp_string( L"Could not open file"), - frame_pointer); + if ( stream->handle.file == NULL ) { + return + make_exception( c_string_to_lisp_string + ( L"Could not open file" ), + frame_pointer ); } break; case CFTYPE_CURL: @@ -501,8 +503,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( frame->arg[0] ) ) { result = make_string( url_fgetwc - ( pointer2cell( frame->arg[0] ).payload. - stream.stream ), NIL ); + ( pointer2cell( frame->arg[0] ).payload.stream. + stream ), NIL ); } return result; diff --git a/src/io/print.c b/src/io/print.c index 3f33252..64d7b37 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -88,38 +88,38 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) { url_fputws( L")", output ); } -void print_map( URL_FILE *output, struct cons_pointer map ) { - if ( hashmapp( map ) ) { - struct vector_space_object *vso = pointer_to_vso( map ); +void print_map( URL_FILE * output, struct cons_pointer map ) { + if ( hashmapp( map ) ) { + struct vector_space_object *vso = pointer_to_vso( map ); - url_fputwc( btowc( '{' ), output ); + url_fputwc( btowc( '{' ), output ); - for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); - ks = c_cdr( ks ) ) { - struct cons_pointer key = c_car( ks); - print( output, key ); - url_fputwc( btowc( ' ' ), output ); - print( output, hashmap_get( map, key ) ); + for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); + ks = c_cdr( ks ) ) { + struct cons_pointer key = c_car( ks ); + print( output, key ); + url_fputwc( btowc( ' ' ), output ); + print( output, hashmap_get( map, key ) ); - if ( !nilp( c_cdr( ks ) ) ) { - url_fputws( L", ", output ); - } + if ( !nilp( c_cdr( ks ) ) ) { + url_fputws( L", ", output ); + } + } + + url_fputwc( btowc( '}' ), output ); } - - url_fputwc( btowc( '}' ), output ); - } } -void print_vso( URL_FILE * output, struct cons_pointer pointer) { - struct vector_space_object *vso = pointer_to_vso(pointer); - switch ( vso->header.tag.value) { +void print_vso( URL_FILE * output, struct cons_pointer pointer ) { + struct vector_space_object *vso = pointer_to_vso( pointer ); + switch ( vso->header.tag.value ) { case HASHTV: - print_map( output, pointer); + print_map( output, pointer ); break; - // \todo: others. + // \todo: others. default: - fwprintf( stderr, L"Unrecognised vector-space type '%d'\n", - vso->header.tag.value ); + fwprintf( stderr, L"Unrecognised vector-space type '%d'\n", + vso->header.tag.value ); } } @@ -130,14 +130,14 @@ void print_128bit( URL_FILE * output, __int128_t n ) { if ( n == 0 ) { fwprintf( stderr, L"0" ); } else { - char str[40] = { 0 }; // log10(1 << 128) + '\0' + char str[40] = { 0 }; // log10(1 << 128) + '\0' char *s = str + sizeof( str ) - 1; // start at the end while ( n != 0 ) { if ( s == str ) - return; // never happens + return; // never happens *--s = "0123456789"[n % 10]; // save last digit - n /= 10; // drop it + n /= 10; // drop it } url_fwprintf( output, L"%s", s ); } @@ -165,9 +165,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { dump_stack_trace( output, pointer ); break; case FUNCTIONTV: - url_fputws( L"', output); + url_fputws( L"', output ); break; case INTEGERTV:{ struct cons_pointer s = integer_to_string( pointer, 10 ); @@ -181,7 +181,7 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_string_contents( output, pointer ); break; case LAMBDATV:{ - url_fputws( L"', output); + url_fputwc( L'>', output ); } break; case NILTV: url_fwprintf( output, L"nil" ); break; case NLAMBDATV:{ - url_fputws( L"', output); + url_fputwc( L'>', output ); } break; case RATIOTV: @@ -218,8 +218,8 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { break; case READTV: url_fwprintf( output, L"', output); + print( output, cell.payload.stream.meta ); + url_fputwc( L'>', output ); break; case REALTV: /* \todo using the C heap is a bad plan because it will fragment. @@ -245,26 +245,26 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { break; case SPECIALTV: url_fwprintf( output, L"', output); + print( output, cell.payload.special.meta ); + url_fputwc( L'>', output ); break; case TIMETV: url_fwprintf( output, L"', output); + print_string( output, time_to_string( pointer ) ); + url_fputws( L"; ", output ); + print_128bit( output, pointer2cell( pointer ).payload.time.value ); + url_fputwc( L'>', output ); break; case TRUETV: url_fwprintf( output, L"t" ); break; case VECTORPOINTTV: - print_vso( output, pointer); + print_vso( output, pointer ); break; case WRITETV: url_fwprintf( output, L"', output); + print( output, cell.payload.stream.meta ); + url_fputwc( L'>', output ); break; default: fwprintf( stderr, diff --git a/src/io/read.c b/src/io/read.c index 2395cbc..9c87932 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -46,8 +46,8 @@ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE * input, wint_t initial ); struct cons_pointer read_map( struct stack_frame *frame, - struct cons_pointer frame_pointer, - URL_FILE * input, wint_t initial ); + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, wint_t initial ); @@ -106,7 +106,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, break; case '{': result = read_map( frame, frame_pointer, input, - url_fgetwc( input ) ); + url_fgetwc( input ) ); break; case '"': result = read_string( input, url_fgetwc( input ) ); @@ -134,10 +134,12 @@ struct cons_pointer read_continuation( struct stack_frame *frame, } else if ( iswblank( next ) ) { /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ - result = read_continuation( frame, frame_pointer, input, + result = + read_continuation( frame, frame_pointer, input, url_fgetwc( input ) ); - debug_print( L"read_continuation: dotted pair; read cdr ", - DEBUG_IO); + debug_print + ( L"read_continuation: dotted pair; read cdr ", + DEBUG_IO ); } else { read_symbol_or_key( input, SYMBOLTV, c ); } @@ -284,37 +286,34 @@ struct cons_pointer read_number( struct stack_frame *frame, * left parenthesis. */ struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, - URL_FILE * input, wint_t initial ) { + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ) { struct cons_pointer result = NIL; wint_t c; if ( initial != ')' ) { debug_printf( DEBUG_IO, - L"read_list starting '%C' (%d)\n", initial, initial ); + L"read_list starting '%C' (%d)\n", initial, initial ); struct cons_pointer car = read_continuation( frame, frame_pointer, input, - initial ); + initial ); /* skip whitespace */ - for (c = url_fgetwc( input ); - iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input )); + for ( c = url_fgetwc( input ); + iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) ); - if ( c == L'.') { + if ( c == L'.' ) { /* 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. */ result = make_cons( car, - c_car( read_list( frame, - frame_pointer, - input, - url_fgetwc( input ) ) ) ); + c_car( read_list( frame, + frame_pointer, + input, url_fgetwc( input ) ) ) ); } else { result = - make_cons( car, - read_list( frame, frame_pointer, input, c ) ); + make_cons( car, read_list( frame, frame_pointer, input, c ) ); } } else { debug_print( L"End of list detected\n", DEBUG_IO ); @@ -325,35 +324,35 @@ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, - URL_FILE *input, wint_t initial ) { - // set write ACL to true whilst creating to prevent GC churn - struct cons_pointer result = make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE ); - wint_t c = initial; + URL_FILE * input, wint_t initial ) { + // set write ACL to true whilst creating to prevent GC churn + struct cons_pointer result = + make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE ); + wint_t c = initial; - while ( c != L'}' ) { - struct cons_pointer key = - read_continuation( frame, frame_pointer, input, c ); + while ( c != L'}' ) { + struct cons_pointer key = + read_continuation( frame, frame_pointer, input, c ); - /* skip whitespace */ - for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input ) ) - ; + /* skip whitespace */ + for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ); - struct cons_pointer value = - read_continuation( frame, frame_pointer, input, c ); + struct cons_pointer value = + read_continuation( frame, frame_pointer, input, c ); - /* skip commaa and whitespace at this point. */ - for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input ) ) - ; + /* skip commaa and whitespace at this point. */ + for ( c = url_fgetwc( input ); + c == L',' || iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ); - result = hashmap_put( result, key, value ); - } + result = hashmap_put( result, key, value ); + } - // default write ACL for maps should be NIL. - pointer_to_vso( result )->payload.hashmap.write_acl = NIL; + // default write ACL for maps should be NIL. + pointer_to_vso( result )->payload.hashmap.write_acl = NIL; - return result; + return result; } /** diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 0b4bf7d..d8d54f9 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -179,7 +179,7 @@ void free_cell( struct cons_pointer pointer ) { dec_ref( cell->payload.string.cdr ); break; case VECTORPOINTTV: - free_vso( pointer); + free_vso( pointer ); break; } diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 32c777f..5b04699 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -33,22 +33,22 @@ * vectorspace object indicated by the cell is this `value`, else false. */ bool check_tag( struct cons_pointer pointer, uint32_t value ) { - bool result = false; + bool result = false; - struct cons_space_object cell = pointer2cell( pointer ); - result = cell.tag.value == value; + struct cons_space_object cell = pointer2cell( pointer ); + result = cell.tag.value == value; - if ( result == false ) { - if ( cell.tag.value == VECTORPOINTTV ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( result == false ) { + if ( cell.tag.value == VECTORPOINTTV ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - if ( vec != NULL ) { - result = vec->header.tag.value == value; - } + if ( vec != NULL ) { + result = vec->header.tag.value == value; + } + } } - } - return result; + return result; } /** @@ -99,22 +99,24 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) { * @return As a Lisp string, the tag of the object which is at that pointer. */ struct cons_pointer c_type( struct cons_pointer pointer ) { - struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( pointer ); - if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == + 0 ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( (wchar_t)vec->header.tag.bytes[i], result ); + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = + make_string( ( wchar_t ) vec->header.tag.bytes[i], result ); + } + } else { + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( ( wchar_t ) cell.tag.bytes[i], result ); + } } - } else { - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( (wchar_t)cell.tag.bytes[i], result ); - } - } - return result; + return result; } /** @@ -122,13 +124,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { * authorised to read it, does not error but returns nil. */ struct cons_pointer c_car( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { - result = pointer2cell( arg ).payload.cons.car; - } + if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.car; + } - return result; + return result; } /** @@ -136,34 +138,34 @@ struct cons_pointer c_car( struct cons_pointer arg ) { * not authorised to read it,does not error but returns nil. */ struct cons_pointer c_cdr( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) ) { - struct cons_space_object *cell = &pointer2cell( arg ); + if ( truep( authorised( arg, NIL ) ) ) { + struct cons_space_object *cell = &pointer2cell( arg ); - switch ( cell->tag.value ) { - case CONSTV: - result = cell->payload.cons.cdr; - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - result = cell->payload.string.cdr; - break; + switch ( cell->tag.value ) { + case CONSTV: + result = cell->payload.cons.cdr; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = cell->payload.string.cdr; + break; + } } - } - return result; + return result; } /** * Implementation of `length` in C. If arg is not a cons, does not error but returns 0. */ -int c_length( struct cons_pointer arg) { +int c_length( struct cons_pointer arg ) { int result = 0; - for (struct cons_pointer c = arg; !nilp(c); c = c_cdr(c)) { - result ++; + for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) { + result++; } return result; @@ -276,27 +278,21 @@ struct cons_pointer make_nlambda( struct cons_pointer args, * * returns 0 for things which are not string like. */ -uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) -{ - struct cons_space_object *cell = &pointer2cell(ptr); +uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) { + struct cons_space_object *cell = &pointer2cell( ptr ); uint32_t result = 0; - switch (cell->tag.value) - { - case KEYTV: - case STRINGTV: - case SYMBOLTV: - if (nilp(cell->payload.string.cdr)) - { - result = (uint32_t)c; - } - else - { - result = ((uint32_t)c * - cell->payload.string.hash) & - 0xffffffff; - } - break; + switch ( cell->tag.value ) { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if ( nilp( cell->payload.string.cdr ) ) { + result = ( uint32_t ) c; + } else { + result = ( ( uint32_t ) c * + cell->payload.string.hash ) & 0xffffffff; + } + break; } return result; @@ -324,7 +320,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { * cell->payload.string.cdr = tail */ cell->payload.string.cdr.offset = tail.offset; - cell->payload.string.hash = calculate_hash(c, tail); + cell->payload.string.hash = calculate_hash( c, tail ); } else { // \todo should throw an exception! debug_printf( DEBUG_ALLOC, @@ -430,12 +426,12 @@ struct cons_pointer make_write_stream( URL_FILE * output, struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) { struct cons_pointer result = NIL; - for ( int i = wcslen( symbol ) -1; i >= 0; i-- ) { - wchar_t c = towlower(symbol[i]); + for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { + wchar_t c = towlower( symbol[i] ); - if (iswalnum(c) || c == L'-') { - result = make_keyword( c, result ); - } + if ( iswalnum( c ) || c == L'-' ) { + result = make_keyword( c, result ); + } } return result; @@ -448,9 +444,9 @@ struct cons_pointer c_string_to_lisp_string( wchar_t *string ) { struct cons_pointer result = NIL; for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { - if (iswprint(string[i]) && string[i] != '"') { - result = make_string( string[i], result ); - } + if ( iswprint( string[i] ) && string[i] != '"' ) { + result = make_string( string[i], result ); + } } return result; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 0efa0a6..2817e69 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -685,7 +685,7 @@ struct cons_pointer c_car( struct cons_pointer arg ); struct cons_pointer c_cdr( struct cons_pointer arg ); -int c_length( struct cons_pointer arg); +int c_length( struct cons_pointer arg ); struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr ); diff --git a/src/memory/dump.c b/src/memory/dump.c index 2dc6658..086f8c8 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -46,8 +46,7 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix, cell.payload.string.character, cell.payload.string.hash, cell.payload.string.cdr.page, - cell.payload.string.cdr.offset, - cell.count ); + cell.payload.string.cdr.offset, cell.count ); url_fwprintf( output, L"\t\t value: " ); print( output, pointer ); url_fwprintf( output, L"\n" ); @@ -57,105 +56,111 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix, /** * dump the object at this cons_pointer to this output stream. */ -void dump_object( URL_FILE *output, struct cons_pointer pointer ) { - struct cons_space_object cell = pointer2cell( pointer ); - url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n", - cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset, - cell.count ); +void dump_object( URL_FILE * output, struct cons_pointer pointer ) { + struct cons_space_object cell = pointer2cell( pointer ); + url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n", + cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset, + cell.count ); - switch ( cell.tag.value ) { - case CONSTV: - url_fwprintf( output, - L"\t\tCons cell: car at page %d offset %d, cdr at page %d " - L"offset %d, count %u :", - cell.payload.cons.car.page, cell.payload.cons.car.offset, - cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset, - cell.count ); - print( output, pointer ); - url_fputws( L"\n", output ); - break; - case EXCEPTIONTV: - url_fwprintf( output, L"\t\tException cell: " ); - dump_stack_trace( output, pointer ); - break; - case FREETV: - url_fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n", - cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset ); - break; - case INTEGERTV: - url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n", - cell.payload.integer.value, cell.count ); - if ( !nilp( cell.payload.integer.more ) ) { - url_fputws( L"\t\tBIGNUM! More at:\n", output ); - dump_object( output, cell.payload.integer.more ); - } - break; - case KEYTV: - dump_string_cell( output, L"Keyword", pointer ); - break; - case LAMBDATV: - url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); - print( output, cell.payload.lambda.args ); - url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); - url_fputws( L"\n", output ); - break; - case NILTV: - break; - case NLAMBDATV: - url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); - print( output, cell.payload.lambda.args ); - url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); - url_fputws( L"\n", output ); - break; - case RATIOTV: - url_fwprintf( - output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ).payload.integer.value, - pointer2cell( cell.payload.ratio.divisor ).payload.integer.value, - cell.count ); - break; - case READTV: - url_fputws( L"\t\tInput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); - url_fputws( L"\n", output ); - break; - case REALTV: - url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", - cell.payload.real.value, cell.count ); - break; - case STRINGTV: - dump_string_cell( output, L"String", pointer ); - break; - case SYMBOLTV: - dump_string_cell( output, L"Symbol", pointer ); - break; - case TRUETV: - break; - case VECTORPOINTTV: { - url_fwprintf( output, L"\t\tPointer to vector-space object at %p\n", - cell.payload.vectorp.address ); - struct vector_space_object *vso = cell.payload.vectorp.address; - url_fwprintf( output, - L"\t\tVector space object of type %4.4s (%d), payload size " - L"%d bytes\n", - &vso->header.tag.bytes, vso->header.tag.value, - vso->header.size ); + switch ( cell.tag.value ) { + case CONSTV: + url_fwprintf( output, + L"\t\tCons cell: car at page %d offset %d, cdr at page %d " + L"offset %d, count %u :", + cell.payload.cons.car.page, + cell.payload.cons.car.offset, + cell.payload.cons.cdr.page, + cell.payload.cons.cdr.offset, cell.count ); + print( output, pointer ); + url_fputws( L"\n", output ); + break; + case EXCEPTIONTV: + url_fwprintf( output, L"\t\tException cell: " ); + dump_stack_trace( output, pointer ); + break; + case FREETV: + url_fwprintf( output, + L"\t\tFree cell: next at page %d offset %d\n", + cell.payload.cons.cdr.page, + cell.payload.cons.cdr.offset ); + break; + case INTEGERTV: + url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n", + cell.payload.integer.value, cell.count ); + if ( !nilp( cell.payload.integer.more ) ) { + url_fputws( L"\t\tBIGNUM! More at:\n", output ); + dump_object( output, cell.payload.integer.more ); + } + break; + case KEYTV: + dump_string_cell( output, L"Keyword", pointer ); + break; + case LAMBDATV: + url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); + print( output, cell.payload.lambda.args ); + url_fwprintf( output, L";\n\t\t\tbody: " ); + print( output, cell.payload.lambda.body ); + url_fputws( L"\n", output ); + break; + case NILTV: + break; + case NLAMBDATV: + url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); + print( output, cell.payload.lambda.args ); + url_fwprintf( output, L";\n\t\t\tbody: " ); + print( output, cell.payload.lambda.body ); + url_fputws( L"\n", output ); + break; + case RATIOTV: + url_fwprintf( output, + L"\t\tRational cell: value %ld/%ld, count %u\n", + pointer2cell( cell.payload.ratio.dividend ).payload. + integer.value, + pointer2cell( cell.payload.ratio.divisor ).payload. + integer.value, cell.count ); + break; + case READTV: + url_fputws( L"\t\tInput stream; metadata: ", output ); + print( output, cell.payload.stream.meta ); + url_fputws( L"\n", output ); + break; + case REALTV: + url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", + cell.payload.real.value, cell.count ); + break; + case STRINGTV: + dump_string_cell( output, L"String", pointer ); + break; + case SYMBOLTV: + dump_string_cell( output, L"Symbol", pointer ); + break; + case TRUETV: + break; + case VECTORPOINTTV:{ + url_fwprintf( output, + L"\t\tPointer to vector-space object at %p\n", + cell.payload.vectorp.address ); + struct vector_space_object *vso = cell.payload.vectorp.address; + url_fwprintf( output, + L"\t\tVector space object of type %4.4s (%d), payload size " + L"%d bytes\n", + &vso->header.tag.bytes, vso->header.tag.value, + vso->header.size ); - switch ( vso->header.tag.value ) { - case STACKFRAMETV: - dump_frame( output, pointer ); - break; - case HASHTV: - dump_map( output, pointer ); - break; - } - } break; - case WRITETV: - url_fputws( L"\t\tOutput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); - url_fputws( L"\n", output ); - break; - } + switch ( vso->header.tag.value ) { + case STACKFRAMETV: + dump_frame( output, pointer ); + break; + case HASHTV: + dump_map( output, pointer ); + break; + } + } + break; + case WRITETV: + url_fputws( L"\t\tOutput stream; metadata: ", output ); + print( output, cell.payload.stream.meta ); + url_fputws( L"\n", output ); + break; + } } diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index ae15461..2e68cda 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -24,47 +24,46 @@ * then `(sxhash x)` and `(sxhash y)` will always be equal. */ uint32_t sxhash( struct cons_pointer ptr ) { - // TODO: Not Yet Implemented - /* TODO: should look at the implementation of Common Lisp sxhash? - * My current implementation of `print` only addresses URL_FILE - * streams. It would be better if it also addressed strings but - * currently it doesn't. Creating a print string of the structure - * and taking the hash of that would be one simple (but not necessarily - * cheap) solution. - */ - /* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp - * and is EXTREMELY complex, and essentially has a different dispatch for - * every type of object. It's likely we need to do the same. - */ - return 0; + // TODO: Not Yet Implemented + /* TODO: should look at the implementation of Common Lisp sxhash? + * My current implementation of `print` only addresses URL_FILE + * streams. It would be better if it also addressed strings but + * currently it doesn't. Creating a print string of the structure + * and taking the hash of that would be one simple (but not necessarily + * cheap) solution. + */ + /* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp + * and is EXTREMELY complex, and essentially has a different dispatch for + * every type of object. It's likely we need to do the same. + */ + return 0; } /** * Get the hash value for the cell indicated by this `ptr`; currently only * implemented for string like things and integers. */ -uint32_t get_hash(struct cons_pointer ptr) -{ - struct cons_space_object *cell = &pointer2cell(ptr); +uint32_t get_hash( struct cons_pointer ptr ) { + struct cons_space_object *cell = &pointer2cell( ptr ); uint32_t result = 0; switch ( cell->tag.value ) { - case INTEGERTV: - /* Note that we're only hashing on the least significant word of an - * integer. */ - result = cell->payload.integer.value & 0xffffffff; - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - result = cell->payload.string.hash; - break; - case TRUETV: - result = 1; // arbitrarily - break; - default: - result = sxhash( ptr ); - break; + case INTEGERTV: + /* Note that we're only hashing on the least significant word of an + * integer. */ + result = cell->payload.integer.value & 0xffffffff; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = cell->payload.string.hash; + break; + case TRUETV: + result = 1; // arbitrarily + break; + default: + result = sxhash( ptr ); + break; } return result; @@ -74,35 +73,34 @@ uint32_t get_hash(struct cons_pointer ptr) * Free the hashmap indicated by this `pointer`. */ void free_hashmap( struct cons_pointer pointer ) { - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( hashmapp( pointer ) ) { - struct vector_space_object *vso = cell->payload.vectorp.address; + if ( hashmapp( pointer ) ) { + struct vector_space_object *vso = cell->payload.vectorp.address; - dec_ref( vso->payload.hashmap.hash_fn ); - dec_ref( vso->payload.hashmap.write_acl ); + dec_ref( vso->payload.hashmap.hash_fn ); + dec_ref( vso->payload.hashmap.write_acl ); - for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) { - if ( !nilp( vso->payload.hashmap.buckets[i] ) ) { - debug_printf( DEBUG_ALLOC, - L"Decrementing bucket [%d] of hashmap at 0x%lx\n", i, - cell->payload.vectorp.address ); - dec_ref( vso->payload.hashmap.buckets[i] ); - } + for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) { + if ( !nilp( vso->payload.hashmap.buckets[i] ) ) { + debug_printf( DEBUG_ALLOC, + L"Decrementing bucket [%d] of hashmap at 0x%lx\n", + i, cell->payload.vectorp.address ); + dec_ref( vso->payload.hashmap.buckets[i] ); + } + } + } else { + debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" ); } - } else { - debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" ); - } } /** * A lisp function signature conforming wrapper around get_hash, q.v.. */ -struct cons_pointer lisp_get_hash(struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env) -{ - return make_integer(get_hash(frame->arg[0]), NIL); +struct cons_pointer lisp_get_hash( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_integer( get_hash( frame->arg[0] ), NIL ); } /** @@ -112,22 +110,23 @@ struct cons_pointer lisp_get_hash(struct stack_frame *frame, struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn, struct cons_pointer write_acl ) { - struct cons_pointer result = - make_vso( HASHTV, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + - ( sizeof( uint32_t ) * 2 ) ); + struct cons_pointer result = + make_vso( HASHTV, + ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + + ( sizeof( uint32_t ) * 2 ) ); - struct hashmap_payload *payload = - (struct hashmap_payload *)&pointer_to_vso( result )->payload; + struct hashmap_payload *payload = + ( struct hashmap_payload * ) &pointer_to_vso( result )->payload; - payload->hash_fn = inc_ref(hash_fn); - payload->write_acl = inc_ref(write_acl); + payload->hash_fn = inc_ref( hash_fn ); + payload->write_acl = inc_ref( write_acl ); - payload->n_buckets = n_buckets; - for ( int i = 0; i < n_buckets; i++ ) { - payload->buckets[i] = NIL; - } + payload->n_buckets = n_buckets; + for ( int i = 0; i < n_buckets; i++ ) { + payload->buckets[i] = NIL; + } - return result; + return result; } /** @@ -141,52 +140,54 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - uint32_t n = DFLT_HASHMAP_BUCKETS; - struct cons_pointer hash_fn = NIL; - struct cons_pointer result = NIL; + uint32_t n = DFLT_HASHMAP_BUCKETS; + struct cons_pointer hash_fn = NIL; + struct cons_pointer result = NIL; - if ( frame->args > 0 ) { - if ( integerp( frame->arg[0] ) ) { - n = to_long_int( frame->arg[0] ) % UINT32_MAX; - } else if ( !nilp( frame->arg[0] ) ) { - result = make_exception( - c_string_to_lisp_string( L"First arg to `hashmap`, if passed, must " - L"be an integer or `nil`.`" ), - NIL ); + if ( frame->args > 0 ) { + if ( integerp( frame->arg[0] ) ) { + n = to_long_int( frame->arg[0] ) % UINT32_MAX; + } else if ( !nilp( frame->arg[0] ) ) { + result = + make_exception( c_string_to_lisp_string + ( L"First arg to `hashmap`, if passed, must " + L"be an integer or `nil`.`" ), NIL ); + } } - } - if ( frame->args > 1 ) { - hash_fn = frame->arg[1]; - } - - if ( nilp( result ) ) { - /* if there are fewer than 4 args, then arg[3] ought to be nil anyway, which - * is fine */ - result = make_hashmap( n, hash_fn, frame->arg[3] ); - struct vector_space_object *map = pointer_to_vso( result ); - - if ( frame->args > 2 && - truep( authorised( result, map->payload.hashmap.write_acl ) ) ) { - // then arg[2] ought to be an assoc list which we should iterate down - // populating the hashmap. - for ( struct cons_pointer cursor = frame->arg[2]; !nilp( cursor ); - cursor = c_cdr( cursor ) ) { - struct cons_pointer pair = c_car( cursor ); - struct cons_pointer key = c_car( pair ); - struct cons_pointer val = c_cdr( pair ); - - uint32_t bucket_no = - get_hash( key ) % - ( (struct hashmap_payload *)&( map->payload ) )->n_buckets; - - map->payload.hashmap.buckets[bucket_no] = - inc_ref( make_cons( make_cons( key, val ), - map->payload.hashmap.buckets[bucket_no] )); - } + if ( frame->args > 1 ) { + hash_fn = frame->arg[1]; } - } - return result; + if ( nilp( result ) ) { + /* if there are fewer than 4 args, then arg[3] ought to be nil anyway, which + * is fine */ + result = make_hashmap( n, hash_fn, frame->arg[3] ); + struct vector_space_object *map = pointer_to_vso( result ); + + if ( frame->args > 2 && + truep( authorised( result, map->payload.hashmap.write_acl ) ) ) { + // then arg[2] ought to be an assoc list which we should iterate down + // populating the hashmap. + for ( struct cons_pointer cursor = frame->arg[2]; !nilp( cursor ); + cursor = c_cdr( cursor ) ) { + struct cons_pointer pair = c_car( cursor ); + struct cons_pointer key = c_car( pair ); + struct cons_pointer val = c_cdr( pair ); + + uint32_t bucket_no = + get_hash( key ) % + ( ( struct hashmap_payload * ) &( map->payload ) )-> + n_buckets; + + map->payload.hashmap.buckets[bucket_no] = + inc_ref( make_cons( make_cons( key, val ), + map->payload.hashmap. + buckets[bucket_no] ) ); + } + } + } + + return result; } @@ -197,28 +198,30 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, * readable hashmap. */ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( ptr, NIL ) ) ) { - if ( hashmapp( ptr ) ) { - struct vector_space_object *from = pointer_to_vso( ptr ); + if ( truep( authorised( ptr, NIL ) ) ) { + if ( hashmapp( ptr ) ) { + struct vector_space_object *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 hashmap_payload to_pl = to->payload.hashmap; + 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 hashmap_payload to_pl = to->payload.hashmap; - for ( int i = 0; i < to_pl.n_buckets; i++ ) { - to_pl.buckets[i] = from_pl.buckets[i]; - inc_ref( to_pl.buckets[i] ); + for ( int i = 0; i < to_pl.n_buckets; i++ ) { + to_pl.buckets[i] = from_pl.buckets[i]; + inc_ref( to_pl.buckets[i] ); + } + } } - } } - } - // TODO: else exception? + // TODO: else exception? - return result; + return result; } /** @@ -229,37 +232,35 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) { struct cons_pointer hashmap_put( struct cons_pointer mapp, struct cons_pointer key, struct cons_pointer val ) { - // TODO: if current user has write access to this hashmap - if ( hashmapp( mapp ) && !nilp( key ) ) { - struct vector_space_object *map = pointer_to_vso( mapp ); + // TODO: if current user has write access to this hashmap + if ( hashmapp( mapp ) && !nilp( key ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); - if (nilp(authorised(mapp, map->payload.hashmap.write_acl))) { - mapp = clone_hashmap( mapp); - map = pointer_to_vso( mapp ); - } - uint32_t bucket_no = - get_hash( key ) % - map->payload.hashmap.n_buckets; + if ( nilp( authorised( mapp, map->payload.hashmap.write_acl ) ) ) { + mapp = clone_hashmap( mapp ); + map = pointer_to_vso( mapp ); + } + uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets; map->payload.hashmap.buckets[bucket_no] = inc_ref( make_cons( make_cons( key, val ), - map->payload.hashmap.buckets[bucket_no] )); - } + map->payload.hashmap.buckets[bucket_no] ) ); + } - return mapp; + return mapp; } struct cons_pointer hashmap_get( struct cons_pointer mapp, struct cons_pointer key ) { - struct cons_pointer result = NIL; - if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) { - struct vector_space_object *map = pointer_to_vso( mapp ); - uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets; + struct cons_pointer result = NIL; + if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); + uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets; - result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] ); - } + result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] ); + } - return result; + return result; } /** @@ -272,11 +273,11 @@ struct cons_pointer hashmap_get( struct cons_pointer mapp, struct cons_pointer lisp_hashmap_put( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer mapp = frame->arg[0]; - struct cons_pointer key = frame->arg[1]; - struct cons_pointer val = frame->arg[2]; + struct cons_pointer mapp = frame->arg[0]; + struct cons_pointer key = frame->arg[1]; + struct cons_pointer val = frame->arg[2]; - return hashmap_put(mapp, key, val); + return hashmap_put( mapp, key, val ); } /** @@ -286,21 +287,21 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame, */ struct cons_pointer hashmap_put_all( struct cons_pointer mapp, struct cons_pointer assoc ) { - // TODO: if current user has write access to this hashmap - if ( hashmapp( mapp ) && !nilp( assoc ) ) { - struct vector_space_object *map = pointer_to_vso( mapp ); + // TODO: if current user has write access to this hashmap + if ( hashmapp( mapp ) && !nilp( assoc ) ) { + struct vector_space_object *map = pointer_to_vso( mapp ); - if ( hashmapp( mapp ) && consp( assoc ) ) { - for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair ); - pair = c_car( assoc ) ) { - /* TODO: this is really hammering the memory management system, because - * it will make a new lone for every key/value pair added. Fix. */ - mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) ); - } + if ( hashmapp( mapp ) && consp( assoc ) ) { + for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair ); + pair = c_car( assoc ) ) { + /* TODO: this is really hammering the memory management system, because + * it will make a new lone for every key/value pair added. Fix. */ + mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) ); + } + } } - } - return mapp; + return mapp; } /** @@ -310,47 +311,47 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp, struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - return hashmap_put_all( frame->arg[0], frame->arg[1] ); + return hashmap_put_all( frame->arg[0], frame->arg[1] ); } /** * return a flat list of all the keys in the hashmap indicated by `map`. */ -struct cons_pointer hashmap_keys( struct cons_pointer mapp) { - struct cons_pointer result = NIL; - if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) )) { +struct cons_pointer hashmap_keys( struct cons_pointer mapp ) { + struct cons_pointer result = NIL; + if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) ) { struct vector_space_object *map = pointer_to_vso( mapp ); - for (int i = 0; i < map->payload.hashmap.n_buckets; i++) { - for (struct cons_pointer c = map->payload.hashmap.buckets[i]; - !nilp(c); - c = c_cdr(c)) { - result = make_cons(c_car( c_car(c)), result); - } + for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) { + for ( struct cons_pointer c = map->payload.hashmap.buckets[i]; + !nilp( c ); c = c_cdr( c ) ) { + result = make_cons( c_car( c_car( c ) ), result ); + } + } } - } - return result; + return result; } struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - return hashmap_keys( frame->arg[0] ); + return hashmap_keys( frame->arg[0] ); } -void dump_map( URL_FILE *output, struct cons_pointer pointer ) { - struct hashmap_payload *payload = &pointer_to_vso( pointer )->payload.hashmap; - url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets ); - url_fwprintf( output, L"\tHash function: " ); - print( output, payload->hash_fn ); - url_fwprintf( output, L"\n\tWrite ACL: " ); - print( output, payload->write_acl ); - url_fwprintf( output, L"\n\tBuckets:" ); - for ( int i = 0; i < payload->n_buckets; i++ ) { - url_fwprintf( output, L"\n\t\t[%d]: ", i ); - print( output, payload->buckets[i] ); - } - url_fwprintf( output, L"\n" ); +void dump_map( URL_FILE * output, struct cons_pointer pointer ) { + struct hashmap_payload *payload = + &pointer_to_vso( pointer )->payload.hashmap; + url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets ); + url_fwprintf( output, L"\tHash function: " ); + print( output, payload->hash_fn ); + url_fwprintf( output, L"\n\tWrite ACL: " ); + print( output, payload->write_acl ); + url_fwprintf( output, L"\n\tBuckets:" ); + for ( int i = 0; i < payload->n_buckets; i++ ) { + url_fwprintf( output, L"\n\t\t[%d]: ", i ); + print( output, payload->buckets[i] ); + } + url_fwprintf( output, L"\n" ); } diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index 4602f3e..b6c4a74 100644 --- a/src/memory/hashmap.h +++ b/src/memory/hashmap.h @@ -15,13 +15,13 @@ #include "memory/consspaceobject.h" #include "memory/vectorspace.h" -#define DFLT_HASHMAP_BUCKETS 32 +#define DFLT_HASHMAP_BUCKETS 32 uint32_t get_hash( struct cons_pointer ptr ); void free_hashmap( struct cons_pointer ptr ); -void dump_map( URL_FILE *output, struct cons_pointer pointer ); +void dump_map( URL_FILE * output, struct cons_pointer pointer ); struct cons_pointer hashmap_get( struct cons_pointer mapp, struct cons_pointer key ); @@ -52,4 +52,4 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn, struct cons_pointer write_acl ); -#endif \ No newline at end of file +#endif diff --git a/src/memory/lookup3.c b/src/memory/lookup3.c index 006d513..359cff2 100644 --- a/src/memory/lookup3.c +++ b/src/memory/lookup3.c @@ -35,12 +35,12 @@ on 1 byte), but shoehorning those bytes into integers efficiently is messy. */ // #define SELF_TEST 1 -#include /* defines printf for tests */ -#include /* defines time_t for timings in the test */ -#include /* defines uint32_t etc */ -#include /* attempt to define endianness */ +#include /* defines printf for tests */ +#include /* defines time_t for timings in the test */ +#include /* defines uint32_t etc */ +#include /* attempt to define endianness */ #ifdef linux -# include /* attempt to define endianness */ +#include /* attempt to define endianness */ #endif /* @@ -51,16 +51,16 @@ on 1 byte), but shoehorning those bytes into integers efficiently is messy. __BYTE_ORDER == __LITTLE_ENDIAN) || \ (defined(i386) || defined(__i386__) || defined(__i486__) || \ defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) -# define HASH_LITTLE_ENDIAN 1 -# define HASH_BIG_ENDIAN 0 +#define HASH_LITTLE_ENDIAN 1 +#define HASH_BIG_ENDIAN 0 #elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \ __BYTE_ORDER == __BIG_ENDIAN) || \ (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 1 +#define HASH_LITTLE_ENDIAN 0 +#define HASH_BIG_ENDIAN 1 #else -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 0 +#define HASH_LITTLE_ENDIAN 0 +#define HASH_BIG_ENDIAN 0 #endif #define hashsize(n) ((uint32_t)1<<(n)) @@ -170,39 +170,38 @@ and these came close: hashlittle() has to dance around fitting the key bytes into registers. -------------------------------------------------------------------- */ -uint32_t hashword( -const uint32_t *k, /* the key, an array of uint32_t values */ -size_t length, /* the length of the key, in uint32_ts */ -uint32_t initval) /* the previous hash, or an arbitrary value */ -{ - uint32_t a,b,c; +uint32_t hashword( const uint32_t * k, /* the key, an array of uint32_t values */ + size_t length, /* the length of the key, in uint32_ts */ + uint32_t initval ) { /* the previous hash, or an arbitrary value */ + uint32_t a, b, c; - /* Set up the internal state */ - a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ( ( ( uint32_t ) length ) << 2 ) + initval; /*------------------------------------------------- handle most of the key */ - while (length > 3) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 3; - k += 3; - } + while ( length > 3 ) { + a += k[0]; + b += k[1]; + c += k[2]; + mix( a, b, c ); + length -= 3; + k += 3; + } /*------------------------------------------- handle the last 3 uint32_t's */ - switch(length) /* all the case statements fall through */ - { - case 3 : c+=k[2]; - case 2 : b+=k[1]; - case 1 : a+=k[0]; - final(a,b,c); - case 0: /* case 0: nothing left to add */ - break; - } + switch ( length ) { /* all the case statements fall through */ + case 3: + c += k[2]; + case 2: + b += k[1]; + case 1: + a += k[0]; + final( a, b, c ); + case 0: /* case 0: nothing left to add */ + break; + } /*------------------------------------------------------ report the result */ - return c; + return c; } @@ -214,41 +213,41 @@ both be initialized with seeds. If you pass in (*pb)==0, the output (*pc) will be the same as the return value from hashword(). -------------------------------------------------------------------- */ -void hashword2 ( -const uint32_t *k, /* the key, an array of uint32_t values */ -size_t length, /* the length of the key, in uint32_ts */ -uint32_t *pc, /* IN: seed OUT: primary hash value */ -uint32_t *pb) /* IN: more seed OUT: secondary hash value */ -{ - uint32_t a,b,c; +void hashword2( const uint32_t * k, /* the key, an array of uint32_t values */ + size_t length, /* the length of the key, in uint32_ts */ + uint32_t * pc, /* IN: seed OUT: primary hash value */ + uint32_t * pb ) { /* IN: more seed OUT: secondary hash value */ + uint32_t a, b, c; - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc; - c += *pb; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ( ( uint32_t ) ( length << 2 ) ) + *pc; + c += *pb; /*------------------------------------------------- handle most of the key */ - while (length > 3) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 3; - k += 3; - } + while ( length > 3 ) { + a += k[0]; + b += k[1]; + c += k[2]; + mix( a, b, c ); + length -= 3; + k += 3; + } /*------------------------------------------- handle the last 3 uint32_t's */ - switch(length) /* all the case statements fall through */ - { - case 3 : c+=k[2]; - case 2 : b+=k[1]; - case 1 : a+=k[0]; - final(a,b,c); - case 0: /* case 0: nothing left to add */ - break; - } + switch ( length ) { /* all the case statements fall through */ + case 3: + c += k[2]; + case 2: + b += k[1]; + case 1: + a += k[0]; + final( a, b, c ); + case 0: /* case 0: nothing left to add */ + break; + } /*------------------------------------------------------ report the result */ - *pc=c; *pb=b; + *pc = c; + *pb = b; } @@ -279,173 +278,251 @@ acceptable. Do NOT use for cryptographic purposes. ------------------------------------------------------------------------------- */ -uint32_t hashlittle( const void *key, size_t length, uint32_t initval) -{ - uint32_t a,b,c; /* internal state */ - union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */ +uint32_t hashlittle( const void *key, size_t length, uint32_t initval ) { + uint32_t a, b, c; /* internal state */ + union { + const void *ptr; + size_t i; + } u; /* needed for Mac Powerbook G4 */ - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)length) + initval; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ( ( uint32_t ) length ) + initval; - u.ptr = key; - if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { - const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ - const uint8_t *k8; + u.ptr = key; + if ( HASH_LITTLE_ENDIAN && ( ( u.i & 0x3 ) == 0 ) ) { + const uint32_t *k = ( const uint32_t * ) key; /* read 32-bit chunks */ + const uint8_t *k8; /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 12; - k += 3; - } + while ( length > 12 ) { + a += k[0]; + b += k[1]; + c += k[2]; + mix( a, b, c ); + length -= 12; + k += 3; + } /*----------------------------- handle the last (probably partial) block */ - /* - * "k[2]&0xffffff" actually reads beyond the end of the string, but - * then masks off the part it's not allowed to read. Because the - * string is aligned, the masked-off tail is in the same word as the - * rest of the string. Every machine with memory protection I've seen - * does it on word boundaries, so is OK with this. But VALGRIND will - * still catch it and complain. The masking trick does make the hash - * noticably faster for short strings (like English words). - */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ #ifndef VALGRIND - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; - case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; - case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=k[1]&0xffffff; a+=k[0]; break; - case 6 : b+=k[1]&0xffff; a+=k[0]; break; - case 5 : b+=k[1]&0xff; a+=k[0]; break; - case 4 : a+=k[0]; break; - case 3 : a+=k[0]&0xffffff; break; - case 2 : a+=k[0]&0xffff; break; - case 1 : a+=k[0]&0xff; break; - case 0 : return c; /* zero length strings require no mixing */ - } + switch ( length ) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += k[2] & 0xffffff; + b += k[1]; + a += k[0]; + break; + case 10: + c += k[2] & 0xffff; + b += k[1]; + a += k[0]; + break; + case 9: + c += k[2] & 0xff; + b += k[1]; + a += k[0]; + break; + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += k[1] & 0xffffff; + a += k[0]; + break; + case 6: + b += k[1] & 0xffff; + a += k[0]; + break; + case 5: + b += k[1] & 0xff; + a += k[0]; + break; + case 4: + a += k[0]; + break; + case 3: + a += k[0] & 0xffffff; + break; + case 2: + a += k[0] & 0xffff; + break; + case 1: + a += k[0] & 0xff; + break; + case 0: + return c; /* zero length strings require no mixing */ + } #else /* make valgrind happy */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]; break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ - case 1 : a+=k8[0]; break; - case 0 : return c; - } + k8 = ( const uint8_t * ) k; + switch ( length ) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += ( ( uint32_t ) k8[10] ) << 16; /* fall through */ + case 10: + c += ( ( uint32_t ) k8[9] ) << 8; /* fall through */ + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += ( ( uint32_t ) k8[6] ) << 16; /* fall through */ + case 6: + b += ( ( uint32_t ) k8[5] ) << 8; /* fall through */ + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0]; + break; + case 3: + a += ( ( uint32_t ) k8[2] ) << 16; /* fall through */ + case 2: + a += ( ( uint32_t ) k8[1] ) << 8; /* fall through */ + case 1: + a += k8[0]; + break; + case 0: + return c; + } #endif /* !valgrind */ - } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { - const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ - const uint8_t *k8; + } else if ( HASH_LITTLE_ENDIAN && ( ( u.i & 0x1 ) == 0 ) ) { + const uint16_t *k = ( const uint16_t * ) key; /* read 16-bit chunks */ + const uint8_t *k8; /*--------------- all but last block: aligned reads and different mixing */ - while (length > 12) - { - a += k[0] + (((uint32_t)k[1])<<16); - b += k[2] + (((uint32_t)k[3])<<16); - c += k[4] + (((uint32_t)k[5])<<16); - mix(a,b,c); - length -= 12; - k += 6; - } + while ( length > 12 ) { + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + c += k[4] + ( ( ( uint32_t ) k[5] ) << 16 ); + mix( a, b, c ); + length -= 12; + k += 6; + } /*----------------------------- handle the last (probably partial) block */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[4]+(((uint32_t)k[5])<<16); - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=k[4]; - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=k[2]; - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=k[0]; - break; - case 1 : a+=k8[0]; - break; - case 0 : return c; /* zero length requires no mixing */ - } + k8 = ( const uint8_t * ) k; + switch ( length ) { + case 12: + c += k[4] + ( ( ( uint32_t ) k[5] ) << 16 ); + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 11: + c += ( ( uint32_t ) k8[10] ) << 16; /* fall through */ + case 10: + c += k[4]; + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 7: + b += ( ( uint32_t ) k8[6] ) << 16; /* fall through */ + case 6: + b += k[2]; + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 3: + a += ( ( uint32_t ) k8[2] ) << 16; /* fall through */ + case 2: + a += k[0]; + break; + case 1: + a += k8[0]; + break; + case 0: + return c; /* zero length requires no mixing */ + } - } else { /* need to read the key one byte at a time */ - const uint8_t *k = (const uint8_t *)key; + } else { /* need to read the key one byte at a time */ + const uint8_t *k = ( const uint8_t * ) key; /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - a += ((uint32_t)k[1])<<8; - a += ((uint32_t)k[2])<<16; - a += ((uint32_t)k[3])<<24; - b += k[4]; - b += ((uint32_t)k[5])<<8; - b += ((uint32_t)k[6])<<16; - b += ((uint32_t)k[7])<<24; - c += k[8]; - c += ((uint32_t)k[9])<<8; - c += ((uint32_t)k[10])<<16; - c += ((uint32_t)k[11])<<24; - mix(a,b,c); - length -= 12; - k += 12; - } + while ( length > 12 ) { + a += k[0]; + a += ( ( uint32_t ) k[1] ) << 8; + a += ( ( uint32_t ) k[2] ) << 16; + a += ( ( uint32_t ) k[3] ) << 24; + b += k[4]; + b += ( ( uint32_t ) k[5] ) << 8; + b += ( ( uint32_t ) k[6] ) << 16; + b += ( ( uint32_t ) k[7] ) << 24; + c += k[8]; + c += ( ( uint32_t ) k[9] ) << 8; + c += ( ( uint32_t ) k[10] ) << 16; + c += ( ( uint32_t ) k[11] ) << 24; + mix( a, b, c ); + length -= 12; + k += 12; + } /*-------------------------------- last block: affect all 32 bits of (c) */ - switch(length) /* all the case statements fall through */ - { - case 12: c+=((uint32_t)k[11])<<24; - case 11: c+=((uint32_t)k[10])<<16; - case 10: c+=((uint32_t)k[9])<<8; - case 9 : c+=k[8]; - case 8 : b+=((uint32_t)k[7])<<24; - case 7 : b+=((uint32_t)k[6])<<16; - case 6 : b+=((uint32_t)k[5])<<8; - case 5 : b+=k[4]; - case 4 : a+=((uint32_t)k[3])<<24; - case 3 : a+=((uint32_t)k[2])<<16; - case 2 : a+=((uint32_t)k[1])<<8; - case 1 : a+=k[0]; - break; - case 0 : return c; + switch ( length ) { /* all the case statements fall through */ + case 12: + c += ( ( uint32_t ) k[11] ) << 24; + case 11: + c += ( ( uint32_t ) k[10] ) << 16; + case 10: + c += ( ( uint32_t ) k[9] ) << 8; + case 9: + c += k[8]; + case 8: + b += ( ( uint32_t ) k[7] ) << 24; + case 7: + b += ( ( uint32_t ) k[6] ) << 16; + case 6: + b += ( ( uint32_t ) k[5] ) << 8; + case 5: + b += k[4]; + case 4: + a += ( ( uint32_t ) k[3] ) << 24; + case 3: + a += ( ( uint32_t ) k[2] ) << 16; + case 2: + a += ( ( uint32_t ) k[1] ) << 8; + case 1: + a += k[0]; + break; + case 0: + return c; + } } - } - final(a,b,c); - return c; + final( a, b, c ); + return c; } @@ -459,178 +536,264 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval) * the key. *pc is better mixed than *pb, so use *pc first. If you want * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)". */ -void hashlittle2( - const void *key, /* the key to hash */ - size_t length, /* length of the key */ - uint32_t *pc, /* IN: primary initval, OUT: primary hash */ - uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */ -{ - uint32_t a,b,c; /* internal state */ - union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */ +void hashlittle2( const void *key, /* the key to hash */ + size_t length, /* length of the key */ + uint32_t * pc, /* IN: primary initval, OUT: primary hash */ + uint32_t * pb ) { /* IN: secondary initval, OUT: secondary hash */ + uint32_t a, b, c; /* internal state */ + union { + const void *ptr; + size_t i; + } u; /* needed for Mac Powerbook G4 */ - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc; - c += *pb; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ( ( uint32_t ) length ) + *pc; + c += *pb; - u.ptr = key; - if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { - const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ - const uint8_t *k8; + u.ptr = key; + if ( HASH_LITTLE_ENDIAN && ( ( u.i & 0x3 ) == 0 ) ) { + const uint32_t *k = ( const uint32_t * ) key; /* read 32-bit chunks */ + const uint8_t *k8; /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 12; - k += 3; - } + while ( length > 12 ) { + a += k[0]; + b += k[1]; + c += k[2]; + mix( a, b, c ); + length -= 12; + k += 3; + } /*----------------------------- handle the last (probably partial) block */ - /* - * "k[2]&0xffffff" actually reads beyond the end of the string, but - * then masks off the part it's not allowed to read. Because the - * string is aligned, the masked-off tail is in the same word as the - * rest of the string. Every machine with memory protection I've seen - * does it on word boundaries, so is OK with this. But VALGRIND will - * still catch it and complain. The masking trick does make the hash - * noticably faster for short strings (like English words). - */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ #ifndef VALGRIND - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; - case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; - case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=k[1]&0xffffff; a+=k[0]; break; - case 6 : b+=k[1]&0xffff; a+=k[0]; break; - case 5 : b+=k[1]&0xff; a+=k[0]; break; - case 4 : a+=k[0]; break; - case 3 : a+=k[0]&0xffffff; break; - case 2 : a+=k[0]&0xffff; break; - case 1 : a+=k[0]&0xff; break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } + switch ( length ) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += k[2] & 0xffffff; + b += k[1]; + a += k[0]; + break; + case 10: + c += k[2] & 0xffff; + b += k[1]; + a += k[0]; + break; + case 9: + c += k[2] & 0xff; + b += k[1]; + a += k[0]; + break; + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += k[1] & 0xffffff; + a += k[0]; + break; + case 6: + b += k[1] & 0xffff; + a += k[0]; + break; + case 5: + b += k[1] & 0xff; + a += k[0]; + break; + case 4: + a += k[0]; + break; + case 3: + a += k[0] & 0xffffff; + break; + case 2: + a += k[0] & 0xffff; + break; + case 1: + a += k[0] & 0xff; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } #else /* make valgrind happy */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]; break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ - case 1 : a+=k8[0]; break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } + k8 = ( const uint8_t * ) k; + switch ( length ) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += ( ( uint32_t ) k8[10] ) << 16; /* fall through */ + case 10: + c += ( ( uint32_t ) k8[9] ) << 8; /* fall through */ + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += ( ( uint32_t ) k8[6] ) << 16; /* fall through */ + case 6: + b += ( ( uint32_t ) k8[5] ) << 8; /* fall through */ + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0]; + break; + case 3: + a += ( ( uint32_t ) k8[2] ) << 16; /* fall through */ + case 2: + a += ( ( uint32_t ) k8[1] ) << 8; /* fall through */ + case 1: + a += k8[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } #endif /* !valgrind */ - } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { - const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ - const uint8_t *k8; + } else if ( HASH_LITTLE_ENDIAN && ( ( u.i & 0x1 ) == 0 ) ) { + const uint16_t *k = ( const uint16_t * ) key; /* read 16-bit chunks */ + const uint8_t *k8; /*--------------- all but last block: aligned reads and different mixing */ - while (length > 12) - { - a += k[0] + (((uint32_t)k[1])<<16); - b += k[2] + (((uint32_t)k[3])<<16); - c += k[4] + (((uint32_t)k[5])<<16); - mix(a,b,c); - length -= 12; - k += 6; - } + while ( length > 12 ) { + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + c += k[4] + ( ( ( uint32_t ) k[5] ) << 16 ); + mix( a, b, c ); + length -= 12; + k += 6; + } /*----------------------------- handle the last (probably partial) block */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[4]+(((uint32_t)k[5])<<16); - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=k[4]; - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=k[2]; - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=k[0]; - break; - case 1 : a+=k8[0]; - break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } + k8 = ( const uint8_t * ) k; + switch ( length ) { + case 12: + c += k[4] + ( ( ( uint32_t ) k[5] ) << 16 ); + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 11: + c += ( ( uint32_t ) k8[10] ) << 16; /* fall through */ + case 10: + c += k[4]; + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[2] + ( ( ( uint32_t ) k[3] ) << 16 ); + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 7: + b += ( ( uint32_t ) k8[6] ) << 16; /* fall through */ + case 6: + b += k[2]; + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0] + ( ( ( uint32_t ) k[1] ) << 16 ); + break; + case 3: + a += ( ( uint32_t ) k8[2] ) << 16; /* fall through */ + case 2: + a += k[0]; + break; + case 1: + a += k8[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } - } else { /* need to read the key one byte at a time */ - const uint8_t *k = (const uint8_t *)key; + } else { /* need to read the key one byte at a time */ + const uint8_t *k = ( const uint8_t * ) key; /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - a += ((uint32_t)k[1])<<8; - a += ((uint32_t)k[2])<<16; - a += ((uint32_t)k[3])<<24; - b += k[4]; - b += ((uint32_t)k[5])<<8; - b += ((uint32_t)k[6])<<16; - b += ((uint32_t)k[7])<<24; - c += k[8]; - c += ((uint32_t)k[9])<<8; - c += ((uint32_t)k[10])<<16; - c += ((uint32_t)k[11])<<24; - mix(a,b,c); - length -= 12; - k += 12; - } + while ( length > 12 ) { + a += k[0]; + a += ( ( uint32_t ) k[1] ) << 8; + a += ( ( uint32_t ) k[2] ) << 16; + a += ( ( uint32_t ) k[3] ) << 24; + b += k[4]; + b += ( ( uint32_t ) k[5] ) << 8; + b += ( ( uint32_t ) k[6] ) << 16; + b += ( ( uint32_t ) k[7] ) << 24; + c += k[8]; + c += ( ( uint32_t ) k[9] ) << 8; + c += ( ( uint32_t ) k[10] ) << 16; + c += ( ( uint32_t ) k[11] ) << 24; + mix( a, b, c ); + length -= 12; + k += 12; + } /*-------------------------------- last block: affect all 32 bits of (c) */ - switch(length) /* all the case statements fall through */ - { - case 12: c+=((uint32_t)k[11])<<24; - case 11: c+=((uint32_t)k[10])<<16; - case 10: c+=((uint32_t)k[9])<<8; - case 9 : c+=k[8]; - case 8 : b+=((uint32_t)k[7])<<24; - case 7 : b+=((uint32_t)k[6])<<16; - case 6 : b+=((uint32_t)k[5])<<8; - case 5 : b+=k[4]; - case 4 : a+=((uint32_t)k[3])<<24; - case 3 : a+=((uint32_t)k[2])<<16; - case 2 : a+=((uint32_t)k[1])<<8; - case 1 : a+=k[0]; - break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ + switch ( length ) { /* all the case statements fall through */ + case 12: + c += ( ( uint32_t ) k[11] ) << 24; + case 11: + c += ( ( uint32_t ) k[10] ) << 16; + case 10: + c += ( ( uint32_t ) k[9] ) << 8; + case 9: + c += k[8]; + case 8: + b += ( ( uint32_t ) k[7] ) << 24; + case 7: + b += ( ( uint32_t ) k[6] ) << 16; + case 6: + b += ( ( uint32_t ) k[5] ) << 8; + case 5: + b += k[4]; + case 4: + a += ( ( uint32_t ) k[3] ) << 24; + case 3: + a += ( ( uint32_t ) k[2] ) << 16; + case 2: + a += ( ( uint32_t ) k[1] ) << 8; + case 1: + a += k[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } } - } - final(a,b,c); - *pc=c; *pb=b; + final( a, b, c ); + *pc = c; + *pb = b; } @@ -641,147 +804,214 @@ void hashlittle2( * from hashlittle() on all machines. hashbig() takes advantage of * big-endian byte ordering. */ -uint32_t hashbig( const void *key, size_t length, uint32_t initval) -{ - uint32_t a,b,c; - union { const void *ptr; size_t i; } u; /* to cast key to (size_t) happily */ +uint32_t hashbig( const void *key, size_t length, uint32_t initval ) { + uint32_t a, b, c; + union { + const void *ptr; + size_t i; + } u; /* to cast key to (size_t) happily */ - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)length) + initval; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ( ( uint32_t ) length ) + initval; - u.ptr = key; - if (HASH_BIG_ENDIAN && ((u.i & 0x3) == 0)) { - const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ - const uint8_t *k8; + u.ptr = key; + if ( HASH_BIG_ENDIAN && ( ( u.i & 0x3 ) == 0 ) ) { + const uint32_t *k = ( const uint32_t * ) key; /* read 32-bit chunks */ + const uint8_t *k8; /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 12; - k += 3; - } + while ( length > 12 ) { + a += k[0]; + b += k[1]; + c += k[2]; + mix( a, b, c ); + length -= 12; + k += 3; + } /*----------------------------- handle the last (probably partial) block */ - /* - * "k[2]<<8" actually reads beyond the end of the string, but - * then shifts out the part it's not allowed to read. Because the - * string is aligned, the illegal read is in the same word as the - * rest of the string. Every machine with memory protection I've seen - * does it on word boundaries, so is OK with this. But VALGRIND will - * still catch it and complain. The masking trick does make the hash - * noticably faster for short strings (like English words). - */ + /* + * "k[2]<<8" actually reads beyond the end of the string, but + * then shifts out the part it's not allowed to read. Because the + * string is aligned, the illegal read is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ #ifndef VALGRIND - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=k[2]&0xffffff00; b+=k[1]; a+=k[0]; break; - case 10: c+=k[2]&0xffff0000; b+=k[1]; a+=k[0]; break; - case 9 : c+=k[2]&0xff000000; b+=k[1]; a+=k[0]; break; - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=k[1]&0xffffff00; a+=k[0]; break; - case 6 : b+=k[1]&0xffff0000; a+=k[0]; break; - case 5 : b+=k[1]&0xff000000; a+=k[0]; break; - case 4 : a+=k[0]; break; - case 3 : a+=k[0]&0xffffff00; break; - case 2 : a+=k[0]&0xffff0000; break; - case 1 : a+=k[0]&0xff000000; break; - case 0 : return c; /* zero length strings require no mixing */ - } + switch ( length ) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += k[2] & 0xffffff00; + b += k[1]; + a += k[0]; + break; + case 10: + c += k[2] & 0xffff0000; + b += k[1]; + a += k[0]; + break; + case 9: + c += k[2] & 0xff000000; + b += k[1]; + a += k[0]; + break; + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += k[1] & 0xffffff00; + a += k[0]; + break; + case 6: + b += k[1] & 0xffff0000; + a += k[0]; + break; + case 5: + b += k[1] & 0xff000000; + a += k[0]; + break; + case 4: + a += k[0]; + break; + case 3: + a += k[0] & 0xffffff00; + break; + case 2: + a += k[0] & 0xffff0000; + break; + case 1: + a += k[0] & 0xff000000; + break; + case 0: + return c; /* zero length strings require no mixing */ + } -#else /* make valgrind happy */ +#else /* make valgrind happy */ - k8 = (const uint8_t *)k; - switch(length) /* all the case statements fall through */ - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=((uint32_t)k8[10])<<8; /* fall through */ - case 10: c+=((uint32_t)k8[9])<<16; /* fall through */ - case 9 : c+=((uint32_t)k8[8])<<24; /* fall through */ - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=((uint32_t)k8[6])<<8; /* fall through */ - case 6 : b+=((uint32_t)k8[5])<<16; /* fall through */ - case 5 : b+=((uint32_t)k8[4])<<24; /* fall through */ - case 4 : a+=k[0]; break; - case 3 : a+=((uint32_t)k8[2])<<8; /* fall through */ - case 2 : a+=((uint32_t)k8[1])<<16; /* fall through */ - case 1 : a+=((uint32_t)k8[0])<<24; break; - case 0 : return c; - } + k8 = ( const uint8_t * ) k; + switch ( length ) { /* all the case statements fall through */ + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += ( ( uint32_t ) k8[10] ) << 8; /* fall through */ + case 10: + c += ( ( uint32_t ) k8[9] ) << 16; /* fall through */ + case 9: + c += ( ( uint32_t ) k8[8] ) << 24; /* fall through */ + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += ( ( uint32_t ) k8[6] ) << 8; /* fall through */ + case 6: + b += ( ( uint32_t ) k8[5] ) << 16; /* fall through */ + case 5: + b += ( ( uint32_t ) k8[4] ) << 24; /* fall through */ + case 4: + a += k[0]; + break; + case 3: + a += ( ( uint32_t ) k8[2] ) << 8; /* fall through */ + case 2: + a += ( ( uint32_t ) k8[1] ) << 16; /* fall through */ + case 1: + a += ( ( uint32_t ) k8[0] ) << 24; + break; + case 0: + return c; + } #endif /* !VALGRIND */ - } else { /* need to read the key one byte at a time */ - const uint8_t *k = (const uint8_t *)key; + } else { /* need to read the key one byte at a time */ + const uint8_t *k = ( const uint8_t * ) key; /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ - while (length > 12) - { - a += ((uint32_t)k[0])<<24; - a += ((uint32_t)k[1])<<16; - a += ((uint32_t)k[2])<<8; - a += ((uint32_t)k[3]); - b += ((uint32_t)k[4])<<24; - b += ((uint32_t)k[5])<<16; - b += ((uint32_t)k[6])<<8; - b += ((uint32_t)k[7]); - c += ((uint32_t)k[8])<<24; - c += ((uint32_t)k[9])<<16; - c += ((uint32_t)k[10])<<8; - c += ((uint32_t)k[11]); - mix(a,b,c); - length -= 12; - k += 12; - } + while ( length > 12 ) { + a += ( ( uint32_t ) k[0] ) << 24; + a += ( ( uint32_t ) k[1] ) << 16; + a += ( ( uint32_t ) k[2] ) << 8; + a += ( ( uint32_t ) k[3] ); + b += ( ( uint32_t ) k[4] ) << 24; + b += ( ( uint32_t ) k[5] ) << 16; + b += ( ( uint32_t ) k[6] ) << 8; + b += ( ( uint32_t ) k[7] ); + c += ( ( uint32_t ) k[8] ) << 24; + c += ( ( uint32_t ) k[9] ) << 16; + c += ( ( uint32_t ) k[10] ) << 8; + c += ( ( uint32_t ) k[11] ); + mix( a, b, c ); + length -= 12; + k += 12; + } /*-------------------------------- last block: affect all 32 bits of (c) */ - switch(length) /* all the case statements fall through */ - { - case 12: c+=k[11]; - case 11: c+=((uint32_t)k[10])<<8; - case 10: c+=((uint32_t)k[9])<<16; - case 9 : c+=((uint32_t)k[8])<<24; - case 8 : b+=k[7]; - case 7 : b+=((uint32_t)k[6])<<8; - case 6 : b+=((uint32_t)k[5])<<16; - case 5 : b+=((uint32_t)k[4])<<24; - case 4 : a+=k[3]; - case 3 : a+=((uint32_t)k[2])<<8; - case 2 : a+=((uint32_t)k[1])<<16; - case 1 : a+=((uint32_t)k[0])<<24; - break; - case 0 : return c; + switch ( length ) { /* all the case statements fall through */ + case 12: + c += k[11]; + case 11: + c += ( ( uint32_t ) k[10] ) << 8; + case 10: + c += ( ( uint32_t ) k[9] ) << 16; + case 9: + c += ( ( uint32_t ) k[8] ) << 24; + case 8: + b += k[7]; + case 7: + b += ( ( uint32_t ) k[6] ) << 8; + case 6: + b += ( ( uint32_t ) k[5] ) << 16; + case 5: + b += ( ( uint32_t ) k[4] ) << 24; + case 4: + a += k[3]; + case 3: + a += ( ( uint32_t ) k[2] ) << 8; + case 2: + a += ( ( uint32_t ) k[1] ) << 16; + case 1: + a += ( ( uint32_t ) k[0] ) << 24; + break; + case 0: + return c; + } } - } - final(a,b,c); - return c; + final( a, b, c ); + return c; } #ifdef SELF_TEST /* used for timings */ -void driver1() -{ - uint8_t buf[256]; - uint32_t i; - uint32_t h=0; - time_t a,z; +void driver1( ) { + uint8_t buf[256]; + uint32_t i; + uint32_t h = 0; + time_t a, z; - time(&a); - for (i=0; i<256; ++i) buf[i] = 'x'; - for (i=0; i<1; ++i) - { - h = hashlittle(&buf[0],1,h); - } - time(&z); - if (z-a > 0) printf("time %d %.8x\n", z-a, h); + time( &a ); + for ( i = 0; i < 256; ++i ) + buf[i] = 'x'; + for ( i = 0; i < 1; ++i ) { + h = hashlittle( &buf[0], 1, h ); + } + time( &z ); + if ( z - a > 0 ) + printf( "time %d %.8x\n", z - a, h ); } /* check that every input bit changes every output bit half the time */ @@ -789,213 +1019,263 @@ void driver1() #define HASHLEN 1 #define MAXPAIR 60 #define MAXLEN 70 -void driver2() -{ - uint8_t qa[MAXLEN+1], qb[MAXLEN+2], *a = &qa[0], *b = &qb[1]; - uint32_t c[HASHSTATE], d[HASHSTATE], i=0, j=0, k, l, m=0, z; - uint32_t e[HASHSTATE],f[HASHSTATE],g[HASHSTATE],h[HASHSTATE]; - uint32_t x[HASHSTATE],y[HASHSTATE]; - uint32_t hlen; +void driver2( ) { + uint8_t qa[MAXLEN + 1], qb[MAXLEN + 2], *a = &qa[0], *b = &qb[1]; + uint32_t c[HASHSTATE], d[HASHSTATE], i = 0, j = 0, k, l, m = 0, z; + uint32_t e[HASHSTATE], f[HASHSTATE], g[HASHSTATE], h[HASHSTATE]; + uint32_t x[HASHSTATE], y[HASHSTATE]; + uint32_t hlen; - printf("No more than %d trials should ever be needed \n",MAXPAIR/2); - for (hlen=0; hlen < MAXLEN; ++hlen) - { - z=0; - for (i=0; i>(8-j)); - c[0] = hashlittle(a, hlen, m); - b[i] ^= ((k+1)<>(8-j)); - d[0] = hashlittle(b, hlen, m); - /* check every bit is 1, 0, set, and not set at least once */ - for (l=0; lz) z=k; - if (k==MAXPAIR) - { - printf("Some bit didn't change: "); - printf("%.8x %.8x %.8x %.8x %.8x %.8x ", - e[0],f[0],g[0],h[0],x[0],y[0]); - printf("i %d j %d m %d len %d\n", i, j, m, hlen); - } - if (z==MAXPAIR) goto done; - } - } + /*---- check that every output bit is affected by that input bit */ + for ( k = 0; k < MAXPAIR; k += 2 ) { + uint32_t finished = 1; + /* keys have one bit different */ + for ( l = 0; l < hlen + 1; ++l ) { + a[l] = b[l] = ( uint8_t ) 0; + } + /* have a and b be two keys differing in only one bit */ + a[i] ^= ( k << j ); + a[i] ^= ( k >> ( 8 - j ) ); + c[0] = hashlittle( a, hlen, m ); + b[i] ^= ( ( k + 1 ) << j ); + b[i] ^= ( ( k + 1 ) >> ( 8 - j ) ); + d[0] = hashlittle( b, hlen, m ); + /* check every bit is 1, 0, set, and not set at least once */ + for ( l = 0; l < HASHSTATE; ++l ) { + e[l] &= ( c[l] ^ d[l] ); + f[l] &= ~( c[l] ^ d[l] ); + g[l] &= c[l]; + h[l] &= ~c[l]; + x[l] &= d[l]; + y[l] &= ~d[l]; + if ( e[l] | f[l] | g[l] | h[l] | x[l] | y[l] ) + finished = 0; + } + if ( finished ) + break; + } + if ( k > z ) + z = k; + if ( k == MAXPAIR ) { + printf( "Some bit didn't change: " ); + printf( "%.8x %.8x %.8x %.8x %.8x %.8x ", + e[0], f[0], g[0], h[0], x[0], y[0] ); + printf( "i %d j %d m %d len %d\n", i, j, m, hlen ); + } + if ( z == MAXPAIR ) + goto done; + } + } + } + done: + if ( z < MAXPAIR ) { + printf( "Mix success %2d bytes %2d initvals ", i, m ); + printf( "required %d trials\n", z / 2 ); + } } - done: - if (z < MAXPAIR) - { - printf("Mix success %2d bytes %2d initvals ",i,m); - printf("required %d trials\n", z/2); - } - } - printf("\n"); + printf( "\n" ); } /* Check for reading beyond the end of the buffer and alignment problems */ -void driver3() -{ - uint8_t buf[MAXLEN+20], *b; - uint32_t len; - uint8_t q[] = "This is the time for all good men to come to the aid of their country..."; - uint32_t h; - uint8_t qq[] = "xThis is the time for all good men to come to the aid of their country..."; - uint32_t i; - uint8_t qqq[] = "xxThis is the time for all good men to come to the aid of their country..."; - uint32_t j; - uint8_t qqqq[] = "xxxThis is the time for all good men to come to the aid of their country..."; - uint32_t ref,x,y; - uint8_t *p; +void driver3( ) { + uint8_t buf[MAXLEN + 20], *b; + uint32_t len; + uint8_t q[] = + "This is the time for all good men to come to the aid of their country..."; + uint32_t h; + uint8_t qq[] = + "xThis is the time for all good men to come to the aid of their country..."; + uint32_t i; + uint8_t qqq[] = + "xxThis is the time for all good men to come to the aid of their country..."; + uint32_t j; + uint8_t qqqq[] = + "xxxThis is the time for all good men to come to the aid of their country..."; + uint32_t ref, x, y; + uint8_t *p; - printf("Endianness. These lines should all be the same (for values filled in):\n"); - printf("%.8x %.8x %.8x\n", - hashword((const uint32_t *)q, (sizeof(q)-1)/4, 13), - hashword((const uint32_t *)q, (sizeof(q)-5)/4, 13), - hashword((const uint32_t *)q, (sizeof(q)-9)/4, 13)); - p = q; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qq[1]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qqq[2]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qqqq[3]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - printf("\n"); + printf + ( "Endianness. These lines should all be the same (for values filled in):\n" ); + printf + ( "%.8x %.8x %.8x\n", + hashword( ( const uint32_t * ) q, ( sizeof( q ) - 1 ) / 4, 13 ), + hashword( ( const uint32_t * ) q, ( sizeof( q ) - 5 ) / 4, 13 ), + hashword( ( const uint32_t * ) q, ( sizeof( q ) - 9 ) / 4, 13 ) ); + p = q; + printf( "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle( p, sizeof( q ) - 1, 13 ), hashlittle( p, + sizeof( q ) - 2, + 13 ), + hashlittle( p, sizeof( q ) - 3, 13 ), hashlittle( p, + sizeof( q ) - 4, + 13 ), + hashlittle( p, sizeof( q ) - 5, 13 ), hashlittle( p, + sizeof( q ) - 6, + 13 ), + hashlittle( p, sizeof( q ) - 7, 13 ), hashlittle( p, + sizeof( q ) - 8, + 13 ), + hashlittle( p, sizeof( q ) - 9, 13 ), hashlittle( p, + sizeof( q ) - 10, + 13 ), + hashlittle( p, sizeof( q ) - 11, 13 ), hashlittle( p, + sizeof( q ) - + 12, 13 ) ); + p = &qq[1]; + printf( "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle( p, sizeof( q ) - 1, 13 ), hashlittle( p, + sizeof( q ) - 2, + 13 ), + hashlittle( p, sizeof( q ) - 3, 13 ), hashlittle( p, + sizeof( q ) - 4, + 13 ), + hashlittle( p, sizeof( q ) - 5, 13 ), hashlittle( p, + sizeof( q ) - 6, + 13 ), + hashlittle( p, sizeof( q ) - 7, 13 ), hashlittle( p, + sizeof( q ) - 8, + 13 ), + hashlittle( p, sizeof( q ) - 9, 13 ), hashlittle( p, + sizeof( q ) - 10, + 13 ), + hashlittle( p, sizeof( q ) - 11, 13 ), hashlittle( p, + sizeof( q ) - + 12, 13 ) ); + p = &qqq[2]; + printf( "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle( p, sizeof( q ) - 1, 13 ), hashlittle( p, + sizeof( q ) - 2, + 13 ), + hashlittle( p, sizeof( q ) - 3, 13 ), hashlittle( p, + sizeof( q ) - 4, + 13 ), + hashlittle( p, sizeof( q ) - 5, 13 ), hashlittle( p, + sizeof( q ) - 6, + 13 ), + hashlittle( p, sizeof( q ) - 7, 13 ), hashlittle( p, + sizeof( q ) - 8, + 13 ), + hashlittle( p, sizeof( q ) - 9, 13 ), hashlittle( p, + sizeof( q ) - 10, + 13 ), + hashlittle( p, sizeof( q ) - 11, 13 ), hashlittle( p, + sizeof( q ) - + 12, 13 ) ); + p = &qqqq[3]; + printf( "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle( p, sizeof( q ) - 1, 13 ), hashlittle( p, + sizeof( q ) - 2, + 13 ), + hashlittle( p, sizeof( q ) - 3, 13 ), hashlittle( p, + sizeof( q ) - 4, + 13 ), + hashlittle( p, sizeof( q ) - 5, 13 ), hashlittle( p, + sizeof( q ) - 6, + 13 ), + hashlittle( p, sizeof( q ) - 7, 13 ), hashlittle( p, + sizeof( q ) - 8, + 13 ), + hashlittle( p, sizeof( q ) - 9, 13 ), hashlittle( p, + sizeof( q ) - 10, + 13 ), + hashlittle( p, sizeof( q ) - 11, 13 ), hashlittle( p, + sizeof( q ) - + 12, 13 ) ); + printf( "\n" ); - /* check that hashlittle2 and hashlittle produce the same results */ - i=47; j=0; - hashlittle2(q, sizeof(q), &i, &j); - if (hashlittle(q, sizeof(q), 47) != i) - printf("hashlittle2 and hashlittle mismatch\n"); + /* check that hashlittle2 and hashlittle produce the same results */ + i = 47; + j = 0; + hashlittle2( q, sizeof( q ), &i, &j ); + if ( hashlittle( q, sizeof( q ), 47 ) != i ) + printf( "hashlittle2 and hashlittle mismatch\n" ); - /* check that hashword2 and hashword produce the same results */ - len = 0xdeadbeef; - i=47, j=0; - hashword2(&len, 1, &i, &j); - if (hashword(&len, 1, 47) != i) - printf("hashword2 and hashword mismatch %x %x\n", - i, hashword(&len, 1, 47)); + /* check that hashword2 and hashword produce the same results */ + len = 0xdeadbeef; + i = 47, j = 0; + hashword2( &len, 1, &i, &j ); + if ( hashword( &len, 1, 47 ) != i ) + printf( "hashword2 and hashword mismatch %x %x\n", + i, hashword( &len, 1, 47 ) ); - /* check hashlittle doesn't read before or after the ends of the string */ - for (h=0, b=buf+1; h<8; ++h, ++b) - { - for (i=0; iheader.tag.value ) { - case HASHTV: - free_hashmap( pointer ); - break; - case STACKFRAMETV: - free_stack_frame( get_stack_frame( pointer ) ); - break; - } + switch ( vso->header.tag.value ) { + case HASHTV: + free_hashmap( pointer ); + break; + case STACKFRAMETV: + free_stack_frame( get_stack_frame( pointer ) ); + break; + } // free( (void *)cell.payload.vectorp.address ); - debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n", - cell.payload.vectorp.address ); + debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n", + cell.payload.vectorp.address ); } // bool check_vso_tag( struct cons_pointer pointer, char * tag) { diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index 2eea84d..3265225 100644 --- a/src/memory/vectorspace.h +++ b/src/memory/vectorspace.h @@ -61,7 +61,7 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ); -void free_vso(struct cons_pointer pointer); +void free_vso( struct cons_pointer pointer ); /** * the header which forms the start of every vector space object. @@ -86,18 +86,16 @@ struct vector_space_header { * i.e. either an assoc list or a further hashmap. */ struct hashmap_payload { - struct cons_pointer - hash_fn; /* function for hashing values in this hashmap, or `NIL` to use - the default hashing function */ - struct cons_pointer write_acl; /* it seems to me that it is likely that the - * principal difference between a hashmap and a - * namespace is that a hashmap has a write ACL - * of `NIL`, meaning not writeable by anyone */ - uint32_t n_buckets; /* number of hash buckets */ - uint32_t unused; /* for word alignment and possible later expansion */ - struct cons_pointer - buckets[]; /* actual hash buckets, which should be `NIL` - * or assoc lists or (possibly) further hashmaps. */ + struct cons_pointer hash_fn; /* function for hashing values in this hashmap, or `NIL` to use + the default hashing function */ + struct cons_pointer write_acl; /* it seems to me that it is likely that the + * principal difference between a hashmap and a + * namespace is that a hashmap has a write ACL + * of `NIL`, meaning not writeable by anyone */ + uint32_t n_buckets; /* number of hash buckets */ + uint32_t unused; /* for word alignment and possible later expansion */ + struct cons_pointer buckets[]; /* actual hash buckets, which should be `NIL` + * or assoc lists or (possibly) further hashmaps. */ }; diff --git a/src/ops/equal.c b/src/ops/equal.c index feffb93..a02acc8 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -20,9 +20,8 @@ * Shallow, and thus cheap, equality: true if these two objects are * the same object, else false. */ -bool eq(struct cons_pointer a, struct cons_pointer b) -{ - return ((a.page == b.page) && (a.offset == b.offset)); +bool eq( struct cons_pointer a, struct cons_pointer b ) { + return ( ( a.page == b.page ) && ( a.offset == b.offset ) ); } /** @@ -32,10 +31,9 @@ bool eq(struct cons_pointer a, struct cons_pointer b) * @return true if the objects at these two cons pointers have the same tag, * else false. */ -bool same_type(struct cons_pointer a, struct cons_pointer b) -{ - struct cons_space_object *cell_a = &pointer2cell(a); - struct cons_space_object *cell_b = &pointer2cell(b); +bool same_type( struct cons_pointer a, struct cons_pointer b ) { + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); return cell_a->tag.value == cell_b->tag.value; } @@ -45,104 +43,95 @@ bool same_type(struct cons_pointer a, struct cons_pointer b) * @param string the string to test * @return true if it's the end of a string. */ -bool end_of_string(struct cons_pointer string) -{ - return nilp(string) || - pointer2cell(string).payload.string.character == '\0'; +bool end_of_string( struct cons_pointer string ) { + return nilp( string ) || + pointer2cell( string ).payload.string.character == '\0'; } /** * Deep, and thus expensive, equality: true if these two objects have * identical structure, else false. */ -bool equal(struct cons_pointer a, struct cons_pointer b) -{ - bool result = eq(a, b); +bool equal( struct cons_pointer a, struct cons_pointer b ) { + bool result = eq( a, b ); - if (!result && same_type(a, b)) - { - struct cons_space_object *cell_a = &pointer2cell(a); - struct cons_space_object *cell_b = &pointer2cell(b); + if ( !result && same_type( a, b ) ) { + struct cons_space_object *cell_a = &pointer2cell( a ); + struct cons_space_object *cell_b = &pointer2cell( b ); - switch (cell_a->tag.value) - { - case CONSTV: - case LAMBDATV: - case NLAMBDATV: - /* TODO: it is not OK to do this on the stack since list-like - * structures can be of indefinite extent. It *must* be done by - * iteration (and even that is problematic) */ - result = - equal(cell_a->payload.cons.car, cell_b->payload.cons.car) && equal(cell_a->payload.cons.cdr, - cell_b->payload.cons.cdr); - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - /* slightly complex because a string may or may not have a '\0' - * cell at the end, but I'll ignore that for now. I think in - * practice only the empty string will. - */ - /* TODO: it is not OK to do this on the stack since list-like - * structures can be of indefinite extent. It *must* be done by - * iteration (and even that is problematic) */ - result = - cell_a->payload.string.character == + switch ( cell_a->tag.value ) { + case CONSTV: + case LAMBDATV: + case NLAMBDATV: + /* TODO: it is not OK to do this on the stack since list-like + * structures can be of indefinite extent. It *must* be done by + * iteration (and even that is problematic) */ + result = + equal( cell_a->payload.cons.car, cell_b->payload.cons.car ) + && equal( cell_a->payload.cons.cdr, + cell_b->payload.cons.cdr ); + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + /* slightly complex because a string may or may not have a '\0' + * cell at the end, but I'll ignore that for now. I think in + * practice only the empty string will. + */ + /* TODO: it is not OK to do this on the stack since list-like + * structures can be of indefinite extent. It *must* be done by + * iteration (and even that is problematic) */ + result = + cell_a->payload.string.character == cell_b->payload.string.character && - (equal(cell_a->payload.string.cdr, - cell_b->payload.string.cdr) || - (end_of_string(cell_a->payload.string.cdr) && end_of_string(cell_b->payload.string.cdr))); - break; - case INTEGERTV: - result = - (cell_a->payload.integer.value == - cell_b->payload.integer.value) && - equal(cell_a->payload.integer.more, - cell_b->payload.integer.more); - break; - case RATIOTV: - result = equal_ratio_ratio(a, b); - break; - case REALTV: - { - double num_a = to_long_double(a); - double num_b = to_long_double(b); - double max = - fabs(num_a) > - fabs(num_b) - ? fabs(num_a) - : fabs(num_b); + ( equal( cell_a->payload.string.cdr, + cell_b->payload.string.cdr ) || + ( end_of_string( cell_a->payload.string.cdr ) + && end_of_string( cell_b->payload.string.cdr ) ) ); + break; + case INTEGERTV: + result = + ( cell_a->payload.integer.value == + cell_b->payload.integer.value ) && + equal( cell_a->payload.integer.more, + cell_b->payload.integer.more ); + break; + case RATIOTV: + result = equal_ratio_ratio( a, b ); + break; + case REALTV: + { + double num_a = to_long_double( a ); + double num_b = to_long_double( b ); + double max = fabs( num_a ) > fabs( num_b ) + ? fabs( num_a ) + : fabs( num_b ); - /* - * not more different than one part in a million - close enough - */ - result = fabs(num_a - num_b) < (max / 1000000.0); + /* + * not more different than one part in a million - close enough + */ + result = fabs( num_a - num_b ) < ( max / 1000000.0 ); + } + break; + default: + result = false; + break; } - break; - default: - result = false; - break; - } - } - else if (numberp(a) && numberp(b)) - { - if (integerp(a)) - { - result = equal_integer_real(a, b); - } - else if (integerp(b)) - { - result = equal_integer_real(b, a); + } else if ( numberp( a ) && numberp( b ) ) { + if ( integerp( a ) ) { + result = equal_integer_real( a, b ); + } else if ( integerp( b ) ) { + result = equal_integer_real( b, a ); } } /* - * there's only supposed ever to be one T and one NIL cell, so each - * should be caught by eq; equality of vector-space objects is a whole - * other ball game so we won't deal with it now (and indeed may never). - * I'm not certain what equality means for read and write streams, so - * I'll ignore them, too, for now. - */ + * there's only supposed ever to be one T and one NIL cell, so each + * should be caught by eq; equality of vector-space objects is a whole + * other ball game so we won't deal with it now (and indeed may never). + * I'm not certain what equality means for read and write streams, so + * I'll ignore them, too, for now. + */ return result; } diff --git a/src/ops/intern.c b/src/ops/intern.c index 07b9693..d7b81c6 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -89,16 +89,16 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { * of that key from the store; otherwise return NIL. */ struct cons_pointer c_assoc( struct cons_pointer key, - struct cons_pointer store ) { + struct cons_pointer store ) { struct cons_pointer result = NIL; - debug_print( L"c_assoc; key is `", DEBUG_BIND); - debug_print_object( key, DEBUG_BIND); - debug_print( L"`\n", DEBUG_BIND); + debug_print( L"c_assoc; key is `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); - if (consp(store)) { + if ( consp( store ) ) { for ( struct cons_pointer next = store; - consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { + consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { struct cons_space_object entry = pointer2cell( pointer2cell( next ).payload.cons.car ); @@ -107,15 +107,17 @@ struct cons_pointer c_assoc( struct cons_pointer key, break; } } - } else if (hashmapp( store)) { - result = hashmap_get( store, key); + } else if ( hashmapp( store ) ) { + result = hashmap_get( store, key ); } else { - result = throw_exception(c_string_to_lisp_string(L"Store is of unknown type"), NIL); + result = + throw_exception( c_string_to_lisp_string + ( L"Store is of unknown type" ), NIL ); } - debug_print( L"c_assoc returning ", DEBUG_BIND); - debug_print_object( result, DEBUG_BIND); - debug_println( DEBUG_BIND); + debug_print( L"c_assoc returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_println( DEBUG_BIND ); return result; } @@ -125,8 +127,8 @@ struct cons_pointer c_assoc( struct cons_pointer key, * with this key/value pair added to the front. */ struct cons_pointer - set( struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store ) { +set( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { struct cons_pointer result = NIL; debug_print( L"set: binding `", DEBUG_BIND ); @@ -134,18 +136,18 @@ struct cons_pointer debug_print( L"` to `", DEBUG_BIND ); debug_print_object( value, DEBUG_BIND ); debug_print( L"` in store ", DEBUG_BIND ); - debug_dump_object( store, DEBUG_BIND); + debug_dump_object( store, DEBUG_BIND ); debug_println( DEBUG_BIND ); - if (nilp( store) || consp(store)) { + if ( nilp( store ) || consp( store ) ) { result = make_cons( make_cons( key, value ), store ); - } else if (hashmapp( store)) { - result = hashmap_put( store, key, value); + } else if ( hashmapp( store ) ) { + result = hashmap_put( store, key, value ); } - debug_print( L"set returning ", DEBUG_BIND); - debug_print_object( result, DEBUG_BIND); - debug_println( DEBUG_BIND); + debug_print( L"set returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_println( DEBUG_BIND ); return result; } @@ -195,4 +197,3 @@ intern( struct cons_pointer key, struct cons_pointer environment ) { return result; } - diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 474784d..454fb9a 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -106,7 +106,7 @@ struct cons_pointer eval_forms( struct stack_frame *frame, list = c_cdr( list ); } - return c_reverse( result); + return c_reverse( result ); } /** @@ -121,19 +121,18 @@ struct cons_pointer eval_forms( struct stack_frame *frame, * * This is experimental. It almost certainly WILL change. */ -struct cons_pointer lisp_try(struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env) { - struct cons_pointer result = c_progn(frame, frame_pointer, frame->arg[0], env); +struct cons_pointer lisp_try( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = + c_progn( frame, frame_pointer, frame->arg[0], env ); - if (exceptionp(result)) - { + if ( exceptionp( result ) ) { // TODO: need to put the exception into the environment! - result = c_progn(frame, frame_pointer, frame->arg[1], - make_cons( - make_cons(c_string_to_lisp_keyword(L"*exception*"), - result), - env)); + result = c_progn( frame, frame_pointer, frame->arg[1], + make_cons( make_cons + ( c_string_to_lisp_keyword + ( L"*exception*" ), result ), env ) ); } return result; @@ -282,8 +281,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, result = eval_form( frame, frame_pointer, sexpr, new_env ); - if (exceptionp(result)) - { + if ( exceptionp( result ) ) { break; } } @@ -306,8 +304,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, * @return the result of evaluating the function with its arguments. */ struct cons_pointer - c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { +c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { debug_print( L"Entering c_apply\n", DEBUG_EVAL ); struct cons_pointer result = NIL; @@ -322,122 +320,124 @@ struct cons_pointer switch ( fn_cell.tag.value ) { case EXCEPTIONTV: - /* just pass exceptions straight back */ - result = fn_pointer; - break; + /* just pass exceptions straight back */ + result = fn_pointer; + break; case FUNCTIONTV: - { - struct cons_pointer exep = NIL; - struct cons_pointer next_pointer = - make_stack_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { - struct stack_frame *next = - get_stack_frame( next_pointer ); + { + struct cons_pointer exep = NIL; + struct cons_pointer next_pointer = + make_stack_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { + struct stack_frame *next = + get_stack_frame( next_pointer ); - result = - ( *fn_cell.payload.function.executable ) ( next, - next_pointer, - env ); - dec_ref( next_pointer ); - } - } - break; - - case KEYTV: - result = c_assoc( fn_pointer, - eval_form(frame, - frame_pointer, - c_car( c_cdr( frame->arg[0])), - env)); - break; - - case LAMBDATV: - { - struct cons_pointer exep = NIL; - struct cons_pointer next_pointer = - make_stack_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { - struct stack_frame *next = - get_stack_frame( next_pointer ); - result = - eval_lambda( fn_cell, next, next_pointer, env ); - if ( !exceptionp( result ) ) { + result = + ( *fn_cell.payload.function.executable ) ( next, + next_pointer, + env ); dec_ref( next_pointer ); } } - } - break; + break; + + case KEYTV: + result = c_assoc( fn_pointer, + eval_form( frame, + frame_pointer, + c_car( c_cdr( frame->arg[0] ) ), + env ) ); + break; + + case LAMBDATV: + { + struct cons_pointer exep = NIL; + struct cons_pointer next_pointer = + make_stack_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { + struct stack_frame *next = + get_stack_frame( next_pointer ); + result = + eval_lambda( fn_cell, next, next_pointer, env ); + if ( !exceptionp( result ) ) { + dec_ref( next_pointer ); + } + } + } + break; case VECTORPOINTTV: - switch ( pointer_to_vso(fn_pointer)->header.tag.value) { - case HASHTV: - /* \todo: if arg[0] is a CONS, treat it as a path */ - result = c_assoc( eval_form(frame, - frame_pointer, - c_car( c_cdr( frame->arg[0])), - env), - fn_pointer); + switch ( pointer_to_vso( fn_pointer )->header.tag.value ) { + case HASHTV: + /* \todo: if arg[0] is a CONS, treat it as a path */ + result = c_assoc( eval_form( frame, + frame_pointer, + c_car( c_cdr + ( frame-> + arg[0] ) ), + env ), fn_pointer ); + break; + } break; - } - break; case NLAMBDATV: - { - struct cons_pointer next_pointer = - make_special_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { - struct stack_frame *next = - get_stack_frame( next_pointer ); - result = - eval_lambda( fn_cell, next, next_pointer, env ); - dec_ref( next_pointer ); + { + struct cons_pointer next_pointer = + make_special_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { + struct stack_frame *next = + get_stack_frame( next_pointer ); + result = + eval_lambda( fn_cell, next, next_pointer, env ); + dec_ref( next_pointer ); + } } - } - break; + break; case SPECIALTV: - { - struct cons_pointer next_pointer = - make_special_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { - result = - ( *fn_cell.payload.special. - executable ) ( get_stack_frame( next_pointer ), - next_pointer, env ); - debug_print( L"Special form returning: ", DEBUG_EVAL ); - debug_print_object( result, DEBUG_EVAL ); - debug_println( DEBUG_EVAL ); - dec_ref( next_pointer ); + { + struct cons_pointer next_pointer = + make_special_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { + result = + ( *fn_cell.payload. + special.executable ) ( get_stack_frame + ( next_pointer ), + next_pointer, env ); + debug_print( L"Special form returning: ", DEBUG_EVAL ); + debug_print_object( result, DEBUG_EVAL ); + debug_println( DEBUG_EVAL ); + dec_ref( next_pointer ); + } } - } - break; + break; default: - { - int bs = sizeof( wchar_t ) * 1024; - wchar_t *buffer = malloc( bs ); - memset( buffer, '\0', bs ); - swprintf( buffer, bs, - L"Unexpected cell with tag %d (%4.4s) in function position", - fn_cell.tag.value, &fn_cell.tag.bytes[0] ); - struct cons_pointer message = - c_string_to_lisp_string( buffer ); - free( buffer ); - result = throw_exception( message, frame_pointer ); - } + { + int bs = sizeof( wchar_t ) * 1024; + wchar_t *buffer = malloc( bs ); + memset( buffer, '\0', bs ); + swprintf( buffer, bs, + L"Unexpected cell with tag %d (%4.4s) in function position", + fn_cell.tag.value, &fn_cell.tag.bytes[0] ); + struct cons_pointer message = + c_string_to_lisp_string( buffer ); + free( buffer ); + result = throw_exception( message, frame_pointer ); + } } } @@ -479,7 +479,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, switch ( cell.tag.value ) { case CONSTV: - result = c_apply( frame, frame_pointer, env ); + result = c_apply( frame, frame_pointer, env ); break; case SYMBOLTV: @@ -781,9 +781,10 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, * @param env my environment (ignored). * @return the length of `any`, if it is a sequence, or zero otherwise. */ -struct cons_pointer lisp_length( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { - return make_integer( c_length( frame->arg[0]), NIL); +struct cons_pointer lisp_length( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_integer( c_length( frame->arg[0] ), NIL ); } /** @@ -802,24 +803,24 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer, return c_assoc( frame->arg[0], frame->arg[1] ); } -struct cons_pointer c_keys(struct cons_pointer store) { - struct cons_pointer result = NIL; +struct cons_pointer c_keys( struct cons_pointer store ) { + struct cons_pointer result = NIL; - if ( hashmapp( store ) ) { - result = hashmap_keys( store ); - } else if ( consp( store ) ) { - for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) { - result = make_cons( c_car( c ), result ); + if ( hashmapp( store ) ) { + result = hashmap_keys( store ); + } else if ( consp( store ) ) { + for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) { + result = make_cons( c_car( c ), result ); + } } - } - return result; + return result; } struct cons_pointer lisp_keys( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - return c_keys( frame->arg[0]); + return c_keys( frame->arg[0] ); } /** @@ -962,26 +963,26 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - debug_print( L"Entering lisp_inspect\n", DEBUG_IO ); - struct cons_pointer result = NIL; - struct cons_pointer out_stream = writep( frame->arg[1] ) - ? frame->arg[1] - : get_default_stream( false, env ); - URL_FILE *output; + debug_print( L"Entering lisp_inspect\n", DEBUG_IO ); + struct cons_pointer result = NIL; + struct cons_pointer out_stream = writep( frame->arg[1] ) + ? frame->arg[1] + : get_default_stream( false, env ); + URL_FILE *output; - if ( writep( out_stream ) ) { - debug_print( L"lisp_inspect: setting output stream\n", DEBUG_IO ); - debug_dump_object( out_stream, DEBUG_IO ); - output = pointer2cell( out_stream ).payload.stream.stream; - } else { - output = file_to_url_file( stderr ); - } + if ( writep( out_stream ) ) { + debug_print( L"lisp_inspect: setting output stream\n", DEBUG_IO ); + debug_dump_object( out_stream, DEBUG_IO ); + output = pointer2cell( out_stream ).payload.stream.stream; + } else { + output = file_to_url_file( stderr ); + } - dump_object( output, frame->arg[0] ); + dump_object( output, frame->arg[0] ); - debug_print( L"Leaving lisp_inspect", DEBUG_IO ); + debug_print( L"Leaving lisp_inspect", DEBUG_IO ); - return result; + return result; } /** @@ -1064,7 +1065,7 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, result = eval_form( frame, frame_pointer, c_car( expressions ), env ); dec_ref( r ); - expressions = exceptionp(result) ? NIL : c_cdr( expressions ); + expressions = exceptionp( result ) ? NIL : c_cdr( expressions ); } return result; @@ -1332,7 +1333,7 @@ struct cons_pointer lisp_source( struct stack_frame *frame, case SPECIALTV: result = c_assoc( source_key, cell.payload.special.meta ); break; - case LAMBDATV: + case LAMBDATV: result = make_cons( c_string_to_lisp_symbol( L"lambda" ), make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 014df2e..c1cc337 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -127,8 +127,8 @@ struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer lisp_inspect( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); diff --git a/src/time/psse_time.c b/src/time/psse_time.c index e37e522..1f24b0e 100644 --- a/src/time/psse_time.c +++ b/src/time/psse_time.c @@ -28,42 +28,44 @@ * PSSE Lisp epoch is 14 Bn years, or 441,806,400,000,000,000 seconds, before * the UNIX epoch; the value in microseconds will break the C reader. */ -unsigned __int128 epoch_offset = ((__int128)(seconds_per_year * 1000000000L) * - (__int128)(14L * 1000000000L)); +unsigned __int128 epoch_offset = + ( ( __int128 ) ( seconds_per_year * 1000000000L ) * + ( __int128 ) ( 14L * 1000000000L ) ); /** * Return the UNIX time value which represents this time, if it falls within * the period representable in UNIX time, or zero otherwise. */ -long int lisp_time_to_unix_time(struct cons_pointer t) { +long int lisp_time_to_unix_time( struct cons_pointer t ) { long int result = 0; - if (timep( t)) { - unsigned __int128 value = pointer2cell(t).payload.time.value; + if ( timep( t ) ) { + unsigned __int128 value = pointer2cell( t ).payload.time.value; - if (value > epoch_offset) { // \todo && value < UNIX time rollover - result = ((value - epoch_offset) / 1000000000); + if ( value > epoch_offset ) { // \todo && value < UNIX time rollover + result = ( ( value - epoch_offset ) / 1000000000 ); } } return result; } -unsigned __int128 unix_time_to_lisp_time( time_t t) { - unsigned __int128 result = epoch_offset + (t * 1000000000); +unsigned __int128 unix_time_to_lisp_time( time_t t ) { + unsigned __int128 result = epoch_offset + ( t * 1000000000 ); return result; } -struct cons_pointer make_time( struct cons_pointer integer_or_nil) { +struct cons_pointer make_time( struct cons_pointer integer_or_nil ) { struct cons_pointer pointer = allocate_cell( TIMETV ); struct cons_space_object *cell = &pointer2cell( pointer ); - if (integerp(integer_or_nil)) { - cell->payload.time.value = pointer2cell(integer_or_nil).payload.integer.value; + if ( integerp( integer_or_nil ) ) { + cell->payload.time.value = + pointer2cell( integer_or_nil ).payload.integer.value; // \todo: if integer is a bignum, deal with it. } else { - cell->payload.time.value = unix_time_to_lisp_time( time(NULL)); + cell->payload.time.value = unix_time_to_lisp_time( time( NULL ) ); } return pointer; @@ -82,25 +84,26 @@ struct cons_pointer make_time( struct cons_pointer integer_or_nil) { * is that number of microseconds after the notional big bang; else the current * time. */ -struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { - return make_time( frame->arg[0]); +struct cons_pointer lisp_time( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_time( frame->arg[0] ); } /** * This is temporary, for bootstrapping. */ -struct cons_pointer time_to_string( struct cons_pointer pointer) { +struct cons_pointer time_to_string( struct cons_pointer pointer ) { struct cons_pointer result = NIL; - long int t = lisp_time_to_unix_time(pointer); + long int t = lisp_time_to_unix_time( pointer ); - if ( t != 0) { - char * bytes = ctime(&t); - int l = strlen(bytes) + 1; - wchar_t buffer[ l]; + if ( t != 0 ) { + char *bytes = ctime( &t ); + int l = strlen( bytes ) + 1; + wchar_t buffer[l]; - mbstowcs( buffer, bytes, l); - result = c_string_to_lisp_string( buffer); + mbstowcs( buffer, bytes, l ); + result = c_string_to_lisp_string( buffer ); } return result; diff --git a/src/time/psse_time.h b/src/time/psse_time.h index af70966..f2afdd2 100644 --- a/src/time/psse_time.h +++ b/src/time/psse_time.h @@ -13,8 +13,9 @@ #define _GNU_SOURCE #include "consspaceobject.h" -struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); -struct cons_pointer time_to_string( struct cons_pointer pointer); +struct cons_pointer lisp_time( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer time_to_string( struct cons_pointer pointer ); #endif From b6ae110f66ac1c85f1f9b00e45db1610c198608d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 18 Aug 2021 11:00:47 +0100 Subject: [PATCH 13/90] Hybrid assoc lists --- docs/Hybrid-assoc-lists.md | 40 ++++++++++++++++++ src/ops/equal.c | 1 + src/ops/intern.c | 85 +++++++++++++++++++++----------------- 3 files changed, 89 insertions(+), 37 deletions(-) create mode 100644 docs/Hybrid-assoc-lists.md diff --git a/docs/Hybrid-assoc-lists.md b/docs/Hybrid-assoc-lists.md new file mode 100644 index 0000000..5bb6ca8 --- /dev/null +++ b/docs/Hybrid-assoc-lists.md @@ -0,0 +1,40 @@ +# Hybrid assoc lists + +In it's current very prototype stage, PSSE has to forms of name/value store. One is the assoc list, the other is the hashmap. + +An assoc (association) list is a list of the form: + + ((name1 . value1)(name2 . value2)(name3 . value3)...) + +Hashmaps have many very clear advantages, but assoc lists have one which is very important in the evaluation environment, and that is precisely its sequentiality. Thus, if the same name is bound twice on an assoc list, the value nearest the head is the one which will be recovered: + + (assoc :bar '((:foo . 1) (:bar . "Hello there!")(:ban . 3)(:bar . 2))) + => "Hello there!" + +Why does this matter? Well, for precisely the same reason it matters when a UNIX system searches for an executable. + +Suppose Clare is a user who trusts both Alice and Bob, but she trusts Alice more than Bob. Suppose both Alice and Bob have written implementations of a function called `froboz`. Suppose Clare invokes + + (froboz 3) + +Which implementation of `froboz` should be evaluated? An assoc list makes that simple. If Clare binds Alice's implementation into her environment later than Bob's, Alice's will be the one found. + +But an assoc list is also fearsomely inefficient, especially if we are in a system with many thousands of names, each of which may be bound multiple times in typical runtime environment. + +How to resolve this? How to get some of the benefits of sequential access of assoc lists, with some of the efficiency benefits of hashmaps? What I'm going to propose is a **hybrid assoc list**, that is to say, a list whose members are either + +1. (key . value) pairs, or else +2. hashmaps. + +So suppose we have a list, `l`, thus: + + ((:foo . 1) (:bar . 2) {:foo "not this" :ban 3} (:ban . "not this either") (:froboz . 4)) + +Then: + + (assoc :foo l) => 1 + (assoc :bar l) => 2 + (assoc :ban l) => 3 + (assoc :froboz l) => 4 + +This will make the implementation of namespaces and search paths vastly easier. \ No newline at end of file diff --git a/src/ops/equal.c b/src/ops/equal.c index a02acc8..36f73ed 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -82,6 +82,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { * structures can be of indefinite extent. It *must* be done by * iteration (and even that is problematic) */ result = + cell_a->payload.string.hash == cell_b->payload.string.hash && cell_a->payload.string.character == cell_b->payload.string.character && ( equal( cell_a->payload.string.cdr, diff --git a/src/ops/intern.c b/src/ops/intern.c index d7b81c6..e541bdf 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -90,56 +90,67 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { */ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - debug_print( L"c_assoc; key is `", DEBUG_BIND ); - debug_print_object( key, DEBUG_BIND ); - debug_print( L"`\n", DEBUG_BIND ); + debug_print( L"c_assoc; key is `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); - if ( consp( store ) ) { - for ( struct cons_pointer next = store; - consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { - struct cons_space_object entry = - pointer2cell( pointer2cell( next ).payload.cons.car ); + if ( consp( store ) ) { + for ( struct cons_pointer next = store; + nilp( result ) && ( consp( next ) || hashmapp( next ) ); + next = pointer2cell( next ).payload.cons.cdr ) { + if ( consp( next ) ) { + struct cons_pointer entry_ptr = c_car( next ); + struct cons_space_object entry = pointer2cell( entry_ptr ); + switch ( entry.tag.value ) { + case CONSTV: if ( equal( key, entry.payload.cons.car ) ) { - result = entry.payload.cons.cdr; - break; + result = entry.payload.cons.cdr; } + break; + case VECTORPOINTTV: + result = hashmap_get( entry_ptr, key ); + break; + default: + throw_exception( + c_string_to_lisp_string( L"Store entry is of unknown type" ), + NIL ); } - } else if ( hashmapp( store ) ) { - result = hashmap_get( store, key ); - } else { - result = - throw_exception( c_string_to_lisp_string - ( L"Store is of unknown type" ), NIL ); + } } + } else if ( hashmapp( store ) ) { + result = hashmap_get( store, key ); + } else if (!nilp(store)) { + result = throw_exception( + c_string_to_lisp_string( L"Store is of unknown type" ), NIL ); + } - debug_print( L"c_assoc returning ", DEBUG_BIND ); - debug_print_object( result, DEBUG_BIND ); - debug_println( DEBUG_BIND ); + debug_print( L"c_assoc returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_println( DEBUG_BIND ); - return result; + return result; } -/** - * Return a new key/value store containing all the key/value pairs in this store - * with this key/value pair added to the front. - */ -struct cons_pointer -set( struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store ) { - struct cons_pointer result = NIL; + /** + * Return a new key/value store containing all the key/value pairs in this + * store with this key/value pair added to the front. + */ + struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { + struct cons_pointer result = NIL; - debug_print( L"set: binding `", DEBUG_BIND ); - debug_print_object( key, DEBUG_BIND ); - debug_print( L"` to `", DEBUG_BIND ); - debug_print_object( value, DEBUG_BIND ); - debug_print( L"` in store ", DEBUG_BIND ); - debug_dump_object( store, DEBUG_BIND ); - debug_println( DEBUG_BIND ); + debug_print( L"set: binding `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` to `", DEBUG_BIND ); + debug_print_object( value, DEBUG_BIND ); + debug_print( L"` in store ", DEBUG_BIND ); + debug_dump_object( store, DEBUG_BIND ); + debug_println( DEBUG_BIND ); - if ( nilp( store ) || consp( store ) ) { + if ( nilp( store ) || consp( store ) ) { result = make_cons( make_cons( key, value ), store ); } else if ( hashmapp( store ) ) { result = hashmap_put( store, key, value ); From 5c6ac7f75dcb07478e6ade237b85be92221fe52b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 18 Aug 2021 13:40:35 +0100 Subject: [PATCH 14/90] Making progress on paths! --- docs/How-do-we-notate-paths.md | 89 +++++++++++++++++++++++++++++++++ src/memory/hashmap.c | 13 +++-- src/ops/equal.c | 16 +++--- src/ops/intern.c | 91 +++++++++++++++++----------------- src/ops/lispops.c | 6 +-- 5 files changed, 153 insertions(+), 62 deletions(-) create mode 100644 docs/How-do-we-notate-paths.md diff --git a/docs/How-do-we-notate-paths.md b/docs/How-do-we-notate-paths.md new file mode 100644 index 0000000..7cdbcb0 --- /dev/null +++ b/docs/How-do-we-notate-paths.md @@ -0,0 +1,89 @@ +# How do we notate paths? + +In order to make the namespaces thing work, we need a convenient way to notate paths from the current namespace to a target, or from the root to a target. This is similar to relative and absolute paths in UNIX, except that in PSSE there is no concept of a single or privileged ancestor namespace to the current namespace, so you have no equivalent of `../`. + +In this discussion, a **namespace** is just a named, mutable hashmap (but not necessarily mutable by all users; indeed namespaces will almost always be mutable only by selected users. I cannot presently see a justified use for a publicly writable namespace). '**Named**', of a hashmap, merely means there is some path from the privileged root namespace which is the value of `oblist` which leads to that hashmap. A **path** is in principle just a sequence of keys, such that the value of each successive key is bound to a namespace in the namespace bound by its predecessor. The evaluable implementation of paths will be discussed later. + +I think also that there must be a privileged **session** namespace, containing information about the current session, which the user can read but not write. + +## Security considerations + +What's important is that a user cannot rebind privileged names in their own environment. Thus to ensure privileged names, such names must be paths either from the `oblist`or from the current session. So we need magic, privileged notations for these things built into the reader, which cannot be overridden. + +This kind of takes away from my general feeling that users should be able to override *anything*. but hey, that's engineering for you. + +Users should be able to override reader macros generally; a programmable reader is in the medium term something which should be implemented. But the privileged syntax for paths should not be overridable. + +## Current state of the reader + +At present, you can rebind the value of the symbol `oblist` in the runtime environment. In principle, you should be able to rebind any symbol. Paths and symbols are not the same. + +At present, the colon character is a separator character. So if you type + +> (list :foo:bar:ban) + +the reader will return + +> (list :foo :bar :ban) + +That's significant, and helpful. + +## Constructing path notation + +The Clojure threading macro, `->`, is a useful example of how we can implement this. Essentially it takes a expression as its first argument, passes the value of that expression to the function which is its second argument, the value of that as argument to the function which is its next, and so on. Given that, in Clojure, an expression which has a keyword in the function position and a hashmap in the argument position will return the value of that keyword in that hashmap, this means that, given the hashmap + +> (def x {:foo {:bar {:ban "Howzat!!"}}}) + +the expression + +> (-> x :foo :bar :ban) + +will return + +> "Howzat!!" + +So, in general, if we implement the 'keyword in the function position' `eval` hack and the threading macro, then something like + +> (-> oblist :users :simon :functions 'foo) + +should return the value of the symbol `foo` in the `:functions` of the user called `:simon`. + +That's stage one of our goal. + +Stage two of our goal is that a stream of non-separator characters separated by colons should be interpreted as a list of keywords. Thus typing + +> :foo:bar:ban + +should result in not just `:foo`being read, but the list `(:foo :bar :ban)`(? not sure about this) + +Stage 3 is to allow a symbol to be appended to a sequence of keywords written by using `/`as a separator, so + +> :foo:bar/ban + +would be read as `(:foo :bar 'ban)` + +Finally, we need privileged notation for root (oblist) and for session. There are very few non-alpha-numeric characters which are available on a standard keyboard and which are not already used as significant lexical characters in Lisp readers. PSSE is not limited, of course, to the characters which are part of the ASCII character set, but it is helpful to use symbols which are reasonably convenient to type, possibly with special keyboard bindings. + +So I'm going to propose that the reader should interpret + +> /:users:simon:functions/assoc + +as + +> (-> oblist :users :simon :functions 'assoc) + +where `oblist` is the actual privileged global object list, not just the current binding of `oblist` in the environment. Thus, this expression would return my personal version of the function `assoc`, whatever the symbol `assoc` was bound to in the runtime environment. + +The use of the leading slash here follows UNIX convention. + +I'm going to suggest that the session is referenced by the character §, otherwise known as the 'silcrow'. This is not available on most keyboard mappings, so a custom mapping might be needed, or we might have to fall back on `$`. + +Thus the reader should interpret + +> §:user + +as + +> (-> session :user) + +where `session`is again a system privileged value, not the binding of `session` in the current environment. \ No newline at end of file diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 2e68cda..efc0e88 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -110,10 +110,10 @@ struct cons_pointer lisp_get_hash( struct stack_frame *frame, struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer hash_fn, struct cons_pointer write_acl ) { - struct cons_pointer result = - make_vso( HASHTV, - ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) + - ( sizeof( uint32_t ) * 2 ) ); + struct cons_pointer result = make_vso( HASHTV, + ( sizeof( struct cons_pointer ) * + ( n_buckets + 1 ) ) + + ( sizeof( uint32_t ) * 2 ) ); struct hashmap_payload *payload = ( struct hashmap_payload * ) &pointer_to_vso( result )->payload; @@ -175,9 +175,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, struct cons_pointer val = c_cdr( pair ); uint32_t bucket_no = - get_hash( key ) % - ( ( struct hashmap_payload * ) &( map->payload ) )-> - n_buckets; + get_hash( key ) % ( ( struct hashmap_payload * ) + &( map->payload ) )->n_buckets; map->payload.hashmap.buckets[bucket_no] = inc_ref( make_cons( make_cons( key, val ), diff --git a/src/ops/equal.c b/src/ops/equal.c index 36f73ed..39d80af 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -82,13 +82,15 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { * structures can be of indefinite extent. It *must* be done by * iteration (and even that is problematic) */ result = - cell_a->payload.string.hash == cell_b->payload.string.hash && - cell_a->payload.string.character == - cell_b->payload.string.character && - ( equal( cell_a->payload.string.cdr, - cell_b->payload.string.cdr ) || - ( end_of_string( cell_a->payload.string.cdr ) - && end_of_string( cell_b->payload.string.cdr ) ) ); + cell_a->payload.string.hash == cell_b->payload.string.hash + && cell_a->payload.string.character == + cell_b->payload.string.character + && + ( equal + ( cell_a->payload.string.cdr, + cell_b->payload.string.cdr ) + || ( end_of_string( cell_a->payload.string.cdr ) + && end_of_string( cell_b->payload.string.cdr ) ) ); break; case INTEGERTV: result = diff --git a/src/ops/intern.c b/src/ops/intern.c index e541bdf..d7a6c0d 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -90,67 +90,68 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { */ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - debug_print( L"c_assoc; key is `", DEBUG_BIND ); - debug_print_object( key, DEBUG_BIND ); - debug_print( L"`\n", DEBUG_BIND ); + debug_print( L"c_assoc; key is `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); - if ( consp( store ) ) { - for ( struct cons_pointer next = store; - nilp( result ) && ( consp( next ) || hashmapp( next ) ); - next = pointer2cell( next ).payload.cons.cdr ) { - if ( consp( next ) ) { - struct cons_pointer entry_ptr = c_car( next ); - struct cons_space_object entry = pointer2cell( entry_ptr ); + if ( consp( store ) ) { + for ( struct cons_pointer next = store; + nilp( result ) && ( consp( next ) || hashmapp( next ) ); + next = pointer2cell( next ).payload.cons.cdr ) { + if ( consp( next ) ) { + struct cons_pointer entry_ptr = c_car( next ); + struct cons_space_object entry = pointer2cell( entry_ptr ); - switch ( entry.tag.value ) { - case CONSTV: - if ( equal( key, entry.payload.cons.car ) ) { - result = entry.payload.cons.cdr; + switch ( entry.tag.value ) { + case CONSTV: + if ( equal( key, entry.payload.cons.car ) ) { + result = entry.payload.cons.cdr; + } + break; + case VECTORPOINTTV: + result = hashmap_get( entry_ptr, key ); + break; + default: + throw_exception( c_string_to_lisp_string + ( L"Store entry is of unknown type" ), + NIL ); + } } - break; - case VECTORPOINTTV: - result = hashmap_get( entry_ptr, key ); - break; - default: - throw_exception( - c_string_to_lisp_string( L"Store entry is of unknown type" ), - NIL ); } - } + } else if ( hashmapp( store ) ) { + result = hashmap_get( store, key ); + } else if ( !nilp( store ) ) { + result = + throw_exception( c_string_to_lisp_string + ( L"Store is of unknown type" ), NIL ); } - } else if ( hashmapp( store ) ) { - result = hashmap_get( store, key ); - } else if (!nilp(store)) { - result = throw_exception( - c_string_to_lisp_string( L"Store is of unknown type" ), NIL ); - } - debug_print( L"c_assoc returning ", DEBUG_BIND ); - debug_print_object( result, DEBUG_BIND ); - debug_println( DEBUG_BIND ); + debug_print( L"c_assoc returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_println( DEBUG_BIND ); - return result; + return result; } /** * Return a new key/value store containing all the key/value pairs in this * store with this key/value pair added to the front. */ - struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store ) { - struct cons_pointer result = NIL; +struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { + struct cons_pointer result = NIL; - debug_print( L"set: binding `", DEBUG_BIND ); - debug_print_object( key, DEBUG_BIND ); - debug_print( L"` to `", DEBUG_BIND ); - debug_print_object( value, DEBUG_BIND ); - debug_print( L"` in store ", DEBUG_BIND ); - debug_dump_object( store, DEBUG_BIND ); - debug_println( DEBUG_BIND ); + debug_print( L"set: binding `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` to `", DEBUG_BIND ); + debug_print_object( value, DEBUG_BIND ); + debug_print( L"` in store ", DEBUG_BIND ); + debug_dump_object( store, DEBUG_BIND ); + debug_println( DEBUG_BIND ); - if ( nilp( store ) || consp( store ) ) { + if ( nilp( store ) || consp( store ) ) { result = make_cons( make_cons( key, value ), store ); } else if ( hashmapp( store ) ) { result = hashmap_put( store, key, value ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 454fb9a..b173090 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -380,9 +380,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = c_assoc( eval_form( frame, frame_pointer, c_car( c_cdr - ( frame-> - arg[0] ) ), - env ), fn_pointer ); + ( frame->arg + [0] ) ), env ), + fn_pointer ); break; } break; From c63c262b740024dccfec261185fa520876d5354f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 18 Aug 2021 18:48:05 +0100 Subject: [PATCH 15/90] Compact path notation now expands correctly --- src/init.c | 5 ++ src/io/read.c | 97 ++++++++++++++++++++++++++++++++++++- src/memory/hashmap.c | 2 +- src/ops/intern.c | 9 ++-- src/repl.c | 8 ++- unit-tests/map.sh | 1 + unit-tests/path-notation.sh | 31 ++++++++++++ 7 files changed, 145 insertions(+), 8 deletions(-) create mode 100755 unit-tests/path-notation.sh diff --git a/src/init.c b/src/init.c index ca48b9d..dbd7acf 100644 --- a/src/init.c +++ b/src/init.c @@ -163,6 +163,9 @@ int main( int argc, char *argv[] ) { debug_print( L"Initialised cons pages, about to bind\n", DEBUG_BOOTSTRAP ); +// TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly +// oblist = inc_ref( make_hashmap( 32, NIL, TRUE ) ); + /* * privileged variables (keywords) */ @@ -271,7 +274,9 @@ int main( int argc, char *argv[] ) { bind_special( L"set!", &lisp_set_shriek ); debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); + repl( show_prompt ); + debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP ); dec_ref( oblist ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); diff --git a/src/io/read.c b/src/io/read.c index 9c87932..4425b77 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -60,6 +60,77 @@ struct cons_pointer c_quote( struct cons_pointer arg ) { make_cons( arg, NIL ) ); } +/** + * Read a path macro from the stream. A path macro is expected to be + * 1. optionally a leading character such as '/' or '$', followed by + * 2. one or more keywords with leading colons (':') but no intervening spaces; or + * 3. one or more symbols separated by slashes; or + * 4. keywords (with leading colons) interspersed with symbols (prefixed by slashes). + */ +struct cons_pointer read_path( URL_FILE * input, wint_t initial, + struct cons_pointer q ) { + bool done = false; + struct cons_pointer prefix = NIL; + + switch ( initial ) { + case '/': + prefix = c_string_to_lisp_symbol( L"oblist" ); + break; + case '$': + case L'§': + prefix = c_string_to_lisp_symbol( L"session" ); + break; + } + + while ( !done ) { + wint_t c = url_fgetwc( input ); + if ( iswblank( c ) || iswcntrl( c ) ) { + done = true; + } else if ( url_feof( input ) ) { + done = true; + } else { + switch ( c ) { + case ':': + q = make_cons( read_symbol_or_key + ( input, KEYTV, url_fgetwc( input ) ), q ); + break; + case '/': + q = make_cons( make_cons + ( c_string_to_lisp_symbol( L"quote" ), + make_cons( read_symbol_or_key + ( input, SYMBOLTV, + url_fgetwc( input ) ), + NIL ) ), q ); + break; + default: + if ( iswalpha( c ) ) { + q = make_cons( read_symbol_or_key + ( input, SYMBOLTV, c ), q ); + } else { + // TODO: it's really an error. Exception? + url_ungetwc( c, input ); + done = true; + } + } + } + } + + // right, we now have the path we want (reversed) in q. + struct cons_pointer r = NIL; + + for ( struct cons_pointer p = q; !nilp( p ); p = c_cdr( p ) ) { + r = make_cons( c_car( p ), r ); + } + + dec_ref( q ); + + if ( !nilp( prefix ) ) { + r = make_cons( prefix, r ); + } + + return make_cons( c_string_to_lisp_symbol( L"->" ), r ); +} + /** * Read the next object on this input stream and return a cons_pointer to it, * treating this initial character as the first character of the object @@ -149,6 +220,27 @@ struct cons_pointer read_continuation( struct stack_frame *frame, result = read_symbol_or_key( input, KEYTV, url_fgetwc( input ) ); break; + case '/': + { + /* slash followed by whitespace is legit provided it's not + * preceded by anything - it's the division operator. Otherwise, + * it's terminal, probably part of a path, and needs pushed back. + */ + wint_t cn = url_fgetwc( input ); + if ( nilp( result ) + && ( iswblank( cn ) || iswcntrl( cn ) ) ) { + url_ungetwc( cn, input ); + result = make_symbol_or_key( c, NIL, SYMBOLTV ); + } else { + url_ungetwc( cn, input ); + result = read_path( input, c, NIL ); + } + } + break; + case '$': + case L'§': + result = read_path( input, c, NIL ); + break; default: if ( iswdigit( c ) ) { result = @@ -398,9 +490,10 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, /* unwise to allow embedded quotation marks in symbols */ case ')': case ':': + case '/': /* - * symbols and keywords may not include right-parenthesis - * or colons. + * symbols and keywords may not include right-parenthesis, + * slashes or colons. */ result = NIL; /* diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index efc0e88..cee9267 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -112,7 +112,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer write_acl ) { struct cons_pointer result = make_vso( HASHTV, ( sizeof( struct cons_pointer ) * - ( n_buckets + 1 ) ) + + ( n_buckets + 2 ) ) + ( sizeof( uint32_t ) * 2 ) ); struct hashmap_payload *payload = diff --git a/src/ops/intern.c b/src/ops/intern.c index d7a6c0d..05d5822 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -25,7 +25,7 @@ #include "equal.h" #include "hashmap.h" #include "lispops.h" -#include "print.h" +// #include "print.h" /** * The global object list/or, to put it differently, the root namespace. @@ -181,8 +181,11 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_println( DEBUG_BIND ); oblist = set( key, value, oblist ); - inc_ref( oblist ); - dec_ref( old ); + + if ( consp( oblist ) ) { + inc_ref( oblist ); + dec_ref( old ); + } debug_print( L"deep_bind returning ", DEBUG_BIND ); debug_print_object( oblist, DEBUG_BIND ); diff --git a/src/repl.c b/src/repl.c index 0ea104d..39bbde6 100644 --- a/src/repl.c +++ b/src/repl.c @@ -24,12 +24,16 @@ void repl( ) { debug_print( L"Entered repl\n", DEBUG_REPL ); - struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, oblist ); + struct cons_pointer env = + consp( oblist ) ? oblist : make_cons( oblist, NIL ); + + /* bottom of stack */ + struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env ); if ( !nilp( frame_pointer ) ) { inc_ref( frame_pointer ); - lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, oblist ); + lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env ); dec_ref( frame_pointer ); } diff --git a/unit-tests/map.sh b/unit-tests/map.sh index c5fb834..65dc182 100755 --- a/unit-tests/map.sh +++ b/unit-tests/map.sh @@ -5,6 +5,7 @@ expected='{}' actual=`echo "$expected" | target/psse | tail -1` +echo -n "Empty map using compact map notation: " if [ "${expected}" = "${actual}" ] then echo "OK" diff --git a/unit-tests/path-notation.sh b/unit-tests/path-notation.sh new file mode 100755 index 0000000..a6cb669 --- /dev/null +++ b/unit-tests/path-notation.sh @@ -0,0 +1,31 @@ +#!/bin/bash + +##################################################################### +# Create a path from root using compact path notation +expected='(-> oblist :users :simon :functions (quote assoc))' +actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1` + +echo -n "Path from root (oblist) using compact notation: " +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +##################################################################### +# Create a path from the current session using compact path notation +expected='(-> session :input-stream)' +actual=`echo "'$:input-stream" | target/psse | tail -1` + +echo -n "Path from current session using compact notation: " +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + + From 6771d6494c5b95d1adc7029aa8920e763d0a71b6 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 23 Aug 2021 12:35:05 +0100 Subject: [PATCH 16/90] Append works; mapcar doesn't; loop isn't even written. --- src/init.c | 2 + src/io/io.c | 4 +- src/memory/consspaceobject.h | 13 ++-- src/memory/dump.c | 8 +-- src/memory/hashmap.c | 4 +- src/ops/lispops.c | 121 +++++++++++++++++++++++++++++------ src/ops/lispops.h | 9 +++ src/ops/loop.c | 50 +++++++++++++++ src/ops/loop.h | 10 +++ unit-tests/append.sh | 24 +++++++ 10 files changed, 213 insertions(+), 32 deletions(-) create mode 100644 src/ops/loop.c create mode 100644 src/ops/loop.h create mode 100755 unit-tests/append.sh diff --git a/src/init.c b/src/init.c index dbd7acf..5e8a55d 100644 --- a/src/init.c +++ b/src/init.c @@ -220,6 +220,7 @@ int main( int argc, char *argv[] ) { */ bind_function( L"absolute", &lisp_absolute ); bind_function( L"add", &lisp_add ); + bind_function( L"append", &lisp_append ); bind_function( L"apply", &lisp_apply ); bind_function( L"assoc", &lisp_assoc ); bind_function( L"car", &lisp_car ); @@ -235,6 +236,7 @@ int main( int argc, char *argv[] ) { bind_function( L"hashmap", lisp_make_hashmap ); bind_function( L"inspect", &lisp_inspect ); bind_function( L"keys", &lisp_keys ); + bind_function( L"mapcar", &lisp_mapcar ); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); bind_function( L"multiply", &lisp_multiply ); diff --git a/src/io/io.c b/src/io/io.c index f621539..72830a4 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -503,8 +503,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( frame->arg[0] ) ) { result = make_string( url_fgetwc - ( pointer2cell( frame->arg[0] ).payload.stream. - stream ), NIL ); + ( pointer2cell( frame->arg[0] ).payload. + stream.stream ), NIL ); } return result; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 2817e69..7c3a390 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -114,12 +114,12 @@ * A loop exit is a special kind of exception which has exactly the same * payload as an exception. */ -#define LOOPXTAG "LOOX" +#define LOOPTAG "LOOP" /** * The string `LOOX`, considered as an `unsigned int`. */ -#define LOOPXTV 1481592652 +#define LOOPTV 1347374924 /** * The special cons cell at address {0,0} whose car and cdr both point to @@ -304,9 +304,9 @@ #define lambdap(conspoint) (check_tag(conspoint,LAMBDATV)) /** - * true if `conspoint` points to a loop exit exception, else false. + * true if `conspoint` points to a loop recursion, else false. */ -#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTV)) +#define loopp(conspoint) (check_tag(conspoint,LOOPTV)) /** * true if `conspoint` points to a special form cell, else false @@ -615,7 +615,7 @@ struct cons_space_object { */ struct cons_payload cons; /** - * if tag == EXCEPTIONTAG || tag == LOOPXTAG + * if tag == EXCEPTIONTAG || tag == LOOPTAG */ struct exception_payload exception; /** @@ -713,6 +713,9 @@ struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer, struct cons_pointer ) ); +struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, + uint32_t tag ); + struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, diff --git a/src/memory/dump.c b/src/memory/dump.c index 086f8c8..81182a8 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -114,10 +114,10 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { case RATIOTV: url_fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ).payload. - integer.value, - pointer2cell( cell.payload.ratio.divisor ).payload. - integer.value, cell.count ); + pointer2cell( cell.payload.ratio.dividend ). + payload.integer.value, + pointer2cell( cell.payload.ratio.divisor ). + payload.integer.value, cell.count ); break; case READTV: url_fputws( L"\t\tInput stream; metadata: ", output ); diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index cee9267..d6909ba 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -180,8 +180,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, map->payload.hashmap.buckets[bucket_no] = inc_ref( make_cons( make_cons( key, val ), - map->payload.hashmap. - buckets[bucket_no] ) ); + map->payload. + hashmap.buckets[bucket_no] ) ); } } } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index b173090..2356abe 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -413,10 +413,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload.special. + executable ) ( get_stack_frame( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -904,26 +903,30 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, /** - * reverse a sequence. + * reverse a sequence (if it is a sequence); else return it unchanged. */ struct cons_pointer c_reverse( struct cons_pointer arg ) { struct cons_pointer result = NIL; - for ( struct cons_pointer p = arg; sequencep( p ); p = c_cdr( p ) ) { - struct cons_space_object o = pointer2cell( p ); - switch ( o.tag.value ) { - case CONSTV: - result = make_cons( o.payload.cons.car, result ); - break; - case STRINGTV: - result = make_string( o.payload.string.character, result ); - break; - case SYMBOLTV: - result = - make_symbol_or_key( o.payload.string.character, result, - SYMBOLTV ); - break; + if ( sequencep( arg ) ) { + for ( struct cons_pointer p = arg; sequencep( p ); p = c_cdr( p ) ) { + struct cons_space_object o = pointer2cell( p ); + switch ( o.tag.value ) { + case CONSTV: + result = make_cons( o.payload.cons.car, result ); + break; + case STRINGTV: + result = make_string( o.payload.string.character, result ); + break; + case SYMBOLTV: + result = + make_symbol_or_key( o.payload.string.character, result, + SYMBOLTV ); + break; + } } + } else { + result = arg; } return result; @@ -1350,6 +1353,86 @@ struct cons_pointer lisp_source( struct stack_frame *frame, return result; } +/** + * A version of append which can conveniently be called from C. + */ +struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { + switch ( pointer2cell( l1 ).tag.value ) { + case CONSTV: + if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { + if ( nilp( c_cdr( l1 ) ) ) { + return make_cons( c_car( l1 ), l2 ); + } else { + return make_cons( c_car( l1 ), + c_append( c_cdr( l1 ), l2 ) ); + } + } else { + throw_exception( c_string_to_lisp_string + ( L"Can't append: not same type" ), NIL ); + } + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { + if ( nilp( c_cdr( l1 ) ) ) { + return + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), l2, + pointer2cell( l1 ).tag.value ); + } else { + return + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), + c_append( c_cdr( l1 ), l2 ), + pointer2cell( l1 ).tag.value ); + } + } else { + throw_exception( c_string_to_lisp_string + ( L"Can't append: not same type" ), NIL ); + } + break; + default: + throw_exception( c_string_to_lisp_string + ( L"Can't append: not a sequence" ), NIL ); + break; + } +} + +/** + * should really be overwritten with a version in Lisp, since this is much easier to write in Lisp + */ +struct cons_pointer lisp_append( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return c_append( frame->arg[0], frame->arg[1] ); +} + + +struct cons_pointer lisp_mapcar( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + + for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) { + struct cons_pointer expr = make_cons(frame->arg[0], make_cons(c_car(c), NIL)); + inc_ref(expr); + + struct cons_pointer r = eval_form(frame, frame_pointer, expr, env); + + if ( exceptionp( r ) ) { + result = r; + inc_ref( expr ); // to protect exception from the later dec_ref + break; + } else { + result = make_cons( c, result ); + } + + dec_ref( expr ); + } + + return c_reverse( result ); +} // /** // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the diff --git a/src/ops/lispops.h b/src/ops/lispops.h index c1cc337..582cd98 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -202,4 +202,13 @@ struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ); + +struct cons_pointer lisp_append( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); + +struct cons_pointer lisp_mapcar( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif diff --git a/src/ops/loop.c b/src/ops/loop.c new file mode 100644 index 0000000..6ccada6 --- /dev/null +++ b/src/ops/loop.c @@ -0,0 +1,50 @@ +/* + * loop.c + * + * Iteration functions. This has *a lot* of similarity to try/catch -- + * essentially what `recur` does is throw a special purpose exception which is + * caught by `loop`. + * + * Essentially the syntax I want is + * + * (defun expt (n e) + * (loop ((n1 . n) (r . n) (e1 . e)) + * (cond ((= e 0) r) + * (t (recur n1 (* n1 r) (- e 1))))) + * + * It might in future be good to allow the body of the loop to comprise many + * expressions, like a `progn`, but for now if you want that you can just + * shove a `progn` in. Note that, given that what `recur` is essentially + * doing is throwing a special purpose exception, the `recur` expression + * doesn't actually have to be in the same function as the `loop` expression. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include "consspaceobject.h" +#include "lispops.h" +#include "loop.h" + +/** + * Special form, not dissimilar to `let`. Essentially, + * + * 1. the first arg (`args`) is an assoc list; + * 2. the second arg (`body`) is an expression. + * + * Each of the vals in the assoc list is evaluated, and bound to its + * respective key in a new environment. The body is then evaled in that + * environment. If the result is an object of type LOOP, it should carry + * a list of values of the same arity as args. Each of the keys in args + * is then rebound in a new environment to the respective value from the + * LOOP object, and body is then re-evaled in that environment. + * + * If the result is not a LOOP object, it is simply returned. + */ +struct cons_pointer +lisp_loop( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer keys = c_keys( frame->arg[0] ); + struct cons_pointer body = frame->arg[1]; + +} diff --git a/src/ops/loop.h b/src/ops/loop.h new file mode 100644 index 0000000..27714a8 --- /dev/null +++ b/src/ops/loop.h @@ -0,0 +1,10 @@ +/* + * loop.h + * + * Iteration functions. This has *a lot* of similarity to try/catch -- + * essentially what `recur` does is throw a special purpose exception which is + * caught by `loop`. + * + * (c) 2021 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ diff --git a/unit-tests/append.sh b/unit-tests/append.sh new file mode 100755 index 0000000..0f6fb30 --- /dev/null +++ b/unit-tests/append.sh @@ -0,0 +1,24 @@ +#!/bin/bash + +expected='(a b c d e f)' +actual=`echo "(append '(a b c) '(d e f))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='"hellodere"' +actual=`echo '(append "hello" "dere")' | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + From 4047b88cae2d5fe2a482d6a3722355fc966a3342 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 23 Aug 2021 13:29:11 +0100 Subject: [PATCH 17/90] Documentation, only --- README.md | 135 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 133 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 9c08aab..afcc524 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,5 @@ # Post Scarcity Software System, version 0 -Very Nearly a Big Lisp Environment - tl,dr: look at the [wiki](wiki). ## State of play @@ -22,6 +20,139 @@ What I'm trying to do now is write a detailed low level specification of the und Although I describe it as a 'Lisp environment', for reasons explained in Post Scarcity Software that doesn't mean you will program it in Lisp. It means that the underlying representation of things in the system is Lispy, not Unixy. +## Bindings currently available + +The following symbols are bound in the bootstrap layer. It is anticipated that + +1. Most of the functions will be overridden by versions of the same function written in Lisp; but +2. these implementations will remain available in the package `/:bootstrap`. + +### Values + +Note that symbols delimited by asterisks, as in `*in*`, invite rebinding; it is expected, for example, that users will want to rebind input and output streams in their current environment. Rebinding some other symbols, for example `nil`, is unwise. + +#### nil + +The canonical empty list. + +#### t + +The canonical true value. + +#### \*in\* + +The input stream. + +#### \*out\* + +The output stream. + +#### \*log\* + +The logging stream (equivalent to `stderr`). + +#### \*sink\* + +The sink stream (equivalent to `/dev/null`). + +#### \*prompt\* + +The REPL prompt. + +#### (absolute *n*) + +Return the absolute value of a number. + +#### (add *n1* *n2* ...), (+ *n1* *n2* ...) + +Return the result of adding together all the (assumed numeric) arguments supplied. + +#### (append *s1* *s2*) + +Return a new sequence comprising all the elements of *s1* followed by all the elements of *s2*. *s1* and *s2* must be sequences of the same type. At a later stage this function will accept arbitrary numbers of arguments, but by that time it will be written in Lisp. + +#### (apply *f* *s*) + +Apply the function *f* to the arguments that form the sequence *s*, and return the result. + +#### (assoc *key* *store*) + +Return the value associated with *key* in *store*. *key* may be an object of any type, but keywords, symbols and strings are handled most efficiently. *store* may be an [*association list*](#Association_list), or may be a hashmap. + +#### (car *s*) + +Return the first element of the sequence *s*. + +#### (cdr *s*) + +Return a sequence of all the elements of the sequence *s* except the first. + +#### (close *stream*) + +Closes the indicates stream. Returns `nil`. + +#### (cons *a* *b*) + +Returns a new pair comprising *a* and *b*. If *b* is a list, this has the effect of creating a new list with the element *a* prepended to all the elements of *b*. If *b* is `nil`, this has the effect creating a new list with *a* as the sole element. Otherwise, it just creates a pair. + +#### (divide *n1* *n2*), (/ *n1* *n2*) + +Divides the number *n1* by the number *n2*. If *n1* and *n2* are both integers, it's likely that the result will be a rational number. + +#### (eq *o1* *o2*) + +Returns true (`t`) if *o1* and *o2* are identically the same object, else `nil`. + +#### (equal *o1* *o2*) + +Returns true (`t`) if *o1* and *o2* are structurally identical to one another, else `nil`. + +#### (exception *message*) + +Throws (returns) an exception, with the specified *message*. Note that it is extremely likely this signature will change. + +#### (get-hash *key* *hashmap*) + +Like 'assoc', but the store must be a hashmap. Deprecated. + +#### (hashmap *n* *f* *store*) + +Create a hashmap with *n* buckets, using *f* as its hashing function, and initialised with the key/value pairs from *store*. All arguments are optional; if none are passed, will create an empty hashmap with 32 keys and the default hashing function. + +#### (inspect *o*) + +Prints detailed structure of the object *o*. Primarily for debugging. + +#### (keys *store*) + +Returns a list of the keys in *store*, which may be either an [*association list*](#Association_list), or a hashmap. + +#### (mapcar *f* *s*) + +Applies the function *f* to each element of the sequence *s*, and returns a new sequence of the results. + +#### (meta *o*), (metadata *o*) + +Returns metadata on *o*. + +#### (multiply *n1* *n2* ...), (\* *n1* *n2* ...) + +Returns the product of multiplying together all of its numeric arguments. + +#### (negative? n1) + +Returns `t` if its argument is a negative number, else `nil`. + +#### (oblist) + +Returns a sequence of all the names bound in the root of the naming system. + +#### (open *url* *read?*) + +Opens a stream to the specified *url*. If a second argument is present and is non-`nil`, the stream is opened for reading; otherwise, it's opened for writing. + + + ## License Copyright © 2017 [Simon Brooke](mailto:simon@journeyman.cc) From 06e87f09faedc8c370cd473f73b2f1dc2a2d47c4 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 8 Sep 2021 13:12:40 +0100 Subject: [PATCH 18/90] Mapcar working; really only `let` left to do for version 0.1 --- src/ops/lispops.c | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 2356abe..0f058ed 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -42,8 +42,6 @@ * also to create in this section: * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env, * struct stack_frame* frame); - * struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env, - * struct stack_frame* frame); * * and others I haven't thought of yet. */ @@ -62,7 +60,8 @@ struct cons_pointer eval_form( struct stack_frame *parent, struct cons_pointer form, struct cons_pointer env ) { debug_print( L"eval_form: ", DEBUG_EVAL ); - debug_dump_object( form, DEBUG_EVAL ); + debug_print_object( form, DEBUG_EVAL ); + debug_println(DEBUG_EVAL); struct cons_pointer result = NIL; struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); @@ -81,6 +80,10 @@ struct cons_pointer eval_form( struct stack_frame *parent, dec_ref( next_pointer ); } + debug_print( L"eval_form returning: ", DEBUG_EVAL ); + debug_print_object( result, DEBUG_EVAL ); + debug_println(DEBUG_EVAL); + return result; } @@ -1413,25 +1416,41 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; + debug_print( L"Mapcar: ", DEBUG_EVAL ); + debug_dump_object( frame_pointer, DEBUG_EVAL ); + int i = 0; for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) { struct cons_pointer expr = make_cons(frame->arg[0], make_cons(c_car(c), NIL)); inc_ref(expr); - struct cons_pointer r = eval_form(frame, frame_pointer, expr, env); + debug_printf(DEBUG_EVAL, L"Mapcar %d, evaluating ", i); + debug_print_object( expr, DEBUG_EVAL); + debug_println(DEBUG_EVAL); + + struct cons_pointer r = eval_form(frame, frame_pointer, expr, env); if ( exceptionp( r ) ) { result = r; inc_ref( expr ); // to protect exception from the later dec_ref break; } else { - result = make_cons( c, result ); + result = make_cons( r, result ); } + debug_printf(DEBUG_EVAL, L"Mapcar %d, result is ", i++); + debug_print_object( result, DEBUG_EVAL); + debug_println(DEBUG_EVAL); dec_ref( expr ); } - return c_reverse( result ); + result = consp(result) ? c_reverse( result ) : result; + + debug_print( L"Mapcar returning: ", DEBUG_EVAL ); + debug_print_object( result, DEBUG_EVAL ); + debug_println(DEBUG_EVAL); + + return result; } // /** From 3abebe937cd55436e8d1bb8c9d1db741317a39b6 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 8 Sep 2021 13:47:36 +0100 Subject: [PATCH 19/90] Added `list` and unit test for it. --- src/init.c | 1 + src/ops/lispops.c | 13 +++++++++++ src/ops/lispops.h | 4 ++++ unit-tests/integer-allocation.sh | 4 ++-- unit-tests/list-test,sh | 38 ++++++++++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 2 deletions(-) create mode 100644 unit-tests/list-test,sh diff --git a/src/init.c b/src/init.c index 5e8a55d..4fc922a 100644 --- a/src/init.c +++ b/src/init.c @@ -236,6 +236,7 @@ int main( int argc, char *argv[] ) { bind_function( L"hashmap", lisp_make_hashmap ); bind_function( L"inspect", &lisp_inspect ); bind_function( L"keys", &lisp_keys ); + bind_function( L"list", &lisp_list); bind_function( L"mapcar", &lisp_mapcar ); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 0f058ed..d35c5a6 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -1453,6 +1453,19 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, return result; } +struct cons_pointer lisp_list( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = frame->more; + + for ( int a = nilp(result) ? frame->args - 1: args_in_frame - 1; + a >= 0; a-- ) { + result = make_cons(fetch_arg(frame, a), result); + } + + return result; +} + // /** // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the // * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 582cd98..2724f89 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -211,4 +211,8 @@ struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + + struct cons_pointer lisp_list( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif diff --git a/unit-tests/integer-allocation.sh b/unit-tests/integer-allocation.sh index ced92f2..b25bef3 100755 --- 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 -v5 2>&1 | grep "${expected}" > /dev/null +expected="(${value} \"INTR\")" +echo "(set! x $value)(list x (type x))" | target/psse 2>&1 | grep "${expected}" > /dev/null if [ $? -eq 0 ] then diff --git a/unit-tests/list-test,sh b/unit-tests/list-test,sh new file mode 100644 index 0000000..32f4797 --- /dev/null +++ b/unit-tests/list-test,sh @@ -0,0 +1,38 @@ +#!/bin/bash + +expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)" + +actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '$expected', got '$actual'" + exit 1 +fi + +expected="(0 1 2 3 4)" + +actual=`echo "(list 0 1 2 3 4)" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '$expected', got '$actual'" + exit 1 +fi + +expected="(0 1 2 3 4 5 6 7)" + +actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" + exit 0 +else + echo "Fail: expected '$expected', got '$actual'" + exit 1 +fi From 78d2395d60b291737a70fc83ee165b63f1462bff Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 8 Sep 2021 15:01:48 +0100 Subject: [PATCH 20/90] Let working, unit tested. --- src/init.c | 1 + src/ops/lispops.c | 54 ++++++++++++++++++++++++++++++++++++++++++----- src/ops/lispops.h | 4 ++++ unit-tests/let.sh | 24 +++++++++++++++++++++ 4 files changed, 78 insertions(+), 5 deletions(-) create mode 100755 unit-tests/let.sh diff --git a/src/init.c b/src/init.c index 4fc922a..031d0ba 100644 --- a/src/init.c +++ b/src/init.c @@ -270,6 +270,7 @@ int main( int argc, char *argv[] ) { bind_special( L"cond", &lisp_cond ); bind_special( L"lambda", &lisp_lambda ); bind_special( L"\u03bb", &lisp_lambda ); // λ + bind_special(L"let", &lisp_let); bind_special( L"nlambda", &lisp_nlambda ); bind_special( L"n\u03bb", &lisp_nlambda ); bind_special( L"progn", &lisp_progn ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index d35c5a6..fa3c68d 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -593,7 +593,7 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, result = frame->arg[1]; } else { result = - make_exception( make_cons + throw_exception( make_cons ( c_string_to_lisp_string ( L"The first argument to `set` is not a symbol: " ), make_cons( frame->arg[0], NIL ) ), @@ -632,7 +632,7 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, result = val; } else { result = - make_exception( make_cons + throw_exception( make_cons ( c_string_to_lisp_string ( L"The first argument to `set!` is not a symbol: " ), make_cons( frame->arg[0], NIL ) ), @@ -1212,7 +1212,7 @@ struct cons_pointer lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer message = frame->arg[0]; - return exceptionp( message ) ? message : make_exception( message, + return exceptionp( message ) ? message : throw_exception( message, frame->previous ); } @@ -1408,9 +1408,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - return c_append( frame->arg[0], frame->arg[1] ); -} + struct cons_pointer result = fetch_arg(frame, (frame->args - 1)); + for (int a = frame->args - 2; a >= 0; a--) { + result = c_append(fetch_arg(frame, a), result); + } + + return result; +} struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -1466,6 +1471,45 @@ struct cons_pointer lisp_list( struct stack_frame *frame, return result; } +/** + * Special form: evaluate a series of forms in an environment in which + * these bindings are bound. + * This is `let*` in Common Lisp parlance; `let` in Clojure parlance. + */ +struct cons_pointer lisp_let( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env) { + struct cons_pointer bindings = env; + struct cons_pointer result = NIL; + + for (struct cons_pointer cursor = frame->arg[0]; + truep(cursor); + cursor = c_cdr(cursor)) { + struct cons_pointer pair = c_car(cursor); + struct cons_pointer symbol = c_car(pair); + + if (symbolp(symbol)) { + bindings = make_cons( + make_cons(symbol, eval_form(frame, frame_pointer, c_cdr(pair), bindings)), + bindings); + + } else { + result = throw_exception( + c_string_to_lisp_string(L"Let: cannot bind, not a symbol"), + frame_pointer); + break; + } + } + + /* i.e., no exception yet */ + for (int form = 1; !exceptionp(result) && form < frame->args; form++) { + result = eval_form(frame, frame_pointer, fetch_arg(frame, form), bindings); + } + + return result; + + } + // /** // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the // * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 2724f89..3d1c4f7 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -215,4 +215,8 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + +struct cons_pointer lisp_let( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env); #endif diff --git a/unit-tests/let.sh b/unit-tests/let.sh new file mode 100755 index 0000000..6454b1e --- /dev/null +++ b/unit-tests/let.sh @@ -0,0 +1,24 @@ +#!/bin/bash + +expected='11' +actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '$expected', got '$actual'" + exit 1 +fi + +expected='1' +actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" + exit 0 +else + echo "Fail: expected '$expected', got '$actual'" + exit 1 +fi From be5cc4e528d024c00386960cde2139648bb9dd4a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 8 Sep 2021 18:32:31 +0100 Subject: [PATCH 21/90] Documentation in README.md --- README.md | 136 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 132 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index afcc524..408818c 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,28 @@ tl,dr: look at the [wiki](wiki). ## State of play +### Version 0.0.5 + +Has working Lisp interpreter, more or less complete, with functions and symbols as defined under [[#Bindings currently available]] below. Features include hash maps. + +#### Known bugs + +At the time of writing, big number arithmetic is completely failing. It has worked in the past, but it doesn't now. + +#### Unknown bugs + +It's pretty likely that there are memory leaks. + +#### Not yet implemented + +1. There is as yet no **compiler**, and indeed it isn't yet certain what a compiler would even mean. Do all nodes in a machine necessarily share the same processor architecture? +2. There's the beginnings of a narrative about how **namespaces** are going to work, but as yet they aren't really implemented. +3. There is as yet no implementation of the concept of **users**. Access Control Lists exist but are not used. Related, there's no concept of a **session**. +4. There is as yet no **multiprocessor architecture**, not even a simulated one. As it is intended that threading will be implemented by handing off parts of a computation to peer processors, this means there no **threads** either. +5. There's no **user interface** beyond a REPL. There isn't even an **editor**, or **history**. +6. **Printing to strings** does not work. +7. The **exception system**, while it does exist, needs to be radically rethought. + ### Version 0.0.4 Has working rational number arithmetic, as well as integer and real number arithmetic. The stack is now in vector space, but vector space is not yet properly garbage collected. `defun` does not yet work, so although Lisp functions can be defined the syntax is pretty clunky. So you *can* start to do things with this, but you should probably wait for at least a 0.1.0 release! @@ -25,7 +47,7 @@ Although I describe it as a 'Lisp environment', for reasons explained in Post Sc The following symbols are bound in the bootstrap layer. It is anticipated that 1. Most of the functions will be overridden by versions of the same function written in Lisp; but -2. these implementations will remain available in the package `/:bootstrap`. +2. these implementations will remain available in the namespace `/:bootstrap`. ### Values @@ -59,6 +81,8 @@ The sink stream (equivalent to `/dev/null`). The REPL prompt. +### Functions + #### (absolute *n*) Return the absolute value of a number. @@ -67,9 +91,9 @@ Return the absolute value of a number. Return the result of adding together all the (assumed numeric) arguments supplied. -#### (append *s1* *s2*) +#### (append *s1* *s2* ...) -Return a new sequence comprising all the elements of *s1* followed by all the elements of *s2*. *s1* and *s2* must be sequences of the same type. At a later stage this function will accept arbitrary numbers of arguments, but by that time it will be written in Lisp. +Return a new sequence comprising all the elements of *s1* followed by all the elements of *s2* and so on for an indefinite number of arguments. All arguments must be sequences of the same type. #### (apply *f* *s*) @@ -109,7 +133,7 @@ Returns true (`t`) if *o1* and *o2* are structurally identical to one another, e #### (exception *message*) -Throws (returns) an exception, with the specified *message*. Note that it is extremely likely this signature will change. +Throws (returns) an exception, with the specified *message*. Note that this doesn't really work at all well, and that it is extremely likely this signature will change. #### (get-hash *key* *hashmap*) @@ -127,6 +151,14 @@ Prints detailed structure of the object *o*. Primarily for debugging. Returns a list of the keys in *store*, which may be either an [*association list*](#Association_list), or a hashmap. +#### (let *bindings* *form*...) + +Evaluates each of the *forms* in an environment to which ally of these *bindings* have been added. *bindings* must be an [*association list*](#Association_list), and, additionally, all keys in *bindings* must be symbols. Values in the association list will be evaluated before being bound, and this is done sequentially, as in the behaviour of Common Lisp `let*` rather than of Common Lisp `let`. + +#### (list *o*...) + +Returns a list of the values of all of its arguments in sequence. + #### (mapcar *f* *s*) Applies the function *f* to each element of the sequence *s*, and returns a new sequence of the results. @@ -151,6 +183,102 @@ Returns a sequence of all the names bound in the root of the naming system. Opens a stream to the specified *url*. If a second argument is present and is non-`nil`, the stream is opened for reading; otherwise, it's opened for writing. +### Types + +The following types are known. Further types can be defined, and ultimately it should be possible to define further types in Lisp, but these are what you have to be going on with. Note that where this documentation differs from `memory/consspaceobject.h`, this documentation is *wrong*. + +#### CONS + +An ordinary cons cell: that is to say, a pair. + +#### EXEP + +An exception + +#### FREE + +An unallocated memory cell. User programs should never see this. + +#### FUNC + +A primitive or compiled Lisp function \-- one whose arguments are pre-evaluated. + +#### HASH + +A hash map (in vector space) + +#### INTR + +An arbitrarily large integer number. + +#### KEYW + +A keyword - an interned, self-evaluating string. + +#### LMBA + +A lambda cell. Lambdas are the interpretable (source) versions of functions. + +#### LOOP + +Internal to the workings of the ••loop** function. User functions should never see this. + +#### NIL + +The special cons cell at address {0,0} whose **car** and **cdr** both point to itself. The canonical empty set. Generally, treated as being indicative of falsity. + +#### NLMD + +An nlambda cell. NLambdas are the interpretable (source) versions of special forms. + +#### RTIO + +A rational number, stored as pointers two integers representing dividend and divisor respectively. + +#### READ + +An open read stream. + +#### REAL + +A real number, represented internally as an IEEE 754-2008 `binary64`. + +#### SPFM + +A compiled or primitive special form - one whose arguments are not pre-evaluated but passed as provided. + +#### STAK + +A stack frame. In vector space. + +#### STRG + +A string of [UTF-32](https://en.wikipedia.org/wiki/UTF-32) characters, stored as a linked list. Self evaluating. + +#### SYMB + +A symbol is just like a string except not self-evaluating. Later, there may be some restrictions on what characters are legal in a symbol, but at present there are not. + +#### TIME + +A time stamp. Not really properly implemented yet; the epoch is not defined, and, given the size of numbers we can store, could be pushed far into the past. + +#### TRUE + +The special cell at address {0,1} which is canonically different from NIL. + +#### VECP + +A pointer to an object in vector space. User functions shouldn't see this, they should see the type of the vector-space object indicated. + +#### VECT + +A vector of objects. In vector space. + +#### WRIT + +An open write stream. + ## License From 2c96e7c30d8d152b4bc5fb88770c0a8e37348975 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 13:41:27 +0100 Subject: [PATCH 22/90] Sanitising debug-printf formats, mostly. --- .gitignore | 4 ++++ Makefile | 2 +- src/arith/integer.c | 2 +- src/init.c | 1 + src/io/io.c | 1 + src/memory/conspage.c | 15 ++++++++++++++- src/memory/conspage.h | 2 ++ src/memory/consspaceobject.c | 2 +- src/memory/vectorspace.c | 2 +- 9 files changed, 26 insertions(+), 5 deletions(-) diff --git a/.gitignore b/.gitignore index a85ac01..b07b2a6 100644 --- a/.gitignore +++ b/.gitignore @@ -42,3 +42,7 @@ hi\.* .vscode/ core + +.kdev4/ + +post-scarcity.kdev4 diff --git a/Makefile b/Makefile index d8e6e81..7e5efb4 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ SRC_DIRS ?= ./src SRCS := $(shell find $(SRC_DIRS) -name *.cpp -or -name *.c -or -name *.s) HDRS := $(shell find $(SRC_DIRS) -name *.h) -OBJS := $(addsuffix .o,$(basename $(SRCS))) +OBJS := $(addsuffix .o,$(basename $(SRCS))) DEPS := $(OBJS:.o=.d) TESTS := $(shell find unit-tests -name *.sh) diff --git a/src/arith/integer.c b/src/arith/integer.c index db486d2..06ef8a3 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -76,7 +76,7 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t result = ( __int128_t ) integerp( c ) ? ( val == 0 ) ? carry : val : op == '*' ? 1 : 0; debug_printf( DEBUG_ARITH, - L"cell_value: raw value is %ld, is_first_cell = %s; %4.4s; returning ", + L"cell_value: raw value is %ld, is_first_cell = %s; '%4.4s'; returning ", val, is_first_cell ? "true" : "false", pointer2cell( c ).tag.bytes ); debug_print_128bit( result, DEBUG_ARITH ); diff --git a/src/init.c b/src/init.c index 031d0ba..a47f008 100644 --- a/src/init.c +++ b/src/init.c @@ -288,6 +288,7 @@ int main( int argc, char *argv[] ) { dump_pages( file_to_url_file( stdout ) ); } + summarise_allocation(); curl_global_cleanup( ); return ( 0 ); } diff --git a/src/io/io.c b/src/io/io.c index 72830a4..fe08a77 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -166,6 +166,7 @@ wint_t url_fgetwc( URL_FILE * input ) { debug_print( L"url_fgetwc: back from url_fgets\n", DEBUG_IO ); int c = ( int ) cbuff[0]; + // TODO: risk of reading off cbuff? debug_printf( DEBUG_IO, L"url_fgetwc: cbuff is '%s'; (first) character = %d (%c)\n", cbuff, c, c & 0xf7 ); diff --git a/src/memory/conspage.c b/src/memory/conspage.c index d8d54f9..f967c74 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -28,6 +28,12 @@ */ bool conspageinitihasbeencalled = false; +/** + * keep track of total cells allocated and freed to check for leakage. + */ +uint64_t total_cells_allocated = 0; +uint64_t total_cells_freed = 0; + /** * the number of cons pages which have thus far been initialised. */ @@ -187,6 +193,7 @@ void free_cell( struct cons_pointer pointer ) { cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; freelist = pointer; + total_cells_freed ++; } else { debug_printf( DEBUG_ALLOC, L"ERROR: Attempt to free cell with %d dangling references at page %d, offset %d\n", @@ -228,8 +235,10 @@ struct cons_pointer allocate_cell( uint32_t tag ) { cell->payload.cons.car = NIL; cell->payload.cons.cdr = NIL; + total_cells_allocated ++; + debug_printf( DEBUG_ALLOC, - L"Allocated cell of type '%s' at %d, %d \n", tag, + L"Allocated cell of type '%4.4s' at %d, %d \n", tag, result.page, result.offset ); } else { debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" ); @@ -255,3 +264,7 @@ void initialise_cons_pages( ) { L"WARNING: initialise_cons_pages() called a second or subsequent time\n" ); } } + +void summarise_allocation() { + fwprintf(stderr, L"Allocation summary: allocated %lld; deallocated %lld.\n", total_cells_allocated, total_cells_freed ); +} \ No newline at end of file diff --git a/src/memory/conspage.h b/src/memory/conspage.h index 260794e..18eda3b 100644 --- a/src/memory/conspage.h +++ b/src/memory/conspage.h @@ -61,4 +61,6 @@ void initialise_cons_pages( ); void dump_pages( URL_FILE * output ); +void summarise_allocation(); + #endif diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 5b04699..0eef3d5 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -324,7 +324,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { } else { // \todo should throw an exception! debug_printf( DEBUG_ALLOC, - L"Warning: only NIL and %s can be prepended to %s\n", + L"Warning: only NIL and %4.4s can be prepended to %4.4s\n", tag, tag ); } diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 4709482..0c1b159 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -85,7 +85,7 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) { if ( vso != NULL ) { memset( vso, 0, padded ); debug_printf( DEBUG_ALLOC, - L"make_vso: about to write tag '%s' into vso at %p\n", + L"make_vso: about to write tag '%4.4s' into vso at %p\n", tag, vso ); vso->header.tag.value = tag; result = make_vec_pointer( vso, tag ); From 2b8f31d2ce46a9bd475dd7063366a1c0b956eb10 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 15:02:27 +0100 Subject: [PATCH 23/90] Paths of #include files --- src/arith/integer.c | 10 +++++----- src/arith/peano.c | 24 ++++++++++++------------ src/arith/ratio.c | 16 ++++++++-------- src/arith/real.c | 6 +++--- src/debug.c | 8 ++++---- src/init.c | 22 ++++++++++++---------- src/io/fopen.c | 6 +++--- src/io/io.c | 14 ++++++-------- src/io/print.c | 18 +++++++++--------- src/io/read.c | 36 ++++++++++++++++++++---------------- src/memory/conspage.c | 12 ++++++------ src/memory/consspaceobject.c | 12 ++++++------ src/memory/dump.c | 16 ++++++++-------- src/memory/hashmap.c | 2 +- src/memory/stack.c | 14 +++++++------- src/memory/vectorspace.c | 10 +++++----- src/ops/intern.c | 10 +++++----- src/ops/lispops.c | 24 ++++++++++++------------ src/ops/meta.c | 2 +- src/repl.c | 8 ++++---- src/time/psse_time.c | 9 ++++----- 21 files changed, 141 insertions(+), 138 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index 06ef8a3..eef171b 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -18,12 +18,12 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "equal.h" -#include "lispops.h" -#include "peano.h" +#include "ops/equal.h" +#include "ops/lispops.h" +#include "arith/peano.h" /** * hexadecimal digits for printing numbers. diff --git a/src/arith/peano.c b/src/arith/peano.c index 5589f1f..ae23a00 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -14,19 +14,19 @@ #include #include -#include "consspaceobject.h" -#include "conspage.h" +#include "memory/consspaceobject.h" +#include "memory/conspage.h" #include "debug.h" -#include "equal.h" -#include "integer.h" -#include "intern.h" -#include "lispops.h" -#include "peano.h" -#include "print.h" -#include "ratio.h" -#include "read.h" -#include "real.h" -#include "stack.h" +#include "ops/equal.h" +#include "arith/integer.h" +#include "ops/intern.h" +#include "ops/lispops.h" +#include "arith/peano.h" +#include "io/print.h" +#include "arith/ratio.h" +#include "io/read.h" +#include "arith/real.h" +#include "memory/stack.h" long double to_long_double( struct cons_pointer arg ); int64_t to_long_int( struct cons_pointer arg ); diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 8100ec2..5135d6b 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -11,15 +11,15 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "equal.h" -#include "integer.h" -#include "lispops.h" -#include "peano.h" -#include "print.h" -#include "ratio.h" +#include "ops/equal.h" +#include "arith/integer.h" +#include "ops/lispops.h" +#include "arith/peano.h" +#include "io/print.h" +#include "arith/ratio.h" /** diff --git a/src/arith/real.c b/src/arith/real.c index a59a125..34d29d0 100644 --- a/src/arith/real.c +++ b/src/arith/real.c @@ -7,10 +7,10 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "read.h" +#include "io/read.h" /** * Allocate a real number cell representing this value and return a cons diff --git a/src/debug.c b/src/debug.c index c8b9771..233e154 100644 --- a/src/debug.c +++ b/src/debug.c @@ -18,11 +18,11 @@ #include #include -#include "consspaceobject.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "dump.h" -#include "io.h" -#include "print.h" +#include "memory/dump.h" +#include "io/io.h" +#include "io/print.h" /** * the controlling flags for `debug_print`; set in `init.c`, q.v. diff --git a/src/init.c b/src/init.c index a47f008..12187fd 100644 --- a/src/init.c +++ b/src/init.c @@ -20,18 +20,20 @@ #include #include "version.h" -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" +#include "memory/stack.h" #include "debug.h" -#include "hashmap.h" -#include "intern.h" -#include "io.h" -#include "lispops.h" -#include "meta.h" -#include "peano.h" -#include "print.h" +#include "memory/hashmap.h" +#include "ops/intern.h" +#include "io/io.h" +#include "ops/lispops.h" +#include "ops/meta.h" +#include "arith/peano.h" +#include "io/print.h" #include "repl.h" -#include "psse_time.h" +#include "io/fopen.h" +#include "time/psse_time.h" // extern char *optarg; /* defined in unistd.h */ diff --git a/src/io/fopen.c b/src/io/fopen.c index 3a66806..e4fafdd 100644 --- a/src/io/fopen.c +++ b/src/io/fopen.c @@ -47,12 +47,12 @@ #include -#include "fopen.h" +#include "io/fopen.h" #ifdef FOPEN_STANDALONE CURLSH *io_share; #else -#include "consspaceobject.h" -#include "io.h" +#include "memory/consspaceobject.h" +#include "io/io.h" #include "utils.h" #endif diff --git a/src/io/io.c b/src/io/io.c index fe08a77..0125488 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -28,13 +28,13 @@ #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "fopen.h" -#include "integer.h" -#include "intern.h" -#include "lispops.h" +#include "io/fopen.h" +#include "arith/integer.h" +#include "ops/intern.h" +#include "ops/lispops.h" #include "utils.h" /** @@ -56,8 +56,6 @@ wint_t ungotten = 0; * @return 0 on success; any other value means failure. */ int io_init( ) { - CURL *curl; - CURLcode res; int result = curl_global_init( CURL_GLOBAL_SSL ); io_share = curl_share_init( ); diff --git a/src/io/print.c b/src/io/print.c index 64d7b37..8f4b88e 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -17,15 +17,15 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" -#include "hashmap.h" -#include "integer.h" -#include "intern.h" -#include "stack.h" -#include "print.h" -#include "psse_time.h" -#include "vectorspace.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" +#include "memory/hashmap.h" +#include "arith/integer.h" +#include "ops/intern.h" +#include "memory/stack.h" +#include "io/print.h" +#include "time/psse_time.h" +#include "memory/vectorspace.h" /** * print all the characters in the symbol or string indicated by `pointer` diff --git a/src/io/read.c b/src/io/read.c index 4425b77..45d1045 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -17,25 +17,29 @@ #include #include -#include "consspaceobject.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "dump.h" -#include "hashmap.h" -#include "integer.h" -#include "intern.h" -#include "io.h" -#include "lispops.h" -#include "peano.h" -#include "print.h" -#include "ratio.h" -#include "read.h" -#include "real.h" -#include "vectorspace.h" +#include "memory/dump.h" +#include "memory/hashmap.h" +#include "arith/integer.h" +#include "ops/intern.h" +#include "io/io.h" +#include "ops/lispops.h" +#include "arith/peano.h" +#include "io/print.h" +#include "arith/ratio.h" +#include "io/read.h" +#include "arith/real.h" +#include "memory/vectorspace.h" /* - * for the time being things which may be read are: strings numbers - either - * integer or real, but not yet including ratios or bignums lists Can't read - * atoms because I don't yet know what an atom is or how it's stored. + * for the time being things which may be read are: + * * strings + * * numbers - either integer, ratio or real + * * lists + * * maps + * * keywords + * * atoms */ struct cons_pointer read_number( struct stack_frame *frame, diff --git a/src/memory/conspage.c b/src/memory/conspage.c index f967c74..6cc4814 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -16,12 +16,12 @@ #include #include -#include "consspaceobject.h" -#include "conspage.h" +#include "memory/consspaceobject.h" +#include "memory/conspage.h" #include "debug.h" -#include "dump.h" -#include "stack.h" -#include "vectorspace.h" +#include "memory/dump.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" /** * Flag indicating whether conspage initialisation has been done. @@ -267,4 +267,4 @@ void initialise_cons_pages( ) { void summarise_allocation() { fwprintf(stderr, L"Allocation summary: allocated %lld; deallocated %lld.\n", total_cells_allocated, total_cells_freed ); -} \ No newline at end of file +} diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 0eef3d5..579e84b 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -19,13 +19,13 @@ #include #include "authorise.h" -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "intern.h" -#include "print.h" -#include "stack.h" -#include "vectorspace.h" +#include "ops/intern.h" +#include "io/print.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" /** * True if the value of the tag on the cell at this `pointer` is this `value`, diff --git a/src/memory/dump.c b/src/memory/dump.c index 81182a8..3148ac1 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -18,15 +18,15 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "hashmap.h" -#include "intern.h" -#include "io.h" -#include "print.h" -#include "stack.h" -#include "vectorspace.h" +#include "memory/hashmap.h" +#include "ops/intern.h" +#include "io/io.h" +#include "io/print.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" void dump_string_cell( URL_FILE * output, wchar_t *prefix, diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index d6909ba..a9bc336 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -11,7 +11,7 @@ #include "arith/peano.h" #include "authorise.h" #include "debug.h" -#include "intern.h" +#include "ops/intern.h" #include "io/print.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" diff --git a/src/memory/stack.c b/src/memory/stack.c index 8b0e610..4b70ed1 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -17,14 +17,14 @@ #include -#include "consspaceobject.h" -#include "conspage.h" +#include "memory/consspaceobject.h" +#include "memory/conspage.h" #include "debug.h" -#include "dump.h" -#include "lispops.h" -#include "print.h" -#include "stack.h" -#include "vectorspace.h" +#include "memory/dump.h" +#include "ops/lispops.h" +#include "io/print.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" /** * set a register in a stack frame. Alwaye use this to do so, diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 0c1b159..4bbeb51 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -19,12 +19,12 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "hashmap.h" -#include "stack.h" -#include "vectorspace.h" +#include "memory/hashmap.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" /** diff --git a/src/ops/intern.c b/src/ops/intern.c index 05d5822..cd80612 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -19,12 +19,12 @@ #include -#include "conspage.h" -#include "consspaceobject.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "equal.h" -#include "hashmap.h" -#include "lispops.h" +#include "ops/equal.h" +#include "memory/hashmap.h" +#include "ops/lispops.h" // #include "print.h" /** diff --git a/src/ops/lispops.c b/src/ops/lispops.c index fa3c68d..4ff14a1 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -24,19 +24,19 @@ #include #include -#include "consspaceobject.h" -#include "conspage.h" +#include "memory/consspaceobject.h" +#include "memory/conspage.h" #include "debug.h" -#include "dump.h" -#include "equal.h" -#include "integer.h" -#include "intern.h" -#include "io.h" -#include "lispops.h" -#include "print.h" -#include "read.h" -#include "stack.h" -#include "vectorspace.h" +#include "memory/dump.h" +#include "ops/equal.h" +#include "arith/integer.h" +#include "ops/intern.h" +#include "io/io.h" +#include "ops/lispops.h" +#include "io/print.h" +#include "io/read.h" +#include "memory/stack.h" +#include "memory/vectorspace.h" /* * also to create in this section: diff --git a/src/ops/meta.c b/src/ops/meta.c index a27d2af..f00824f 100644 --- a/src/ops/meta.c +++ b/src/ops/meta.c @@ -7,7 +7,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#include "conspage.h" +#include "memory/conspage.h" #include "debug.h" /** diff --git a/src/repl.c b/src/repl.c index 39bbde6..bef08b1 100644 --- a/src/repl.c +++ b/src/repl.c @@ -11,11 +11,11 @@ #include #include -#include "consspaceobject.h" +#include "memory/consspaceobject.h" #include "debug.h" -#include "intern.h" -#include "lispops.h" -#include "stack.h" +#include "ops/intern.h" +#include "ops/lispops.h" +#include "memory/stack.h" /** diff --git a/src/time/psse_time.c b/src/time/psse_time.c index 1f24b0e..06c1b58 100644 --- a/src/time/psse_time.c +++ b/src/time/psse_time.c @@ -16,10 +16,10 @@ #include #include -#include "conspage.h" -#include "consspaceobject.h" -#include "integer.h" -#include "psse_time.h" +#include "memory/conspage.h" +#include "memory/consspaceobject.h" +#include "arith/integer.h" +#include "time/psse_time.h" #define _GNU_SOURCE #define seconds_per_year 31557600L @@ -63,7 +63,6 @@ struct cons_pointer make_time( struct cons_pointer integer_or_nil ) { if ( integerp( integer_or_nil ) ) { cell->payload.time.value = pointer2cell( integer_or_nil ).payload.integer.value; - // \todo: if integer is a bignum, deal with it. } else { cell->payload.time.value = unix_time_to_lisp_time( time( NULL ) ); } From 40e35022475915608e630deb15402772499b4819 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 15:06:05 +0100 Subject: [PATCH 24/90] Standardised format (with `make format`) --- src/init.c | 6 +- src/io/io.c | 4 +- src/memory/conspage.c | 10 +-- src/memory/conspage.h | 2 +- src/memory/dump.c | 8 +-- src/memory/hashmap.c | 4 +- src/ops/lispops.c | 144 ++++++++++++++++++++++-------------------- src/ops/lispops.h | 6 +- 8 files changed, 97 insertions(+), 87 deletions(-) diff --git a/src/init.c b/src/init.c index 12187fd..ff8c190 100644 --- a/src/init.c +++ b/src/init.c @@ -238,7 +238,7 @@ int main( int argc, char *argv[] ) { bind_function( L"hashmap", lisp_make_hashmap ); bind_function( L"inspect", &lisp_inspect ); bind_function( L"keys", &lisp_keys ); - bind_function( L"list", &lisp_list); + bind_function( L"list", &lisp_list ); bind_function( L"mapcar", &lisp_mapcar ); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); @@ -272,7 +272,7 @@ int main( int argc, char *argv[] ) { bind_special( L"cond", &lisp_cond ); bind_special( L"lambda", &lisp_lambda ); bind_special( L"\u03bb", &lisp_lambda ); // λ - bind_special(L"let", &lisp_let); + bind_special( L"let", &lisp_let ); bind_special( L"nlambda", &lisp_nlambda ); bind_special( L"n\u03bb", &lisp_nlambda ); bind_special( L"progn", &lisp_progn ); @@ -290,7 +290,7 @@ int main( int argc, char *argv[] ) { dump_pages( file_to_url_file( stdout ) ); } - summarise_allocation(); + summarise_allocation( ); curl_global_cleanup( ); return ( 0 ); } diff --git a/src/io/io.c b/src/io/io.c index 0125488..d01f788 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -502,8 +502,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( frame->arg[0] ) ) { result = make_string( url_fgetwc - ( pointer2cell( frame->arg[0] ).payload. - stream.stream ), NIL ); + ( pointer2cell( frame->arg[0] ).payload.stream. + stream ), NIL ); } return result; diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 6cc4814..f8802cc 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -193,7 +193,7 @@ void free_cell( struct cons_pointer pointer ) { cell->payload.free.car = NIL; cell->payload.free.cdr = freelist; freelist = pointer; - total_cells_freed ++; + total_cells_freed++; } else { debug_printf( DEBUG_ALLOC, L"ERROR: Attempt to free cell with %d dangling references at page %d, offset %d\n", @@ -235,7 +235,7 @@ struct cons_pointer allocate_cell( uint32_t tag ) { cell->payload.cons.car = NIL; cell->payload.cons.cdr = NIL; - total_cells_allocated ++; + total_cells_allocated++; debug_printf( DEBUG_ALLOC, L"Allocated cell of type '%4.4s' at %d, %d \n", tag, @@ -265,6 +265,8 @@ void initialise_cons_pages( ) { } } -void summarise_allocation() { - fwprintf(stderr, L"Allocation summary: allocated %lld; deallocated %lld.\n", total_cells_allocated, total_cells_freed ); +void summarise_allocation( ) { + fwprintf( stderr, + L"Allocation summary: allocated %lld; deallocated %lld.\n", + total_cells_allocated, total_cells_freed ); } diff --git a/src/memory/conspage.h b/src/memory/conspage.h index 18eda3b..589f6bf 100644 --- a/src/memory/conspage.h +++ b/src/memory/conspage.h @@ -61,6 +61,6 @@ void initialise_cons_pages( ); void dump_pages( URL_FILE * output ); -void summarise_allocation(); +void summarise_allocation( ); #endif diff --git a/src/memory/dump.c b/src/memory/dump.c index 3148ac1..2bc5bb0 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -114,10 +114,10 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { case RATIOTV: url_fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ). - payload.integer.value, - pointer2cell( cell.payload.ratio.divisor ). - payload.integer.value, cell.count ); + pointer2cell( cell.payload.ratio.dividend ).payload. + integer.value, + pointer2cell( cell.payload.ratio.divisor ).payload. + integer.value, cell.count ); break; case READTV: url_fputws( L"\t\tInput stream; metadata: ", output ); diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index a9bc336..5e1db0a 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -180,8 +180,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, map->payload.hashmap.buckets[bucket_no] = inc_ref( make_cons( make_cons( key, val ), - map->payload. - hashmap.buckets[bucket_no] ) ); + map->payload.hashmap. + buckets[bucket_no] ) ); } } } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 4ff14a1..c4ca4f3 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -61,7 +61,7 @@ struct cons_pointer eval_form( struct stack_frame *parent, struct cons_pointer env ) { debug_print( L"eval_form: ", DEBUG_EVAL ); debug_print_object( form, DEBUG_EVAL ); - debug_println(DEBUG_EVAL); + debug_println( DEBUG_EVAL ); struct cons_pointer result = NIL; struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); @@ -82,7 +82,7 @@ struct cons_pointer eval_form( struct stack_frame *parent, debug_print( L"eval_form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); - debug_println(DEBUG_EVAL); + debug_println( DEBUG_EVAL ); return result; } @@ -416,9 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload.special. - executable ) ( get_stack_frame( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload. + special.executable ) ( get_stack_frame + ( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -594,10 +595,10 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, } else { result = throw_exception( make_cons - ( c_string_to_lisp_string - ( L"The first argument to `set` is not a symbol: " ), - make_cons( frame->arg[0], NIL ) ), - frame_pointer ); + ( c_string_to_lisp_string + ( L"The first argument to `set` is not a symbol: " ), + make_cons( frame->arg[0], NIL ) ), + frame_pointer ); } return result; @@ -633,10 +634,10 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, } else { result = throw_exception( make_cons - ( c_string_to_lisp_string - ( L"The first argument to `set!` is not a symbol: " ), - make_cons( frame->arg[0], NIL ) ), - frame_pointer ); + ( c_string_to_lisp_string + ( L"The first argument to `set!` is not a symbol: " ), + make_cons( frame->arg[0], NIL ) ), + frame_pointer ); } return result; @@ -1213,7 +1214,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer message = frame->arg[0]; return exceptionp( message ) ? message : throw_exception( message, - frame->previous ); + frame-> + previous ); } /** @@ -1380,13 +1382,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { if ( nilp( c_cdr( l1 ) ) ) { return - make_string_like_thing( ( pointer2cell( l1 ).payload. - string.character ), l2, + make_string_like_thing( ( pointer2cell( l1 ). + payload.string.character ), + l2, pointer2cell( l1 ).tag.value ); } else { return - make_string_like_thing( ( pointer2cell( l1 ).payload. - string.character ), + make_string_like_thing( ( pointer2cell( l1 ). + payload.string.character ), c_append( c_cdr( l1 ), l2 ), pointer2cell( l1 ).tag.value ); } @@ -1408,13 +1411,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer result = fetch_arg(frame, (frame->args - 1)); + struct cons_pointer result = fetch_arg( frame, ( frame->args - 1 ) ); - for (int a = frame->args - 2; a >= 0; a--) { - result = c_append(fetch_arg(frame, a), result); - } + for ( int a = frame->args - 2; a >= 0; a-- ) { + result = c_append( fetch_arg( frame, a ), result ); + } - return result; + return result; } struct cons_pointer lisp_mapcar( struct stack_frame *frame, @@ -1426,34 +1429,35 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, int i = 0; for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) { - struct cons_pointer expr = make_cons(frame->arg[0], make_cons(c_car(c), NIL)); - inc_ref(expr); + struct cons_pointer expr = + make_cons( frame->arg[0], make_cons( c_car( c ), NIL ) ); + inc_ref( expr ); - debug_printf(DEBUG_EVAL, L"Mapcar %d, evaluating ", i); - debug_print_object( expr, DEBUG_EVAL); - debug_println(DEBUG_EVAL); + debug_printf( DEBUG_EVAL, L"Mapcar %d, evaluating ", i ); + debug_print_object( expr, DEBUG_EVAL ); + debug_println( DEBUG_EVAL ); - struct cons_pointer r = eval_form(frame, frame_pointer, expr, env); + struct cons_pointer r = eval_form( frame, frame_pointer, expr, env ); if ( exceptionp( r ) ) { result = r; - inc_ref( expr ); // to protect exception from the later dec_ref + inc_ref( expr ); // to protect exception from the later dec_ref break; } else { result = make_cons( r, result ); } - debug_printf(DEBUG_EVAL, L"Mapcar %d, result is ", i++); - debug_print_object( result, DEBUG_EVAL); - debug_println(DEBUG_EVAL); + debug_printf( DEBUG_EVAL, L"Mapcar %d, result is ", i++ ); + debug_print_object( result, DEBUG_EVAL ); + debug_println( DEBUG_EVAL ); dec_ref( expr ); } - result = consp(result) ? c_reverse( result ) : result; + result = consp( result ) ? c_reverse( result ) : result; debug_print( L"Mapcar returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); - debug_println(DEBUG_EVAL); + debug_println( DEBUG_EVAL ); return result; } @@ -1461,14 +1465,14 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer result = frame->more; + struct cons_pointer result = frame->more; - for ( int a = nilp(result) ? frame->args - 1: args_in_frame - 1; - a >= 0; a-- ) { - result = make_cons(fetch_arg(frame, a), result); - } + for ( int a = nilp( result ) ? frame->args - 1 : args_in_frame - 1; + a >= 0; a-- ) { + result = make_cons( fetch_arg( frame, a ), result ); + } - return result; + return result; } /** @@ -1477,38 +1481,42 @@ struct cons_pointer lisp_list( struct stack_frame *frame, * This is `let*` in Common Lisp parlance; `let` in Clojure parlance. */ struct cons_pointer lisp_let( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env) { - struct cons_pointer bindings = env; - struct cons_pointer result = NIL; + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer bindings = env; + struct cons_pointer result = NIL; - for (struct cons_pointer cursor = frame->arg[0]; - truep(cursor); - cursor = c_cdr(cursor)) { - struct cons_pointer pair = c_car(cursor); - struct cons_pointer symbol = c_car(pair); + for ( struct cons_pointer cursor = frame->arg[0]; + truep( cursor ); cursor = c_cdr( cursor ) ) { + struct cons_pointer pair = c_car( cursor ); + struct cons_pointer symbol = c_car( pair ); - if (symbolp(symbol)) { - bindings = make_cons( - make_cons(symbol, eval_form(frame, frame_pointer, c_cdr(pair), bindings)), - bindings); - - } else { - result = throw_exception( - c_string_to_lisp_string(L"Let: cannot bind, not a symbol"), - frame_pointer); - break; - } - } + if ( symbolp( symbol ) ) { + bindings = + make_cons( make_cons + ( symbol, + eval_form( frame, frame_pointer, c_cdr( pair ), + bindings ) ), bindings ); - /* i.e., no exception yet */ - for (int form = 1; !exceptionp(result) && form < frame->args; form++) { - result = eval_form(frame, frame_pointer, fetch_arg(frame, form), bindings); - } + } else { + result = + throw_exception( c_string_to_lisp_string + ( L"Let: cannot bind, not a symbol" ), + frame_pointer ); + break; + } + } - return result; + /* i.e., no exception yet */ + for ( int form = 1; !exceptionp( result ) && form < frame->args; form++ ) { + result = + eval_form( frame, frame_pointer, fetch_arg( frame, form ), + bindings ); + } - } + return result; + +} // /** // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 3d1c4f7..ba1e999 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -212,11 +212,11 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); - struct cons_pointer lisp_list( struct stack_frame *frame, +struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer lisp_let( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env); + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif From 462c0c69b4e0513c34c27d75fa4a291a04ae50d9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 15:28:27 +0100 Subject: [PATCH 25/90] Fixed bug that reading map literal didn't evaluate values. --- src/io/read.c | 33 ++++++++++++++-------- src/io/read.h | 4 ++- src/ops/lispops.c | 70 +++++++++++++++++++++++++++++++---------------- 3 files changed, 71 insertions(+), 36 deletions(-) diff --git a/src/io/read.c b/src/io/read.c index 45d1045..df0735b 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -48,9 +48,11 @@ struct cons_pointer read_number( struct stack_frame *frame, bool seen_period ); struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ); struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, @@ -142,6 +144,7 @@ struct cons_pointer read_path( URL_FILE * input, wint_t initial, */ struct cons_pointer read_continuation( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { debug_print( L"entering read_continuation\n", DEBUG_IO ); struct cons_pointer result = NIL; @@ -171,16 +174,16 @@ struct cons_pointer read_continuation( struct stack_frame *frame, case '\'': result = c_quote( read_continuation - ( frame, frame_pointer, input, + ( frame, frame_pointer, env, input, url_fgetwc( input ) ) ); break; case '(': result = - read_list( frame, frame_pointer, input, + read_list( frame, frame_pointer, env, input, url_fgetwc( input ) ); break; case '{': - result = read_map( frame, frame_pointer, input, + result = read_map( frame, frame_pointer, env, input, url_fgetwc( input ) ); break; case '"': @@ -210,8 +213,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame, /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ result = - read_continuation( frame, frame_pointer, input, - url_fgetwc( input ) ); + read_continuation( frame, frame_pointer, env, + input, url_fgetwc( input ) ); debug_print ( L"read_continuation: dotted pair; read cdr ", DEBUG_IO ); @@ -383,6 +386,7 @@ struct cons_pointer read_number( struct stack_frame *frame, */ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { struct cons_pointer result = NIL; wint_t c; @@ -391,7 +395,7 @@ struct cons_pointer read_list( struct stack_frame *frame, debug_printf( DEBUG_IO, L"read_list starting '%C' (%d)\n", initial, initial ); struct cons_pointer car = - read_continuation( frame, frame_pointer, input, + read_continuation( frame, frame_pointer, env, input, initial ); /* skip whitespace */ @@ -406,10 +410,12 @@ struct cons_pointer read_list( struct stack_frame *frame, make_cons( car, c_car( read_list( frame, frame_pointer, + env, input, url_fgetwc( input ) ) ) ); } else { result = - make_cons( car, read_list( frame, frame_pointer, input, c ) ); + make_cons( car, + read_list( frame, frame_pointer, env, input, c ) ); } } else { debug_print( L"End of list detected\n", DEBUG_IO ); @@ -420,6 +426,7 @@ struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer read_map( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env, URL_FILE * input, wint_t initial ) { // set write ACL to true whilst creating to prevent GC churn struct cons_pointer result = @@ -428,21 +435,23 @@ struct cons_pointer read_map( struct stack_frame *frame, while ( c != L'}' ) { struct cons_pointer key = - read_continuation( frame, frame_pointer, input, c ); + read_continuation( frame, frame_pointer, env, input, c ); /* skip whitespace */ for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) ); struct cons_pointer value = - read_continuation( frame, frame_pointer, input, c ); + read_continuation( frame, frame_pointer, env, input, c ); /* skip commaa and whitespace at this point. */ for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c ); c = url_fgetwc( input ) ); - result = hashmap_put( result, key, value ); + result = + hashmap_put( result, key, + eval_form( frame, frame_pointer, value, env ) ); } // default write ACL for maps should be NIL. @@ -536,7 +545,7 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, struct cons_pointer read( struct stack_frame *frame, struct cons_pointer frame_pointer, - URL_FILE * input ) { - return read_continuation( frame, frame_pointer, input, + struct cons_pointer env, URL_FILE * input ) { + return read_continuation( frame, frame_pointer, env, input, url_fgetwc( input ) ); } diff --git a/src/io/read.h b/src/io/read.h index 64f36b0..031bb4f 100644 --- a/src/io/read.h +++ b/src/io/read.h @@ -11,11 +11,13 @@ #ifndef __read_h #define __read_h +#include "memory/consspaceobject.h" + /** * read the next object on this input stream and return a cons_pointer to it. */ struct cons_pointer read( struct stack_frame *frame, struct cons_pointer frame_pointer, - URL_FILE * input ); + struct cons_pointer env, URL_FILE * input ); #endif diff --git a/src/ops/lispops.c b/src/ops/lispops.c index c4ca4f3..436f4df 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -63,21 +63,45 @@ struct cons_pointer eval_form( struct stack_frame *parent, debug_print_object( form, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); - struct cons_pointer result = NIL; - struct cons_pointer next_pointer = make_empty_frame( parent_pointer ); - inc_ref( next_pointer ); + struct cons_pointer result = form; + switch ( pointer2cell( form ).tag.value ) { + /* things which evaluate to themselves */ + case EXCEPTIONTV: + case FREETV: // shouldn't happen, but anyway... + // FUNCTIONTV, LAMBDATV, NLAMBDATV, SPECIALTV ? + case INTEGERTV: + case KEYTV: + case LOOPTV: // don't think this should happen... + case NILTV: + case RATIOTV: + case REALTV: + case READTV: + case STRINGTV: + case TIMETV: + case TRUETV: + // case VECTORPOINTTV: ? + case WRITETV: + break; + default: + { + struct cons_pointer next_pointer = + make_empty_frame( parent_pointer ); + inc_ref( next_pointer ); - struct stack_frame *next = get_stack_frame( next_pointer ); - set_reg( next, 0, form ); - next->args = 1; + struct stack_frame *next = get_stack_frame( next_pointer ); + set_reg( next, 0, form ); + next->args = 1; - result = lisp_eval( next, next_pointer, env ); + result = lisp_eval( next, next_pointer, env ); - if ( !exceptionp( result ) ) { - /* if we're returning an exception, we should NOT free the - * stack frame. Corollary is, when we free an exception, we - * should free all the frames it's holding on to. */ - dec_ref( next_pointer ); + if ( !exceptionp( result ) ) { + /* if we're returning an exception, we should NOT free the + * stack frame. Corollary is, when we free an exception, we + * should free all the frames it's holding on to. */ + dec_ref( next_pointer ); + } + } + break; } debug_print( L"eval_form returning: ", DEBUG_EVAL ); @@ -113,16 +137,16 @@ struct cons_pointer eval_forms( struct stack_frame *frame, } /** - * OK, the idea here (and I know this is less than perfect) is that the basic `try` - * function in PSSE takes two arguments, the first, `body`, being a list of forms, - * and the second, `catch`, being a catch handler (which is also a list of forms). - * Forms from `body` are evaluated in turn until one returns an exception object, + * OK, the idea here (and I know this is less than perfect) is that the basic `try` + * function in PSSE takes two arguments, the first, `body`, being a list of forms, + * and the second, `catch`, being a catch handler (which is also a list of forms). + * Forms from `body` are evaluated in turn until one returns an exception object, * or until the list is exhausted. If the list was exhausted, then the value of - * evaluating the last form in `body` is returned. If an exception was encountered, - * then each of the forms in `catch` is evaluated and the value of the last of + * evaluating the last form in `body` is returned. If an exception was encountered, + * then each of the forms in `catch` is evaluated and the value of the last of * those is returned. - * - * This is experimental. It almost certainly WILL change. + * + * This is experimental. It almost certainly WILL change. */ struct cons_pointer lisp_try( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -891,7 +915,7 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, input = file_to_url_file( stdin ); } - struct cons_pointer result = read( frame, frame_pointer, input ); + struct cons_pointer result = read( frame, frame_pointer, env, input ); debug_print( L"lisp_read returning\n", DEBUG_IO ); debug_dump_object( result, DEBUG_IO ); @@ -1406,7 +1430,7 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { } /** - * should really be overwritten with a version in Lisp, since this is much easier to write in Lisp + * should really be overwritten with a version in Lisp, since this is much easier to write in Lisp */ struct cons_pointer lisp_append( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -1476,7 +1500,7 @@ struct cons_pointer lisp_list( struct stack_frame *frame, } /** - * Special form: evaluate a series of forms in an environment in which + * Special form: evaluate a series of forms in an environment in which * these bindings are bound. * This is `let*` in Common Lisp parlance; `let` in Clojure parlance. */ From a8315d649f40d8249f10992924fd755593d700e7 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 16:20:13 +0100 Subject: [PATCH 26/90] Made try/catch actually work --- src/init.c | 1 + src/ops/lispops.c | 23 ++++++++++------------- src/ops/lispops.h | 4 ++++ unit-tests/try.sh | 45 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 13 deletions(-) create mode 100755 unit-tests/try.sh diff --git a/src/init.c b/src/init.c index ff8c190..dee2b7c 100644 --- a/src/init.c +++ b/src/init.c @@ -278,6 +278,7 @@ int main( int argc, char *argv[] ) { bind_special( L"progn", &lisp_progn ); bind_special( L"quote", &lisp_quote ); bind_special( L"set!", &lisp_set_shriek ); + bind_special( L"try", &lisp_try ); debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 436f4df..917f7b5 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -138,7 +138,7 @@ struct cons_pointer eval_forms( struct stack_frame *frame, /** * OK, the idea here (and I know this is less than perfect) is that the basic `try` - * function in PSSE takes two arguments, the first, `body`, being a list of forms, + * special form in PSSE takes two arguments, the first, `body`, being a list of forms, * and the second, `catch`, being a catch handler (which is also a list of forms). * Forms from `body` are evaluated in turn until one returns an exception object, * or until the list is exhausted. If the list was exhausted, then the value of @@ -158,7 +158,7 @@ struct cons_pointer lisp_try( struct stack_frame *frame, // TODO: need to put the exception into the environment! result = c_progn( frame, frame_pointer, frame->arg[1], make_cons( make_cons - ( c_string_to_lisp_keyword + ( c_string_to_lisp_symbol ( L"*exception*" ), result ), env ) ); } @@ -440,10 +440,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload.special. + executable ) ( get_stack_frame( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -1238,8 +1237,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer message = frame->arg[0]; return exceptionp( message ) ? message : throw_exception( message, - frame-> - previous ); + frame->previous ); } /** @@ -1406,14 +1404,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) { if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { if ( nilp( c_cdr( l1 ) ) ) { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), - l2, + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), l2, pointer2cell( l1 ).tag.value ); } else { return - make_string_like_thing( ( pointer2cell( l1 ). - payload.string.character ), + make_string_like_thing( ( pointer2cell( l1 ).payload. + string.character ), c_append( c_cdr( l1 ), l2 ), pointer2cell( l1 ).tag.value ); } diff --git a/src/ops/lispops.h b/src/ops/lispops.h index ba1e999..da1f27e 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -219,4 +219,8 @@ struct cons_pointer lisp_list( struct stack_frame *frame, struct cons_pointer lisp_let( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + +struct cons_pointer lisp_try( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); #endif diff --git a/unit-tests/try.sh b/unit-tests/try.sh new file mode 100755 index 0000000..a6d529c --- /dev/null +++ b/unit-tests/try.sh @@ -0,0 +1,45 @@ +#!/bin/bash + +expected=':foo' +actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='4' +actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='8' +actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='' +actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi From 86961577a6d8f86ee395cf5d21f4825c1d1bbb9d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 18:43:07 +0100 Subject: [PATCH 27/90] Mostly more documentation --- README.md | 114 ++++++++++++++++++++++++++++++++++++++++++++-- src/init.c | 5 +- src/ops/lispops.c | 27 +++++++++-- 3 files changed, 134 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 408818c..145b870 100644 --- a/README.md +++ b/README.md @@ -12,9 +12,11 @@ Has working Lisp interpreter, more or less complete, with functions and symbols At the time of writing, big number arithmetic is completely failing. It has worked in the past, but it doesn't now. +There are ludicrous memory leaks. Essentially the garbage collection strategy isn't yet really working. However, if we are to implement the hypercube architecture in future, a mark and sweep garbage collector will not work, so it's important to get the reference counter working properly. + #### Unknown bugs -It's pretty likely that there are memory leaks. +There are certainly MANY unknown bugs. Please report those you find. #### Not yet implemented @@ -127,7 +129,7 @@ Divides the number *n1* by the number *n2*. If *n1* and *n2* are both integers, Returns true (`t`) if *o1* and *o2* are identically the same object, else `nil`. -#### (equal *o1* *o2*) +#### (equal *o1* *o2*), (= *o1* *o2*) Returns true (`t`) if *o1* and *o2* are structurally identical to one another, else `nil`. @@ -183,7 +185,111 @@ Returns a sequence of all the names bound in the root of the naming system. Opens a stream to the specified *url*. If a second argument is present and is non-`nil`, the stream is opened for reading; otherwise, it's opened for writing. -### Types +#### (print *o* [*stream*]) + +Prints the print-name of object *o* to the output stream which is the value of *stream*, or to the value of \*out\* in the current environment if no *stream* is provided. + +#### (put! *map* *key* *value*) + +Puts *value* as the value of *key* in hashmap *map*, destructively modifying it, and returns the map. Note that in future this will work only if the current user has write access to the specified map. + +#### (put-all! *map* *assoc*) + +Puts each (+key* . *value*) pair from the association list *assoc* into this *map*, destructively modifying it, and returns the map. Note that in future this will work only if the current user has write access to the specified map. + +#### (read [*stream*]) + +Reads a single Lisp form from the input stream which is the value of *stream*, or from the value of \*in\* in the current environment if no *stream* is provided. + +#### (read-char [*stream*]) + +Return the next character from the stream indicated by *stream*, or from the value of \*in\* in the current environment if no *stream* is provided; further arguments are ignored. + +#### (repl [*prompt* *input* *output*)) + +Initiate a new Read/Eval/Print loop with this *prompt*, reading from this *input* stream and writing to this *output* stream. All arguments are optional and default sensibly if omitted. TODO: doesn't actually work yet. + +#### (reverse *seq*) + +Return a new sequence of the same type as *seq*, containing the same elements but in the reverse order. + +#### (slurp *in*) + +Reads all available characters on input stream *in* into a string, and returns the string. + +#### (source *fn*) + +Should return the source code of the function or special form *fn*, but as we don't yet +have a compiler, doesn't. + +#### (subtract *n1* *n2*), (- *n1* *n2*) + +Subtracts the numeric value *n2* from the numeric value *n1*, and returns the difference. + +#### (throw *message*) + +Throws an exception, with the payload *message*. While *message* is at present most usefully a string, it doesn't have to be. Returns the exception, but as exceptions are handled specially by `eval`, it is returned to the catch block of the nearest `try` expression on the stack. + +#### (time [*milliseconds-since-epoch*]) + +Returns a time object whose value is the specified number of *milliseconds-since-epoch*, where the Post Scarcity Software Environment epoch is 14 billion years prior to the UN*X epoch. If *milliseconds-since-epoch* is not specified, returns a time object representing the UTC time when the function was executed. + +#### (type *o*) + +Returns a string representing the type -- actually the tag value -- of the object *o*. + +### Special forms + +#### (cond (test value) ...) + +Evaluates a series of *(test value)* clauses in turn until a test returns non-nil, when the corresponding value is returned and further tests are not evaluated. This is the same syntax as Common Lisp's `cond` implementation, and different from Clojure's. + +It's conventional in Lisp to have a final clause in a `cond` block with the test `t`; however, since we have keywords which are always truthy, it would be equally valid to use `:else` or `:default` as final fallback tests. + +#### (lambda (arg ...) form ...), (λ (arg ...) form ...) + +Returns an anonymous fuction which evaluates each of the *form*s sequentially in an environment in which the specified *arg*s are bound, and returns the value of the last such form. + +#### (let ((*var* . *val*) ...) form ...) + +Evaluates each of these *form*s sequentially in an environment in which each *var* is bound to the respective *val* in the bindings specified, and returns the value of the last form. + +#### (nlambda (arg ...) form ...), (nλ (arg ...) form ...) + +Returns an anonymous special form which evaluates each of the *form*s sequentially in an environment in which the specified *arg*s are bound, and returns the value of the last such form. + +#### (progn *f* ...) + +Evaluates each of the forms which are its arguments in turn and returns the value of the last. + +#### (quote *o*), '*o* + +Returns *o*, unevaluated. + +#### (set! *name* *value* [*namespace*]) + +Sets (destructively modifies) the value of *name* this *value* in the root namespace. The *namespace* argument is currently ignored but in future is anticipated to be a path specification of a namespace to be modified. + +#### (try (*form* ...) (*handler* ...)) + +Attempt to evaluate, sequentially, each of the *form*s in the first sequence, and return the value of the last of them; however, if any of them cause an exception to be thrown, then evaluate sequentially each of the *handler*s in the second sequence. + +It is recommended that you structure this as follows: + +`lisp + (try + (:body + (print "hello") + (/ 1 'a) + (print "goodbye")) + (:catch + (print "Well, that failed.") + 5)) +` + +Here, `:body` and `:catch` are syntactic sugar which will not affect the final value. + +### Type values The following types are known. Further types can be defined, and ultimately it should be possible to define further types in Lisp, but these are what you have to be going on with. Note that where this documentation differs from `memory/consspaceobject.h`, this documentation is *wrong*. @@ -261,7 +367,7 @@ A symbol is just like a string except not self-evaluating. Later, there may be s #### TIME -A time stamp. Not really properly implemented yet; the epoch is not defined, and, given the size of numbers we can store, could be pushed far into the past. +A time stamp. The epoch for the Post Scarcity Software Environment is 14 billion years before the UN*X epoch, and is chosen as being a reasonable estimate for the birth of the universe, and thus of the start of time. #### TRUE diff --git a/src/init.c b/src/init.c index dee2b7c..676964f 100644 --- a/src/init.c +++ b/src/init.c @@ -247,9 +247,8 @@ int main( int argc, char *argv[] ) { bind_function( L"oblist", &lisp_oblist ); bind_function( L"open", &lisp_open ); bind_function( L"print", &lisp_print ); - bind_function( L"progn", &lisp_progn ); - bind_function( L"put", lisp_hashmap_put ); - bind_function( L"put-all", &lisp_hashmap_put_all ); + bind_function( L"put!", lisp_hashmap_put ); + bind_function( L"put-all!", &lisp_hashmap_put_all ); bind_function( L"read", &lisp_read ); bind_function( L"read-char", &lisp_read_char ); bind_function( L"repl", &lisp_repl ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 917f7b5..f9fb95a 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -1256,23 +1256,36 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer expr = NIL; - - /* \todo bind *prompt*, *input*, *output* in the environment to the values - * of arguments 0, 1, and 2 respectively, but in each case only if the - * argument is not nil */ + + debug_printf(DEBUG_REPL, L"Entering new inner REPL\n"); struct cons_pointer input = get_default_stream( true, env ); struct cons_pointer output = get_default_stream( false, env ); - URL_FILE *os = pointer2cell( output ).payload.stream.stream; struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" ); struct cons_pointer old_oblist = oblist; struct cons_pointer new_env = env; + inc_ref( env ); + if (truep(frame->arg[0])) { + new_env = set( prompt_name, frame->arg[0], new_env); + } + if (readp(frame->arg[1])) { + new_env = set( c_string_to_lisp_symbol(L"*in*"), frame->arg[1], new_env); + input = frame->arg[1]; + } + if (readp(frame->arg[2])) { + new_env = set( c_string_to_lisp_symbol(L"*out*"), frame->arg[2], new_env); + output = frame->arg[2]; + } + inc_ref( input ); inc_ref( output ); inc_ref( prompt_name ); + URL_FILE *os = pointer2cell( output ).payload.stream.stream; + + /* \todo this is subtly wrong. If we were evaluating * (print (eval (read))) * then the stack frame for read would have the stack frame for @@ -1287,6 +1300,8 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, * are not visible. So copy changes made in the oblist into the enviroment. * \todo the whole process of resolving symbol values needs to be revisited * when we get onto namespaces. */ + /* OK, there's something even more subtle here if the root namespace is a map. + * H'mmmm... */ if ( !eq( oblist, old_oblist ) ) { struct cons_pointer cursor = oblist; @@ -1335,6 +1350,8 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, dec_ref( prompt_name ); dec_ref( env ); + debug_printf(DEBUG_REPL, L"Leaving inner repl\n"); + return expr; } From 2ef08249674683351aa4c3403206cb17de1639d7 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 18:55:15 +0100 Subject: [PATCH 28/90] Upversioned to 0.0.6-SNAPSHOT --- src/version.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/version.h b/src/version.h index 0e08c48..462f9be 100644 --- a/src/version.h +++ b/src/version.h @@ -8,4 +8,4 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#define VERSION "0.0.5-SNAPSHOT" +#define VERSION "0.0.6-SNAPSHOT" From c2ad3eda0d6a1ee6d3f87d7fd22669800e172bdd Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Sep 2021 19:01:51 +0100 Subject: [PATCH 29/90] Still trying to fix the damned README! --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 93ad64d..8ea4dc4 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ tl,dr: look at the [wiki](wiki). ### Version 0.0.5 -Has working Lisp interpreter, more or less complete, with functions and symbols as defined under [#bindings currently available](Bindings currently available) below. Features include hash maps. +Has working Lisp interpreter, more or less complete, with functions and symbols as defined under [#bindings-currently-available](Bindings currently available) below. Features include hash maps. #### Known bugs From ea0d9a2629baa69586426c48e213d1e1ad15e188 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 17 Sep 2021 09:57:38 +0100 Subject: [PATCH 30/90] Fixed two coredump issues --- src/memory/conspage.c | 2 +- src/memory/vectorspace.c | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/memory/conspage.c b/src/memory/conspage.c index f8802cc..f438627 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -238,7 +238,7 @@ struct cons_pointer allocate_cell( uint32_t tag ) { total_cells_allocated++; debug_printf( DEBUG_ALLOC, - L"Allocated cell of type '%4.4s' at %d, %d \n", tag, + L"Allocated cell of type '%4.4s' at %d, %d \n", cell->tag.bytes, result.page, result.offset ); } else { debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" ); diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 4bbeb51..3616bf3 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -84,10 +84,11 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) { if ( vso != NULL ) { memset( vso, 0, padded ); + vso->header.tag.value = tag; + debug_printf( DEBUG_ALLOC, - L"make_vso: about to write tag '%4.4s' into vso at %p\n", - tag, vso ); - vso->header.tag.value = tag; + L"make_vso: written tag '%4.4s' into vso at %p\n", + vso->header.tag.bytes, vso ); result = make_vec_pointer( vso, tag ); debug_dump_object( result, DEBUG_ALLOC ); vso->header.vecp = result; From fae4a4d444d99cecd00b7d6e4e6615d53be3b096 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 30 Sep 2021 16:27:04 +0100 Subject: [PATCH 31/90] Added unit test to explore the deallocation failure. --- unit-tests/memory.sh | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 unit-tests/memory.sh diff --git a/unit-tests/memory.sh b/unit-tests/memory.sh new file mode 100644 index 0000000..1bb76f6 --- /dev/null +++ b/unit-tests/memory.sh @@ -0,0 +1,14 @@ +#!/bin/bash + +actual=`echo "" | target/psse 2>&1 | tail -2` + +alloc=`echo $actual | sed 's/[[:punct:]]/ /g' | awk '{print $4}'` +dealloc=`echo $actual | sed 's/[[:punct:]]/ /g' | awk '{print $6}'` + +if [ "${alloc}" = "${dealloc}" ] +then + echo "OK" +else + echo "Fail: expected '${alloc}', got '${dealloc}'" + exit 1 +fi From 7ab1640a34ebb549cb9c8d051cefda7099572545 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 8 Apr 2023 10:36:59 +0100 Subject: [PATCH 32/90] Just poking around and trying to remember where the problems are. --- src/arith/integer.c | 11 +++++------ src/arith/peano.h | 10 +++++++++- src/init.c | 1 + src/memory/conspage.c | 4 ++-- src/memory/consspaceobject.h | 2 ++ src/ops/lispops.c | 3 ++- 6 files changed, 21 insertions(+), 10 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index eef171b..b67ccc8 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -100,13 +100,12 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t int128_to_integer( __int128_t val, struct cons_pointer less_significant, struct cons_pointer new ) { - struct cons_pointer cursor = NIL; __int128_t carry = 0; if ( MAX_INTEGER >= val ) { carry = 0; } else { - carry = val >> 60; + carry = val >> INTEGER_BIT_SHIFT; debug_printf( DEBUG_ARITH, L"int128_to_integer: 64 bit overflow; setting carry to %ld\n", ( int64_t ) carry ); @@ -136,7 +135,7 @@ struct cons_pointer make_integer_128( __int128_t val, less_significant = make_integer( ( long int ) val & MAX_INTEGER, less_significant ); - val = val >> 60; + val = val >> INTEGER_BIT_SHIFT; } } while ( nilp( result ) ); @@ -290,7 +289,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* if xj exceeds one digit, break it into the digit dj and * the carry */ - carry = xj >> 60; + carry = xj >> INTEGER_BIT_SHIFT; struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL ); /* destructively modify ri by appending dj */ @@ -320,7 +319,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, } /** - * don't use; private to integer_to_string, and somewaht dodgy. + * don't use; private to integer_to_string, and somewhat dodgy. */ struct cons_pointer integer_to_string_add_digit( int digit, int digits, struct cons_pointer tail ) { @@ -361,7 +360,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 << 60 ); + ( pointer2cell( next ).payload.integer.value << INTEGER_BIT_SHIFT ); next = pointer2cell( next ).payload.integer.more; } int offset = ( int ) ( accumulator % base ); diff --git a/src/arith/peano.h b/src/arith/peano.h index 3076391..84faa28 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -13,10 +13,18 @@ #define PEANO_H /** - * The maximum value we will allow in an integer cell. + * The maximum value we will allow in an integer cell: one less than 2^60: + * (let ((s (make-string-output-stream))) + * (format s "0x0~XL" (- (expt 2 60) 1)) + * (string-downcase (get-output-stream-string s))) + * "0x0fffffffffffffffl" + * + * So left shifting and right shifting by 60 bits is correct. */ #define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) +#define INTEGER_BIT_SHIFT (60) + bool zerop( struct cons_pointer arg ); struct cons_pointer negative( struct cons_pointer arg ); diff --git a/src/init.c b/src/init.c index 676964f..3f3566c 100644 --- a/src/init.c +++ b/src/init.c @@ -9,6 +9,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include #include diff --git a/src/memory/conspage.c b/src/memory/conspage.c index f438627..b30ee53 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -267,6 +267,6 @@ void initialise_cons_pages( ) { void summarise_allocation( ) { fwprintf( stderr, - L"Allocation summary: allocated %lld; deallocated %lld.\n", - total_cells_allocated, total_cells_freed ); + L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n", + total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed ); } diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 7c3a390..e4c0b95 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -478,6 +478,8 @@ struct free_payload { * exceeds 60 bits, the least significant 60 bits are stored in the first cell * in the chain, the next 60 in the next cell, and so on. Only the value of the * first cell in any chain should be negative. + * + * \todo Why is this 60, and not 64 bits? */ struct integer_payload { /** the value of the payload (i.e. 60 bits) of this cell. */ diff --git a/src/ops/lispops.c b/src/ops/lispops.c index f9fb95a..7d1a761 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -681,6 +681,8 @@ bool end_of_stringp( struct cons_pointer arg ) { * returns a cell constructed from a and b. If a is of type string but its * cdr is nill, and b is of type string, then returns a new string cell; * otherwise returns a new cons cell. + * + * Thus: `(cons "a" "bcd") -> "abcd"`, but `(cons "ab" "cd") -> ("ab" . "cd")` * * * (cons a b) * @@ -700,7 +702,6 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, return NIL; } else if ( stringp( car ) && stringp( cdr ) && end_of_stringp( c_cdr( car ) ) ) { - // \todo check that car is of length 1 result = make_string( pointer2cell( car ).payload.string.character, cdr ); } else { From cbcced70b212dfeb40ed45485b968ee6c783c1fa Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 8 Apr 2023 10:36:59 +0100 Subject: [PATCH 33/90] Just poking around and trying to remember where the problems are. --- src/arith/integer.c | 11 +- src/arith/peano.h | 10 +- src/init.c | 1 + src/io/print.h | 2 + src/memory/conspage.c | 4 +- src/memory/consspaceobject.c | 425 ++++++++++++++++++----------------- src/memory/consspaceobject.h | 2 + src/ops/lispops.c | 3 +- 8 files changed, 240 insertions(+), 218 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index eef171b..b67ccc8 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -100,13 +100,12 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t int128_to_integer( __int128_t val, struct cons_pointer less_significant, struct cons_pointer new ) { - struct cons_pointer cursor = NIL; __int128_t carry = 0; if ( MAX_INTEGER >= val ) { carry = 0; } else { - carry = val >> 60; + carry = val >> INTEGER_BIT_SHIFT; debug_printf( DEBUG_ARITH, L"int128_to_integer: 64 bit overflow; setting carry to %ld\n", ( int64_t ) carry ); @@ -136,7 +135,7 @@ struct cons_pointer make_integer_128( __int128_t val, less_significant = make_integer( ( long int ) val & MAX_INTEGER, less_significant ); - val = val >> 60; + val = val >> INTEGER_BIT_SHIFT; } } while ( nilp( result ) ); @@ -290,7 +289,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* if xj exceeds one digit, break it into the digit dj and * the carry */ - carry = xj >> 60; + carry = xj >> INTEGER_BIT_SHIFT; struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL ); /* destructively modify ri by appending dj */ @@ -320,7 +319,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, } /** - * don't use; private to integer_to_string, and somewaht dodgy. + * don't use; private to integer_to_string, and somewhat dodgy. */ struct cons_pointer integer_to_string_add_digit( int digit, int digits, struct cons_pointer tail ) { @@ -361,7 +360,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 << 60 ); + ( pointer2cell( next ).payload.integer.value << INTEGER_BIT_SHIFT ); next = pointer2cell( next ).payload.integer.more; } int offset = ( int ) ( accumulator % base ); diff --git a/src/arith/peano.h b/src/arith/peano.h index 3076391..84faa28 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -13,10 +13,18 @@ #define PEANO_H /** - * The maximum value we will allow in an integer cell. + * The maximum value we will allow in an integer cell: one less than 2^60: + * (let ((s (make-string-output-stream))) + * (format s "0x0~XL" (- (expt 2 60) 1)) + * (string-downcase (get-output-stream-string s))) + * "0x0fffffffffffffffl" + * + * So left shifting and right shifting by 60 bits is correct. */ #define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) +#define INTEGER_BIT_SHIFT (60) + bool zerop( struct cons_pointer arg ); struct cons_pointer negative( struct cons_pointer arg ); diff --git a/src/init.c b/src/init.c index 676964f..3f3566c 100644 --- a/src/init.c +++ b/src/init.c @@ -9,6 +9,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include #include diff --git a/src/io/print.h b/src/io/print.h index 006ef80..b72513c 100644 --- a/src/io/print.h +++ b/src/io/print.h @@ -11,6 +11,8 @@ #include #include +#include "io/fopen.h" + #ifndef __print_h #define __print_h diff --git a/src/memory/conspage.c b/src/memory/conspage.c index f438627..b30ee53 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -267,6 +267,6 @@ void initialise_cons_pages( ) { void summarise_allocation( ) { fwprintf( stderr, - L"Allocation summary: allocated %lld; deallocated %lld.\n", - total_cells_allocated, total_cells_freed ); + L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n", + total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed ); } diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 579e84b..8f9e2a8 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -9,9 +9,9 @@ */ #include +#include #include #include -#include /* * wide characters */ @@ -19,13 +19,13 @@ #include #include "authorise.h" +#include "debug.h" +#include "io/print.h" #include "memory/conspage.h" #include "memory/consspaceobject.h" -#include "debug.h" -#include "ops/intern.h" -#include "io/print.h" #include "memory/stack.h" #include "memory/vectorspace.h" +#include "ops/intern.h" /** * True if the value of the tag on the cell at this `pointer` is this `value`, @@ -33,22 +33,22 @@ * vectorspace object indicated by the cell is this `value`, else false. */ bool check_tag( struct cons_pointer pointer, uint32_t value ) { - bool result = false; + bool result = false; - struct cons_space_object cell = pointer2cell( pointer ); - result = cell.tag.value == value; + struct cons_space_object cell = pointer2cell( pointer ); + result = cell.tag.value == value; - if ( result == false ) { - if ( cell.tag.value == VECTORPOINTTV ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( result == false ) { + if ( cell.tag.value == VECTORPOINTTV ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - if ( vec != NULL ) { - result = vec->header.tag.value == value; - } - } + if ( vec != NULL ) { + result = vec->header.tag.value == value; + } } + } - return result; + return result; } /** @@ -56,17 +56,17 @@ bool check_tag( struct cons_pointer pointer, uint32_t value ) { * * You can't roll over the reference count. Once it hits the maximum * value you cannot increment further. - * + * * Returns the `pointer`. */ struct cons_pointer inc_ref( struct cons_pointer pointer ) { - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( cell->count < MAXREFERENCE ) { - cell->count++; - } + if ( cell->count < MAXREFERENCE ) { + cell->count++; + } - return pointer; + return pointer; } /** @@ -74,49 +74,46 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) { * * If a count has reached MAXREFERENCE it cannot be decremented. * If a count is decremented to zero the cell should be freed. - * + * * Returns the `pointer`, or, if the cell has been freed, NIL. */ struct cons_pointer dec_ref( struct cons_pointer pointer ) { - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - if ( cell->count > 0 ) { - cell->count--; + if ( cell->count > 0 ) { + cell->count--; - if ( cell->count == 0 ) { - free_cell( pointer ); - pointer = NIL; - } + if ( cell->count == 0 ) { + free_cell( pointer ); + pointer = NIL; } + } - return pointer; + return pointer; } - /** * Get the Lisp type of the single argument. * @param pointer a pointer to the object whose type is requested. * @return As a Lisp string, the tag of the object which is at that pointer. */ struct cons_pointer c_type( struct cons_pointer pointer ) { - struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( pointer ); - if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == - 0 ) { - struct vector_space_object *vec = pointer_to_vso( pointer ); + if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { + struct vector_space_object *vec = pointer_to_vso( pointer ); - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = - make_string( ( wchar_t ) vec->header.tag.bytes[i], result ); - } - } else { - for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( ( wchar_t ) cell.tag.bytes[i], result ); - } + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( (wchar_t)vec->header.tag.bytes[i], result ); } + } else { + for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { + result = make_string( (wchar_t)cell.tag.bytes[i], result ); + } + } - return result; + return result; } /** @@ -124,13 +121,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { * authorised to read it, does not error but returns nil. */ struct cons_pointer c_car( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { - result = pointer2cell( arg ).payload.cons.car; - } + if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) { + result = pointer2cell( arg ).payload.cons.car; + } - return result; + return result; } /** @@ -138,96 +135,98 @@ struct cons_pointer c_car( struct cons_pointer arg ) { * not authorised to read it,does not error but returns nil. */ struct cons_pointer c_cdr( struct cons_pointer arg ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - if ( truep( authorised( arg, NIL ) ) ) { - struct cons_space_object *cell = &pointer2cell( arg ); + if ( truep( authorised( arg, NIL ) ) ) { + struct cons_space_object *cell = &pointer2cell( arg ); - switch ( cell->tag.value ) { - case CONSTV: - result = cell->payload.cons.cdr; - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - result = cell->payload.string.cdr; - break; - } + switch ( cell->tag.value ) { + case CONSTV: + result = cell->payload.cons.cdr; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = cell->payload.string.cdr; + break; } + } - return result; + return result; } /** - * Implementation of `length` in C. If arg is not a cons, does not error but returns 0. + * Implementation of `length` in C. If arg is not a cons, does not error but + * returns 0. */ int c_length( struct cons_pointer arg ) { - int result = 0; + int result = 0; - for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) { - result++; - } + for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) { + result++; + } - return result; + return result; } - /** * Construct a cons cell from this pair of pointers. */ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr ) { - struct cons_pointer pointer = NIL; + struct cons_pointer pointer = NIL; - pointer = allocate_cell( CONSTV ); + pointer = allocate_cell( CONSTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( car ); - inc_ref( cdr ); - cell->payload.cons.car = car; - cell->payload.cons.cdr = cdr; + inc_ref( car ); + inc_ref( cdr ); + cell->payload.cons.car = car; + cell->payload.cons.cdr = cdr; - return pointer; + return pointer; } /** * Construct an exception cell. - * @param message should be a lisp string describing the problem, but actually any cons pointer will do; - * @param frame_pointer should be the pointer to the frame in which the exception occurred. + * @param message should be a lisp string describing the problem, but actually + * any cons pointer will do; + * @param frame_pointer should be the pointer to the frame in which the + * exception occurred. */ struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer frame_pointer ) { - struct cons_pointer result = NIL; - struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer result = NIL; + struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( message ); - inc_ref( frame_pointer ); - cell->payload.exception.payload = message; - cell->payload.exception.frame = frame_pointer; + inc_ref( message ); + inc_ref( frame_pointer ); + cell->payload.exception.payload = message; + cell->payload.exception.frame = frame_pointer; - result = pointer; + result = pointer; - return result; + return result; } - /** * Construct a cell which points to an executable Lisp function. */ -struct cons_pointer -make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) - ( struct stack_frame *, - struct cons_pointer, struct cons_pointer ) ) { - struct cons_pointer pointer = allocate_cell( FUNCTIONTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( meta ); +struct cons_pointer make_function( + struct cons_pointer meta, + struct cons_pointer ( *executable )( struct stack_frame *, + struct cons_pointer, + struct cons_pointer ) ) { + struct cons_pointer pointer = allocate_cell( FUNCTIONTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( meta ); - cell->payload.function.meta = meta; - cell->payload.function.executable = executable; + cell->payload.function.meta = meta; + cell->payload.function.executable = executable; - return pointer; + return pointer; } /** @@ -235,17 +234,18 @@ make_function( struct cons_pointer meta, struct cons_pointer ( *executable ) */ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( LAMBDATV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( LAMBDATV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ + inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do + this, but if I don't the cell gets freed */ - inc_ref( args ); - inc_ref( body ); - cell->payload.lambda.args = args; - cell->payload.lambda.body = body; + inc_ref( args ); + inc_ref( body ); + cell->payload.lambda.args = args; + cell->payload.lambda.body = body; - return pointer; + return pointer; } /** @@ -254,48 +254,48 @@ struct cons_pointer make_lambda( struct cons_pointer args, */ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ) { - struct cons_pointer pointer = allocate_cell( NLAMBDATV ); + struct cons_pointer pointer = allocate_cell( NLAMBDATV ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ + inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do + this, but if I don't the cell gets freed */ - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( args ); - inc_ref( body ); - cell->payload.lambda.args = args; - cell->payload.lambda.body = body; + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( args ); + inc_ref( body ); + cell->payload.lambda.args = args; + cell->payload.lambda.body = body; - return pointer; + return pointer; } /** * Return a hash value for this string like thing. - * + * * What's important here is that two strings with the same characters in the * same order should have the same hash value, even if one was created using - * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function - * has that property. I doubt that it's the most efficient hash function to + * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function + * has that property. I doubt that it's the most efficient hash function to * have that property. - * + * * returns 0 for things which are not string like. */ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) { - struct cons_space_object *cell = &pointer2cell( ptr ); - uint32_t result = 0; + struct cons_space_object *cell = &pointer2cell( ptr ); + uint32_t result = 0; - switch ( cell->tag.value ) { - case KEYTV: - case STRINGTV: - case SYMBOLTV: - if ( nilp( cell->payload.string.cdr ) ) { - result = ( uint32_t ) c; - } else { - result = ( ( uint32_t ) c * - cell->payload.string.hash ) & 0xffffffff; - } - break; - } + switch ( cell->tag.value ) { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if ( nilp( cell->payload.string.cdr ) ) { + result = (uint32_t)c; + } else { + result = ( (uint32_t)c * cell->payload.string.hash ) & 0xffffffff; + } + break; + } - return result; + return result; } /** @@ -304,31 +304,31 @@ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) { * has one character and a pointer to the next; in the last cell the * pointer to next is NIL. */ -struct cons_pointer -make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { - struct cons_pointer pointer = NIL; +struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, + uint32_t tag ) { + struct cons_pointer pointer = NIL; - if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) { - pointer = allocate_cell( tag ); - struct cons_space_object *cell = &pointer2cell( pointer ); + if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) { + pointer = allocate_cell( tag ); + struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( tail ); - cell->payload.string.character = c; - cell->payload.string.cdr.page = tail.page; - /* \todo There's a problem here. Sometimes the offsets on - * strings are quite massively off. Fix is probably - * cell->payload.string.cdr = tail */ - cell->payload.string.cdr.offset = tail.offset; + inc_ref( tail ); + cell->payload.string.character = c; + cell->payload.string.cdr.page = tail.page; + /* \todo There's a problem here. Sometimes the offsets on + * strings are quite massively off. Fix is probably + * cell->payload.string.cdr = tail */ + cell->payload.string.cdr.offset = tail.offset; - cell->payload.string.hash = calculate_hash( c, tail ); - } else { - // \todo should throw an exception! - debug_printf( DEBUG_ALLOC, - L"Warning: only NIL and %4.4s can be prepended to %4.4s\n", - tag, tag ); - } + cell->payload.string.hash = calculate_hash( c, tail ); + } else { + // \todo should throw an exception! + debug_printf( DEBUG_ALLOC, + L"Warning: only NIL and %4.4s can be prepended to %4.4s\n", + tag, tag ); + } - return pointer; + return pointer; } /** @@ -340,7 +340,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) { * @param tail the string which is being built. */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { - return make_string_like_thing( c, tail, STRINGTV ); + return make_string_like_thing( c, tail, STRINGTV ); } /** @@ -353,36 +353,45 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) { */ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, uint32_t tag ) { - struct cons_pointer result = make_string_like_thing( c, tail, tag ); + struct cons_pointer result; + + if ( tag == SYMBOLTV || tag == KEYTV ) { + result = make_string_like_thing( c, tail, tag ); if ( tag == KEYTV ) { - struct cons_pointer r = internedp( result, oblist ); + struct cons_pointer r = internedp( result, oblist ); - if ( nilp( r ) ) { - intern( result, oblist ); - } else { - result = r; - } + if ( nilp( r ) ) { + intern( result, oblist ); + } else { + result = r; + } } + } else { + result = make_exception( + c_string_to_lisp_string( L"Unexpected tag when making symbol or key." ), + NIL); + } - return result; + return result; } /** * Construct a cell which points to an executable Lisp special form. */ -struct cons_pointer -make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) - ( struct stack_frame * frame, - struct cons_pointer, struct cons_pointer env ) ) { - struct cons_pointer pointer = allocate_cell( SPECIALTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( meta ); +struct cons_pointer make_special( + struct cons_pointer meta, + struct cons_pointer ( *executable )( struct stack_frame *frame, + struct cons_pointer, + struct cons_pointer env ) ) { + struct cons_pointer pointer = allocate_cell( SPECIALTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); + inc_ref( meta ); - cell->payload.special.meta = meta; - cell->payload.special.executable = executable; + cell->payload.special.meta = meta; + cell->payload.special.executable = executable; - return pointer; + return pointer; } /** @@ -391,15 +400,15 @@ make_special( struct cons_pointer meta, struct cons_pointer ( *executable ) * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct cons_pointer make_read_stream( URL_FILE * input, +struct cons_pointer make_read_stream( URL_FILE *input, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( READTV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( READTV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - cell->payload.stream.stream = input; - cell->payload.stream.meta = metadata; + cell->payload.stream.stream = input; + cell->payload.stream.meta = metadata; - return pointer; + return pointer; } /** @@ -408,59 +417,59 @@ struct cons_pointer make_read_stream( URL_FILE * input, * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct cons_pointer make_write_stream( URL_FILE * output, +struct cons_pointer make_write_stream( URL_FILE *output, struct cons_pointer metadata ) { - struct cons_pointer pointer = allocate_cell( WRITETV ); - struct cons_space_object *cell = &pointer2cell( pointer ); + struct cons_pointer pointer = allocate_cell( WRITETV ); + struct cons_space_object *cell = &pointer2cell( pointer ); - cell->payload.stream.stream = output; - cell->payload.stream.meta = metadata; + cell->payload.stream.stream = output; + cell->payload.stream.meta = metadata; - return pointer; + return pointer; } /** - * Return a lisp keyword representation of this wide character string. In keywords, - * I am accepting only lower case characters and numbers. + * Return a lisp keyword representation of this wide character string. In + * keywords, I am accepting only lower case characters and numbers. */ struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { - wchar_t c = towlower( symbol[i] ); + for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) { + wchar_t c = towlower( symbol[i] ); - if ( iswalnum( c ) || c == L'-' ) { - result = make_keyword( c, result ); - } + if ( iswalnum( c ) || c == L'-' ) { + result = make_keyword( c, result ); } + } - return result; + return result; } /** * Return a lisp string representation of this wide character string. */ struct cons_pointer c_string_to_lisp_string( wchar_t *string ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { - if ( iswprint( string[i] ) && string[i] != '"' ) { - result = make_string( string[i], result ); - } + for ( int i = wcslen( string ) - 1; i >= 0; i-- ) { + if ( iswprint( string[i] ) && string[i] != '"' ) { + result = make_string( string[i], result ); } + } - return result; + return result; } /** * Return a lisp symbol representation of this wide character string. */ struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ) { - struct cons_pointer result = NIL; + struct cons_pointer result = NIL; - for ( int i = wcslen( symbol ); i > 0; i-- ) { - result = make_symbol( symbol[i - 1], result ); - } + for ( int i = wcslen( symbol ); i > 0; i-- ) { + result = make_symbol( symbol[i - 1], result ); + } - return result; + return result; } diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 7c3a390..e4c0b95 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -478,6 +478,8 @@ struct free_payload { * exceeds 60 bits, the least significant 60 bits are stored in the first cell * in the chain, the next 60 in the next cell, and so on. Only the value of the * first cell in any chain should be negative. + * + * \todo Why is this 60, and not 64 bits? */ struct integer_payload { /** the value of the payload (i.e. 60 bits) of this cell. */ diff --git a/src/ops/lispops.c b/src/ops/lispops.c index f9fb95a..7d1a761 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -681,6 +681,8 @@ bool end_of_stringp( struct cons_pointer arg ) { * returns a cell constructed from a and b. If a is of type string but its * cdr is nill, and b is of type string, then returns a new string cell; * otherwise returns a new cons cell. + * + * Thus: `(cons "a" "bcd") -> "abcd"`, but `(cons "ab" "cd") -> ("ab" . "cd")` * * * (cons a b) * @@ -700,7 +702,6 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, return NIL; } else if ( stringp( car ) && stringp( cdr ) && end_of_stringp( c_cdr( car ) ) ) { - // \todo check that car is of length 1 result = make_string( pointer2cell( car ).payload.string.character, cdr ); } else { From ce1c72973db7b80b381333b9daa60f6f288b8c28 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 13 Mar 2025 12:47:54 +0000 Subject: [PATCH 34/90] Defensive commit before experimenting with code::blocks --- src/arith/peano.h | 4 ++++ src/io/read.c | 19 ++++++++++--------- src/io/read.h | 9 +++++++++ 3 files changed, 23 insertions(+), 9 deletions(-) diff --git a/src/arith/peano.h b/src/arith/peano.h index 3076391..b1d3087 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -14,6 +14,10 @@ /** * The maximum value we will allow in an integer cell. + * + * NOTE: 20250312 this is 2^60. WHY? Given that we're using the sign bit + * inside the int64 record, we only have 63 value bits; but why did I decide + * not to use all 63? */ #define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) diff --git a/src/io/read.c b/src/io/read.c index df0735b..bf92f35 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -83,7 +83,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; } @@ -245,7 +245,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame, } break; case '$': - case L'§': + case LSESSION: result = read_path( input, c, NIL ); break; default: @@ -298,9 +298,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" ), @@ -311,7 +311,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" ), @@ -324,11 +324,12 @@ struct cons_pointer read_number( struct stack_frame *frame, result = make_integer( 0, NIL ); } break; - case L',': + case LCOMMA: // silently ignore it. break; default: result = add_integers( multiply_integers( result, base ), + /* /todo: this won't work for hex digits */ make_integer( ( int ) c - ( int ) '0', NIL ) ); @@ -402,7 +403,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. */ @@ -433,7 +434,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 ); @@ -446,7 +447,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 = diff --git a/src/io/read.h b/src/io/read.h index 031bb4f..7f58d0c 100644 --- a/src/io/read.h +++ b/src/io/read.h @@ -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. */ From e9f49d06a62f115776d7784e20ac25275efa2ae9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 13 Mar 2025 18:26:38 +0000 Subject: [PATCH 35/90] Added code::blocks project experimentally; also, added macro for bits --- Makefile | 4 +- post-scarcity.cbp | 157 +++++++++++++++++++++++++++++++++ post-scarcity.cscope_file_list | 58 ++++++++++++ post-scarcity.layout | 15 ++++ src/arith/integer.c | 15 ++-- src/arith/peano.h | 11 +-- state-of-play.md | 28 ++++++ 7 files changed, 275 insertions(+), 13 deletions(-) create mode 100644 post-scarcity.cbp create mode 100644 post-scarcity.cscope_file_list create mode 100644 post-scarcity.layout create mode 100644 state-of-play.md diff --git a/Makefile b/Makefile index 7e5efb4..67bb015 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ SRC_DIRS ?= ./src SRCS := $(shell find $(SRC_DIRS) -name *.cpp -or -name *.c -or -name *.s) HDRS := $(shell find $(SRC_DIRS) -name *.h) -OBJS := $(addsuffix .o,$(basename $(SRCS))) +OBJS := $(addsuffix .o,$(basename $(SRCS))) DEPS := $(OBJS:.o=.d) TESTS := $(shell find unit-tests -name *.sh) @@ -21,6 +21,8 @@ DEBUGFLAGS := -g3 all: $(TARGET) +Debug: $(TARGET) + $(TARGET): $(OBJS) Makefile $(CC) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) diff --git a/post-scarcity.cbp b/post-scarcity.cbp new file mode 100644 index 0000000..a1f42e0 --- /dev/null +++ b/post-scarcity.cbp @@ -0,0 +1,157 @@ + + + + + + diff --git a/post-scarcity.cscope_file_list b/post-scarcity.cscope_file_list new file mode 100644 index 0000000..6fbf5ec --- /dev/null +++ b/post-scarcity.cscope_file_list @@ -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" diff --git a/post-scarcity.layout b/post-scarcity.layout new file mode 100644 index 0000000..98bd2b3 --- /dev/null +++ b/post-scarcity.layout @@ -0,0 +1,15 @@ + + + + + + + + + + + + + + + diff --git a/src/arith/integer.c b/src/arith/integer.c index eef171b..63f7dd2 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -87,9 +87,10 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { /** * 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, @@ -106,7 +107,7 @@ __int128_t int128_to_integer( __int128_t val, if ( MAX_INTEGER >= val ) { carry = 0; } else { - carry = val >> 60; + carry = val >> INTEGER_BITS; debug_printf( DEBUG_ARITH, L"int128_to_integer: 64 bit overflow; setting carry to %ld\n", ( int64_t ) carry ); @@ -136,7 +137,7 @@ struct cons_pointer make_integer_128( __int128_t val, less_significant = make_integer( ( long int ) val & MAX_INTEGER, less_significant ); - val = val >> 60; + val = val >> INTEGER_BITS; } } while ( nilp( result ) ); @@ -290,7 +291,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a, /* if xj exceeds one digit, break it into the digit dj and * the carry */ - carry = xj >> 60; + carry = xj >> INTEGER_BITS; struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL ); /* destructively modify ri by appending dj */ @@ -361,7 +362,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 << 60 ); + ( pointer2cell( next ).payload.integer.value << INTEGER_BITS ); next = pointer2cell( next ).payload.integer.more; } int offset = ( int ) ( accumulator % base ); diff --git a/src/arith/peano.h b/src/arith/peano.h index b1d3087..163d47d 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -14,12 +14,13 @@ /** * The maximum value we will allow in an integer cell. - * - * NOTE: 20250312 this is 2^60. WHY? Given that we're using the sign bit - * inside the int64 record, we only have 63 value bits; but why did I decide - * not to use all 63? */ -#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) +#define MAX_INTEGER ((__int128_t)0x7fffffffffffffffL) +/** + * @brief Number of value bits in an integer cell + * + */ +#define INTEGER_BITS 63 bool zerop( struct cons_pointer arg ); diff --git a/state-of-play.md b/state-of-play.md new file mode 100644 index 0000000..bd38ead --- /dev/null +++ b/state-of-play.md @@ -0,0 +1,28 @@ +# State of Play + +## 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 263 nor 264. + +| | | | +| -------------- | -------------------- | ---- | +| 262 | 4611686018427387904 | | +| 263 | 9223372036854775808 | | +| 264 | 18446744073709551616 | | +| Mystery number | 1152921504606846976 | | + +In fact, our mystery number turns out (by inspection) to be 260. But **why**? From 4e76fad655d1537878ace936a0cf12b264c2505e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 14 Mar 2025 10:24:38 +0000 Subject: [PATCH 36/90] Revert to 60-bit bignum chunks; better `make test` rigging Still failing the three-chunk bignum unit tests --- Makefile | 2 +- src/arith/peano.h | 4 ++-- state-of-play.md | 18 ++++++++++++++++++ 3 files changed, 21 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 67bb015..b4f9d3c 100644 --- a/Makefile +++ b/Makefile @@ -36,7 +36,7 @@ else indent $(INDENT_FLAGS) $(SRCS) $(HDRS) endif -test: $(OBJS) $(TESTS) Makefile +test: $(TESTS) Makefile $(TARGET) bash ./unit-tests.sh .PHONY: clean diff --git a/src/arith/peano.h b/src/arith/peano.h index 163d47d..a7d63b3 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -15,12 +15,12 @@ /** * The maximum value we will allow in an integer cell. */ -#define MAX_INTEGER ((__int128_t)0x7fffffffffffffffL) +#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) /** * @brief Number of value bits in an integer cell * */ -#define INTEGER_BITS 63 +#define INTEGER_BITS 60 bool zerop( struct cons_pointer arg ); diff --git a/state-of-play.md b/state-of-play.md index bd38ead..e96a15a 100644 --- a/state-of-play.md +++ b/state-of-play.md @@ -1,5 +1,23 @@ # State of Play +## 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. From 7c84cb433a257e25ff55b3d05a29722f09ccdf90 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 16 Mar 2025 09:38:00 +0000 Subject: [PATCH 37/90] Changed from using bit-shifts to using arithmetic operators. More tests fail, but... --- lisp/fact.lisp | 2 +- src/arith/integer.c | 12 ++++++------ src/arith/peano.h | 4 +++- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/fact.lisp b/lisp/fact.lisp index 86d452a..17a7288 100644 --- a/lisp/fact.lisp +++ b/lisp/fact.lisp @@ -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))))))) diff --git a/src/arith/integer.c b/src/arith/integer.c index 0b4990a..7ca328f 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -71,7 +71,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; @@ -106,15 +106,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 ); @@ -136,7 +136,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 ) ); @@ -361,7 +361,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 ); diff --git a/src/arith/peano.h b/src/arith/peano.h index eb53450..95c5013 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -21,7 +21,9 @@ * * So left shifting and right shifting by 60 bits is correct. */ -#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL) +#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 * From fa99dd69902385f9efe93dff4c0cb9620bee95b8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 5 Jul 2025 09:52:03 +0100 Subject: [PATCH 38/90] Mainly, work on investigating the bignum arithmetic problem(s). --- src/io/read.c | 12 +++++++++- src/memory/consspaceobject.h | 24 +++++++++++++++++++ unit-tests/bignum-add.sh | 45 ++++++++++++++++++++++++++++++++++++ 3 files changed, 80 insertions(+), 1 deletion(-) diff --git a/src/io/read.c b/src/io/read.c index df0735b..87c568e 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -32,6 +32,16 @@ #include "arith/real.h" #include "memory/vectorspace.h" +// We can't, I think, use libreadline, because we read character by character, +// not line by line, and because we use wide characters. So we're going to have +// to reimplement it. So we're going to have to maintain history of the forms +// (or strings, but I currently think forms). So we're going to have to be able +// to detact special keys, particularly, at this stage, the uparrow and down- +// arrow keys +// #include +// #include + + /* * for the time being things which may be read are: * * strings @@ -325,7 +335,7 @@ struct cons_pointer read_number( struct stack_frame *frame, } break; case L',': - // silently ignore it. + // silently ignore commas. break; default: result = add_integers( multiply_integers( result, base ), diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index e4c0b95..32b0b78 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -121,6 +121,30 @@ */ #define LOOPTV 1347374924 +/** + * @brief Tag for a lazy cons cell. + * + * A lazy cons cell is like a cons cell, but lazy. + * + */ +#define LAZYCONSTAG "LZYC" + +/** + * @brief Tag for a lazy string cell. + * + * A lazy string cell is like a string cell, but lazy. + * + */ +#define LAZYSTRTAG "LZYS" + +/** + * @brief Tag for a lazy worker cell. + * + * A lazy + * + */ +#define LAZYWRKRTAG "WRKR" + /** * The special cons cell at address {0,0} whose car and cdr both point to * itself. diff --git a/unit-tests/bignum-add.sh b/unit-tests/bignum-add.sh index 7bbb41e..778015a 100755 --- a/unit-tests/bignum-add.sh +++ b/unit-tests/bignum-add.sh @@ -129,6 +129,51 @@ else fi +##################################################################### +# add two small bignums to produce a bigger bignum + +a=1152921504606846977 +c=`echo "$a + $a" | bc` +echo -n "adding $a to $a: " +expected='t' +output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` + +actual=`echo $output |\ + tail -1 |\ + sed 's/\,//g'` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +##################################################################### +# add five small bignums to produce a bigger bignum + +a=1152921504606846977 +c=`echo "$a * 5" | bc` +echo -n "adding $a, $a $a, $a, $a: " +expected='t' +output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log` + +actual=`echo $output |\ + tail -1 |\ + sed 's/\,//g'` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + + + + ##################################################################### # add two bignums to produce a bignum a=10000000000000000000 From 36696254f25a0156c0b41b947276e8f7b2dedb40 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 5 Jul 2025 13:58:18 +0100 Subject: [PATCH 39/90] Work on the bignum problem, ongoing. --- src/arith/integer.c | 56 ++++++++++++++++++++---------------- src/memory/consspaceobject.h | 2 +- src/memory/hashmap.c | 24 +++++++++++----- state-of-play.md | 16 +++++++++++ 4 files changed, 66 insertions(+), 32 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index 7ca328f..3bb58bd 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -12,6 +12,7 @@ #include #include #include +#include /* * wide characters */ @@ -32,32 +33,10 @@ 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. * * @param c a pointer to a cell, assumed to be an integer cell; @@ -85,6 +64,35 @@ __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 INTEGER_BITS bits of `val`, and return the diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index e4c0b95..e9a75a6 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -484,7 +484,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; }; diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 5e1db0a..fcbff31 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -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; } diff --git a/state-of-play.md b/state-of-play.md index e96a15a..498bf60 100644 --- a/state-of-play.md +++ b/state-of-play.md @@ -1,5 +1,21 @@ # 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. From cc534255b56ac1ce8065ad0047cf48075bf266f6 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 6 Jul 2025 09:43:38 +0100 Subject: [PATCH 40/90] Transferred all documentation from the Wiki(s) to the `/docs` directory; not all links yet fixed up. --- Doxyfile | 56 +--- docs/Access-control.md | 128 +++++++++ docs/Cons-space.md | 139 ++++++++++ docs/Core-functions.md | 93 +++++++ docs/Free-list.md | 7 + docs/Hashing-structure-writ-large.md | 156 +++++++++++ docs/Home.md | 30 ++ docs/Homogeneity.md | 6 + docs/How-do-we-notate-paths.md | 2 +- docs/Implementing-post-scarcity-hardware.md | 72 +++++ docs/Interning-strings.md | 98 +++++++ docs/Lazy-Collections.md | 36 +++ docs/Memory-management.md | 80 ++++++ docs/Names-of-things.md | 10 + docs/Parallelism.md | 43 +++ docs/Paths.md | 9 + docs/Plan-overview.md | 12 + docs/Post-scarcity-hardware.md | 178 ++++++++++++ docs/Post-scarcity-software.md | 259 ++++++++++++++++++ docs/Regularity.md | 20 ++ docs/Stack.md | 40 +++ docs/Sysout-and-sysin.md | 19 ++ docs/System-private-functions.md | 14 + ...logy-of-the-hardware-of-the-deep-future.md | 35 +++ docs/Users.md | 9 + docs/Vector-space.md | 80 ++++++ 26 files changed, 1582 insertions(+), 49 deletions(-) create mode 100644 docs/Access-control.md create mode 100644 docs/Cons-space.md create mode 100644 docs/Core-functions.md create mode 100644 docs/Free-list.md create mode 100644 docs/Hashing-structure-writ-large.md create mode 100644 docs/Home.md create mode 100644 docs/Homogeneity.md create mode 100644 docs/Implementing-post-scarcity-hardware.md create mode 100644 docs/Interning-strings.md create mode 100644 docs/Lazy-Collections.md create mode 100644 docs/Memory-management.md create mode 100644 docs/Names-of-things.md create mode 100644 docs/Parallelism.md create mode 100644 docs/Paths.md create mode 100644 docs/Plan-overview.md create mode 100644 docs/Post-scarcity-hardware.md create mode 100644 docs/Post-scarcity-software.md create mode 100644 docs/Regularity.md create mode 100644 docs/Stack.md create mode 100644 docs/Sysout-and-sysin.md create mode 100644 docs/System-private-functions.md create mode 100644 docs/Topology-of-the-hardware-of-the-deep-future.md create mode 100644 docs/Users.md create mode 100644 docs/Vector-space.md diff --git a/Doxyfile b/Doxyfile index e283f9a..2b6b284 100644 --- a/Doxyfile +++ b/Doxyfile @@ -76,7 +76,7 @@ CREATE_SUBDIRS = NO # U+3044. # The default value is: NO. -ALLOW_UNICODE_NAMES = NO +ALLOW_UNICODE_NAMES = YES # The OUTPUT_LANGUAGE tag is used to specify the language in which all # documentation generated by doxygen is written. Doxygen will use this @@ -310,7 +310,7 @@ MARKDOWN_SUPPORT = YES # Minimum value: 0, maximum value: 99, default value: 0. # This tag requires that the tag MARKDOWN_SUPPORT is set to YES. -TOC_INCLUDE_HEADINGS = 0 +TOC_INCLUDE_HEADINGS = 5 # When enabled doxygen tries to link words that correspond to documented # classes, or namespaces to their corresponding documentation. Such a link can @@ -790,7 +790,7 @@ WARN_LOGFILE = doxy.log # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. -INPUT = src +INPUT = src docs # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses @@ -816,50 +816,10 @@ INPUT_ENCODING = UTF-8 # *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf and *.qsf. FILE_PATTERNS = *.c \ - *.cc \ - *.cxx \ - *.cpp \ - *.c++ \ - *.java \ - *.ii \ - *.ixx \ - *.ipp \ - *.i++ \ - *.inl \ - *.idl \ - *.ddl \ - *.odl \ *.h \ - *.hh \ - *.hxx \ - *.hpp \ - *.h++ \ - *.cs \ - *.d \ - *.php \ - *.php4 \ - *.php5 \ - *.phtml \ - *.inc \ - *.m \ *.markdown \ - *.md \ - *.mm \ - *.dox \ - *.py \ - *.pyw \ - *.f90 \ - *.f95 \ - *.f03 \ - *.f08 \ - *.f \ - *.for \ - *.tcl \ - *.vhd \ - *.vhdl \ - *.ucf \ - *.qsf - + *.md + # The RECURSIVE tag can be used to specify whether or not subdirectories should # be searched for input files as well. # The default value is: NO. @@ -982,7 +942,7 @@ FILTER_SOURCE_PATTERNS = # (index.html). This can be useful if you have a project on for instance GitHub # and want to reuse the introduction page also for the doxygen output. -USE_MDFILE_AS_MAINPAGE = +USE_MDFILE_AS_MAINPAGE = docs/Home.md #--------------------------------------------------------------------------- # Configuration options related to source browsing @@ -1478,7 +1438,7 @@ DISABLE_INDEX = NO # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. -GENERATE_TREEVIEW = NO +GENERATE_TREEVIEW = YES # The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that # doxygen will group on one line in the generated HTML documentation. @@ -1533,7 +1493,7 @@ FORMULA_TRANSPARENT = YES # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. -USE_MATHJAX = NO +USE_MATHJAX = YES # When MathJax is enabled you can set the default output format to be used for # the MathJax output. See the MathJax site (see: diff --git a/docs/Access-control.md b/docs/Access-control.md new file mode 100644 index 0000000..0f41a5d --- /dev/null +++ b/docs/Access-control.md @@ -0,0 +1,128 @@ +# Access control +_ +ote that a number of details not yet finalised are used in examples in this note. There must be some mechanism for creating fully qualified and partially qualified hierarchical names, but I haven't finalised it yet. In this note I've assumed that the portions of an hierarchical name are separated by periods ('.'); that fully qualified names start with a quote mark; and that where a name doesn't start with a quote mark, the first portion of it is evaluated in the current environment and its value assumed to be a fully qualified equivalent. All of these details may change._ + +In a multi-user environment, access control is necessary in order for a user to be able to protect an item of data from being seen by someone who isn't authorised to see it. But actually, in a world of immutable data, it's less necessary than you might think. As explained in my note on [[Memory, threads and communication]], if there's strict immutability, and all user processes spawn from a common root process, then no user can see into any other user's data space anyway. + +But that makes collaboration and communication impossible, so I've proposed namespaces be mutable. So the value of a name in a [[namespace]] will be a data item and inevitably that data item will be in some user's data space. So we do need an access control list on each data item. + +## Initial thoughts + +My initial plan was that the access control list would have the following structure: + +1. **NIL** would mean only the owner could read it; +2. **T** would mean that anyone could read it; +3. A list of user objects and group objects, any of whom could read it. + +This does not work. We don't know who the owner of a cell is; in the current design we don't store that information, and I cannot see merit in storing that information. So **NIL** cannot mean 'only the owner could read it'. It essentially means 'no-one can read it' (or possibly 'only system processes can read it, which is potentially useful). + +Worse though, if the list points to immutable user and group objects, then if a new user is added to the system after the object was created, they can never be added to the access control list. + +## Write access + +As most data is immutable, there's no need for write access lists. If it exists, you can't write it, period. You can make a modified copy, but you can't modify the original. So most data objects don't need a write access list. + +A sort-of minor exception to this is write streams. If you have normal access to a write stream, gatekept by the normal access lists, you can write to the stream; what you can't do is change where the stream points to. As you can't read from a write stream, there's still only one access list needed. + +However, if (some) [[namespaces]] are mutable - and I believe some must be - then a namespace does need a write access list, in addition to its (normal) read access list. The structure of a write access list will be the same as of a read access list. + +### Modifying write access lists on mutable namespaces + +If mutable namespaces have write access lists, then someone has to be able to manage the content of those write access lists - including modify them. Of course, data being immutable, 'modify' here really means replace. Who has authority to modify the access control list of a mutable namespace? The simplest thing would be for mutable namespaces to have an extra key, '**write-access**', which pointed to the write access list. Then any user with write access to the namespace could modify the write access list. That may be undesirable and needs further thought, but any other solution is going to be complex. + +## Execute access + +I don't see the need for separate read and execute access lists. This is possibly slightly affected by whether the system can run interpreted code, compiled code, or both. If it can run interpreted code, then having read access to the source is equivalent to having execute access, unless there is a separate execute access list (which I don't want). Thus, a user able to edit a system function would also be able to execute it - but as themselves, not as system, so it would not be able to call any further system functions it depended on, unless the user also had read access to them. Note that, of course, in order to put the new version of the function into the system namespace, to make it the version which will be called by other processes, the user would need write access to the system namespace. + +However, it's really hard to make the semantics of interpreted code identical to compiled code, and compilation is no longer such a big deal on modern fast processors. So I don't see the necessity of being able to run interpretted code; it's easier if source and executable are different objects, and, if they're different objects, they can have different access lists. So having access to the source doesn't necessarily means having access to the executable, and vice versa. + +If only compiled code can be executed, then it seems to me that having access to the compiled code means one can execute it, and still there's only one access list needed. + +## Read access + +Thus the default access list is the read access list; every cell has an access list. What do its possible values mean? + +1. **T** everyone can read this; +2. An executable function of two arguments: the current user can read the cell if the function, when passed as arguments the current user and the cell to which access is requested, returns **T** or a list of names as below, and the user is present on that list; +3. A list of names: true if the value of one of those names is the user object of the current user, or is a group which contains the user object of the current user. + +If there's anything on the list which isn't a name it's ignored. Any value of the access list which isn't **T**, an executable function, of a list of names is problematic; we either have to treat it as **T** (everyone) or as **NIL** (either no-one or system-only). We should probably flag an error if an attempt is made to create a cell with an invalid access list. Access control list cells also clearly have their own access control lists; there is a potential for very deep recursion and consequently poor performance here, so it will be desirable to keep such access control lists short or just **T**. Obviously, if you can't read an access control list you can't read the cell that it guards. + +## If data is immutable, how is an access control list set? + +My idea of this is that there will be a priviliged name which is bound in the environment of each user; each user will have their own binding for this name, and, furthermore, they can change the binding of the name in their environment. For now I propose that this name shall be **friends**. The value of **friends** should be an access list as defined above. The access control list of any cell is the value that **friends** had in the environment in the environment in which it was created, at the time it was created. + +## Managing access control + +The `with` function can be used to make this easier: + +``` +(with ((*friends* . list-or-t-or-executable)) s-exprs...) +``` + +Creates a new environment in which **friends** is bound to the value of **list-or-t-or-executable**, and within that environment evaluates the specified **s-exprs**. Any cells created during that evaluation will obviously have **list-or-t-or-executable** as their access control. Returns the value of executing the last **s-expr**. + +### (get-access-control s-expr) + +Returns the access control list of the object which is the value of the **s-expr**. + +### Typical use cases + +Suppose I want to compile a function **foo** which will be executable by all my current friends and additionally the group **foo-users**: + +``` + (with-open-access-control + (cons ::system:groups:foo-users *friends*) + (rebind! ::system:users:simon:functions:foo (compile foo)) +``` + +_Here **rebind!** creates a new binding for the name **foo** in the namespace **::system:users:simon:functions**, whether or not that name was previously bound there. Analogous to the Clojure function **swap!**_ + +Suppose I want to compile a function **bar** which will be executable by exactly the same people as **foo**: + + (with-access-control + (get-access-control 'system.users.simon.exec.foo) + (rebind! 'system.users.simon.exec.bar (compile bar)) + +Suppose I want to do some work which is secret, visible only to me and not to my normal friends: + +``` + (with ((*friends* . (list current-user))) + (repl)) +``` + +(or, obviously, +``` + (with ((*friends* current-user)) + (repl)) +``` +which is in practice exactly the same) + +_Here **repl** starts a new read-eval-print loop in the modified environment - I suspect this is a common use case._ + +Suppose I want to permanently add Anne and Bill to my normal friends: + +``` + (rebind! *environment*:*friends* (cons ::system:users:anne (cons ::system:users:bill *friends*))) +``` + +_Here I'm presuming that `*environment*` is bound to the value of `::system:users:simon:environment`, and that unqualified names are searched for first in my own environment._ + +Suppose I want everyone to be able to play a game, but only outside working hours; and for my friends to be able to play it additionally at lunchtime: + +``` + (with ((*friends* + (compile + (lambda (user cell) + (let ((time . (now))) + (cond + ((< time 09:00) T) + ((> time 17:00) T) + ((and (> time 12:30)(< time 13:30)) *friends*) + (T NIL))))))) + (rebind! ::system:users:simon:functions:excellent-game (compile excellent-game))) +``` + +## Summary + +Security is hard to do well, and all this requires careful further thought, in part because the proposed post-scarcity environment is so unlike any existing software environment. diff --git a/docs/Cons-space.md b/docs/Cons-space.md new file mode 100644 index 0000000..9e1005f --- /dev/null +++ b/docs/Cons-space.md @@ -0,0 +1,139 @@ +# Cons space + +Cons space is a space which contains cons cells, and other objects whose memory representation fits into the footprint of a cons cell. A cons cell comprises: + + +-----+-------+------+----------------+--------------+--------------+ + | header | payload | + + +--------------+--------------+ + | | car | cdr | + +-----+-------+------+----------------+--------------+--------------+ + | tag | count | mark | access-control | cons-pointer | cons-pointer | + +-----+-------+------+----------------+--------------+--------------+ + +The size of each of these components needs to be fixed in a running system. Traditional Lisps have made each as small as possible, but part of the point of thinking about post-scarcity software is to get away from thinking parsimoniously. While obviously we do still have finite store and at some stage in development it will be time to ask what are the sensible compromises to make, that time is not now. To get up and running, and to make debugging of memory sllocation easy, we'll be expansive. + +## Header + +Every cons space object has a header and each header shall be the same size with the same subdivisions. + +### Tag + +The tag identifies the type of the cons space object. There must be at least sufficient tag values for all the possible types of cons space objects. Actually the number of potential types of cons space objects is quite low, but at present I don't know how many I'll need. Sixteen values (4 bits) may be enough, but for the time being we'll reserve 32 bits. We'll think of these bits both as an unsigned 32 bit integer, and as a string of four ASCII characters; that is, we'll assign for now only numeric values which, if considered as an ASCII string, result in useful mnemonics. This will make memory dumps easy to read, which will aid in debugging memory allocation. + +### Count + +Either the count or the mark are redundant. The count is for reference counting garbage collection; the mark is for mark-and-sweep (including generational mark-and-sweep) garbage collection. Ultimately we probably need only one of these; conventional wisdom is that generational mark and sweep will win. But I want to banchmark both systems and see how they perform, so for now we'll have both. + +A reference count counts how many other objects point to this object. When the reference count decrements to zero, the object may safely be garbage collected. However, when a reference count can no longer be safely incremented, neither can it ever be safely decremented. Suppose we had three bits - eight values including zero, 0...7 - for the reference count. Suppose six other objects point to this object, so the reference count is 6. Now suppose one of those objects is freed, so no longer points to this object. Our reference count is decremented to 5, and that's OK. + +But, suppose seven objects already point to this object; our reference count is now 7. If an eigth object is created which points to this object, we cannot increment the reference count because we no longer have bits to store the incremented value. So we have to leave it at 7. Now, suppose another object which points to this object is freed: do we decrement the reference counter? No: we can't, because we can't know whether the actual number of objects which point to it is seven, or eight, or one hundred. + +Consequently, for any size of reference counter, when it hits its maximum value it can no longer be decremented, and consequently a reference counting garbage collector can no longer free that object - ever. It is possible to write a hybrid reference-counting/mark-and-sweep garbage collector, but that is both expensive and complicated. We need a size of reference count which will very, very rarely overflow in practice. That's probably still quite small, but I'm proposing to reserve 24 bits (16,777,216 values) (in fact the current implementation reserves 32 bits - see [consspaceobject.h](https://github.com/simon-brooke/post-scarcity/blob/master/src/consspaceobject.h)). + +### Mark + +A mark and sweep garbage collector actually only needs one mark bit, but for now it will sit in the same space as the reference count, since we're only using one or other, never both. + +### Access control + +Access control is a [[cons pointer]], see below; and is consequently the size of a cons pointer, which is presently 64 bits. An access control value of NIL means only system processes may access the cell; an access control value of TRUE means any user can access the cell; otherwise, the access control pointer points to the first cons cell of a list of allowed users/groups. The access control list is thus an ordinary list in ordinary cons space, and cells in an access control list can have access control lists of their own. As cons cells are immutable, infinite recursion is impossible; but it is nevertheless probably a good thing if access control list cells normally have an access control list of either TRUE or NIL. + +### Car, Cdr: Cons pointers + +A [[cons pointer]] is simply a pointer to a cons cell, and the simplest way to implement this is exactly as the memory address of the cons cell. + +We have a fixed size vector of total memory, which we address in eight bit words (bytes) because that's the current convention. Our cons cell size is 32 bytes. So 31/32 of the possible values of a cons pointer are wasted - there cannot be a valid cons cell at that address. Also, our total memory must be divided between cons space, vector space and stack (actually stack could be implemented in either cons space or vector space, and ultimately may end up being implemented in cons space, but that's a highly non-trivial detail which will be addressed much later). In practice it's likely that less than half of the total memory available will be devoted to cons space. So 63/64 of the possible values of a cons pointer are wasted. + +Is there a better way? Yes, there is, but as in all engineering matters it's a trade off. + +One of the things I absolutely hate about modern computers is their tendency to run out of one 'sort' of memory while there is actually plenty of memory free. For example, it's childishly easy to run any JVM program out of stack space, because the JVM on startup reserves a fixed size block of memory for stack, and cannot extend this block. When it's exhausted, execution halts, and you've had your chips. There is no recovery. + +That was acceptable when the JVM was a special purpose platform for developing software for small embedded devices, which is what it was originally designed for. But it's one of the compromises the JVM makes in order to work well on small embedded devices which is completely unacceptable for post-scarcity computing. And we won't accept it. + +But be that as it may, we don't know at system initialisation time how much memory to reserve for cons space, and how much for vector space ('the heap'). If we reserve too much for cons space, we may run out of vector space while there's still cons space free, and vice versa. So we'll reserve cons space in units: [[cons pages]]. If our cons pointers are absolute memory addresses, then it becomes very expensive to move a cons page in memory, because all the pointers in the whole system to any cell on the page need to be updated. + +(**NOTE**: As my thinking has developed, I'm now envisaging one cons page per compute node, which means that on each node the division between cons space and vector space will have to be fixed) + +If, however, we divide our cons pointer into two elements, a page number and a page offset. Suppose we have 40 bits of page number (up to 1,099,511,627,776 - one trillion - pages) and 24 bits of page offset (up to 16,777,216 cons cells on a page), then suddenly we can address not 2^64 bytes of memory in cons space, but 32x2^64. Furthermore, this cons space addressing is now independent of vector space addressing, allowing even further address space. + +Obviously it also means that to fetch any cell, the processor has to first fetch the address of the page, then compute the address of the offset of the cell in the page, then fetch the cell at the computed address, making three processor cycles instead of just one. We're post-scarcity: at this stage, we don't worry about such things. The time to worry about run-time performance is far beyond version 0. + +So our cons cell is now 32 bytes, 256 bits: + + +-----+-------+------+----------------+--------------+--------------+ + | header | payload | + + +--------------+--------------+ + | | car | cdr | + +-----+-------+------+----------------+--------------+--------------+ + | 0 | 32 | 56 | 64 | 128 | 192 ...255 | + | tag | count | mark | access-control | cons-pointer | cons-pointer | + +-----+-------+------+----------------+--------------+--------------+ + +## Types of cons space object + +This is a non-exhaustive list of types of things which may be stored in cons space; each has a memory representation which is 128 bits or less, and will thus fit in the memory footprint of a cons cell. There will be others I have not yet thought of, but this is enough to get us started. + +### CONS + +A cons cell. The tag value of a CONS cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'CONS'. The count of a CONS cell is always non-zero. The mark is up to the garbage collector. The Car of a CONS cell is a pointer to another cons-space object, or NIL (address zero). + +### FREE + +An unassigned cons cell. The tag value of a FREE cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'FREE'. The count of a FREE cell is always zero. The mark of a free cell is always zero. The access control value of a FREE cell is always NIL. The Car of a FREE cell is always NIL (address zero). The Cdr of a FREE cell is a cons-pointer to the next FREE cell (the [[free list]] pointer). + +### INTR + +An integer; possibly an integer which isn't a big integer. The tag value of a INTR cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'INTR'. The count of a INTR cell is always non-zero. The mark is up to the garbage collector. + +There's fundamentally two ways to do this; one is we store up to 128 bit signed integers in the payload of an INTR cell, and have some other tag for an integer ('[[bignum]]') which overflows 128 bits and must thus be stored in another data structure; or else we treat one bit as a 'bignum' flag. If the bignum flag is clear we treat the remaining 127 bits as an unsigned 127 bit integer; if set, we treat the low 64 bits of the value as a cons pointer to the data structure which represents the bignum. + +### NIL + +The canonical empty list. May not actually exist at all: the cell-pointer whose value is zero is deemed to point to the canonical empty list. However, if zero is a valid cell-pointer, the cell at pointer zero will be initialised with the tag "NIL " (i.e. the 32 bit unsigned integer which, when considered as an ASCII string, reads "NIL "). The count of the NIL cell is the maximum reference count value - that is, it can never be garbage collected. The mark is always 1 - that is, it can never be garbage collected. The access control value is TRUE - any user can read NIL. The payload is zero. + +### READ + +A stream open for reading. The tag value of a READ cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'READ'. The count of a READ cell is always non-zero. The mark is up to the garbage collector. + +I'm not yet certain what the payload of a READ cell is; it is implementation dependent and, at least in version zero, will probably be a file handle from the underlying system. + +### REAL + +A real number. The tag value of a REAL cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'REAL'. The count of a REAL cell is always non-zero. The mark is up to the garbage collector. The payload is a IEEE 754R 128-bit floating point number. + +### STRG + +A string. The tag value of a STRG cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'STRG'. The count of a STRG cell is always non-zero. The mark is up to the garbage collector. The Car of an STRG cell contains a single UTF character. The Cdr of an STRG cell contains a cons-pointer to the remainder of the string, or NIL if this is the end of the string. + +Note that in this definition a string is not an atom, which is probably right. But we also at this stage don't have an idea of a [[symbol]]. Very likely we'll end up with the idea that a string which is bound to a value in a namespace is for our purposes a symbol. + +Note, however, that there's a risk that we might have two instances of strings comprising identical characters in identical order, one of which was bound in a namespace and one of which wasn't; string equality is something to worry about. + +### TIME + +At nanosecond resolution (if I've done my arithmetic right), 128 bits will represent a span of 1 x 10²² years, or much longer than from the big bang to the [estimated date of fuel exhaustion of all stars](https://en.wikipedia.org/wiki/Timeline_of_the_far_future). So I think I'll arbitrarily set an epoch 14Bn years before the UNIX epoch and go with that. The time will be unsigned - there is no time before the big bang. + +### TRUE + +The canonical true value. May not actually exist at all: the cell-pointer whose value is one is deemed to point to the canonical true value. However, if one is a valid cell-pointer, the cell at pointer zero will be initialised with the tag "TRUE" (i.e. the 32 bit unsigned integer which, when considered as an ASCII string, reads "TRUE"). The count of the TRUE cell is the maximum reference count value - that is, it can never be garbage collected. The mark is always 1 - that is, it can never be garbage collected. The access control value is TRUE: any user can read the canonical true value. The payload is zero. + +### VECP + +A pointer into vector space. The tag value of a VECP cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'VECP'. The count of a VECP cell is always non-zero. The mark is up to the garbage collector. The payload is the a pointer to a vector space object. On systems with an address bus up to 128 bits wide, it's simply the address of the vector; on systems with an address bus wider than 128 bits, it's probably an offset into an indirection table, but that really is a problem for another day. + +As an alternate implementation on hardware with a 64 bit address bus, it might be sensible to have the Car of the VECP cell simply the memory address of the vector, and the Cdr a pointer to the next VECP cell, maintained automatically in the same way that a [[free list]] is maintained. This way we automatically hold a list of all live vector space objects, which would help in garbage collecting vector space. + +Every object in vector space shall have exactly one VECP cell in cons space which refers to it. Every other object which wished to hold a reference to that object shall hold a cons pointer to VECP cell that points to the object. Each object in vector space shall hold a backpointer to the VECP cell which points to it. This means that if vector space needs to be shuffled in order to free memory, for each object which is moved only one pointer need be updated. + +When the reference count of a VECP cell is decremented to zero, the backpointer on the vector to which it points will be set to NIL (zero), marking it as available for garbage collection. + +### WRIT + +A stream open for writing. The tag value of a WRIT cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'WRIT'. The count of a WRIT cell is always non-zero. The mark is up to the garbage collector. + +I'm not yet certain what the payload of a WRIT cell is; it is implementation dependent and, at least in version zero, will probably be a file handle from the underlying system. + + +## Cons pages + +Cons cells will be initialised in cons pages. A cons page is a fixed size array of cons cells. Each cell is initialised as FREE, and each cell, as it is initialised, is linked onto the front of the system [[free list]]. Cons pages will exist in [[vector space]], and consequently each cons page will have a vector space header. \ No newline at end of file diff --git a/docs/Core-functions.md b/docs/Core-functions.md new file mode 100644 index 0000000..772fd32 --- /dev/null +++ b/docs/Core-functions.md @@ -0,0 +1,93 @@ +# Core functions + +In the specifications that follow, a word in all upper case refers to a tag value, defined on either the [[cons space]] or the [[vector space]] page. + +# (and args...) + +Public. Takes an arbitrary number of arguments. Returns true if all are readable by the current user and evaluate to non-NIL. _Note that evaluation of args may be parallelised across a number of processors, so you *cannot* use this for flow control._ + +# (atom? arg) + +Public. Takes one argument. Returns TRUE if that argument is neither a CONS cell, a VECP, nor a STRG cell, else NIL. + +# (append args...) + +Public. Takes an arbitrary number of arguments, which should either all be CONS cells or all STRG cells. In either case returns a concatenation of all those arguments readable by the current user. + +# (assoc key store) + +Public. Takes two arguments, a key and a store. The store may either be a CONS forming the head of a list formatted as an [[assoc list]], or else a VECP pointing to a HASH. If the key is readable by the current user, returns the value associated with that key in the store, if it exists and is readable by the current user, else NIL. + +# (car arg) + +Public. Takes one argument. If that argument is a CONS cell and is readable by the current user, returns the value indicated by the first pointer of that cell; if the argument is an STRG and is readable by the user, a CHAR representing the first character in the string; else NIL. + +# (cdr arg) + +Public. Takes one argument. If that argument is a CONS or STRG cell and is readable by the current user, returns the value indicated by the second pointer of that cell, else NIL. + +# (cond args...) + +Public. Takes an arbitrary number of arguments each of which are lists. The arguments are examined in turn until the first element of an argument evaluates to non-nil; then each of the remaining elements of that argument are evaluated in turn and the value of the last element returned. If no argument has a first element which evaluates to true, returns NIL. _Note: this is explicit flow control and clauses will not be evaluated in parallel._ + +# (cons a d) + +Public. Takes two arguments, A, D. Returns a newly allocated cons cell whose first pointer points to A and whose second points to D. + +# (eq? a b) + +Public. Takes two arguments, A, B. Returns TRUE if both are readable by the current user and are the same cons space object (i.e. pointer equality), else NIL. + +# (eval arg) + +Public. Takes one argument. +* if that argument is not readable by the current user, returns NIL. +* if that argument is a CONS, returns the result of + (apply (car arg) (cdr arg)) +* if that argument is an INTR, NIL, REAL, STRG, TRUE or VECP, returns the argument. +* if that argument is a READ or a WRIT, _probably_ returns the argument but I'm not yet certain. + +# (intern str), (intern str namespace) + +Public. +* If one argument, being a STRG readable by the current user, interns that string as a symbol in the current namespace (by binding it to a special symbol *sys-intern*, which has its access control set NIL). +* if two arguments, being a STRG and a VECP pointing to a HASH, interns that string in the specified hash. + +_Note: I'm not sure what happens if the STRG is already bound in the HASH. A normal everyday HASH ought to be immutable, but namespaces can't be immutable or else we cannot create new stuff._ + +# (lambda args forms...) + +Public. Takes an arbitrary number of arguments. Considers the first argument ('args') as a set of formal parameters, and returns a function composed of the forms with those parameters bound. Where I say 'returns a function', this is in initial prototyping probably an interpreted function (i.e. a code tree implemented as an S-expression), but in a usable version will mean a VECP (see [[cons space#VECP]]) pointing to an EXEC (see [[vector space#EXEC]]) vector. + +# (nil? arg) + +Public. Takes one argument. Returns TRUE if the argument is NIL. May also return TRUE if the argument is not readable by the current user (on the basis that what you're not entitled to read should appear not to exist) but this needs more thought. + +# (not arg) + +Public. Takes one argument. Returns TRUE if that argument is NIL, else NIL. _Note: Not sure what happens when the argument is not NIL but not readable by the current user. If we return NIL, as we usually do for an unreadable argument, then that's a clue that the object exists but is not readable. Generally, when an object is not readable, it appears as though it doesn't exist._ + +# (number? arg) + +Public. Takes one argument. Returns TRUE if the argument is readable by the current user and is an INTR, REAL, or some other sort of number I haven't specified yet. + +# (or args...) + +Public. Takes an arbitrary number of arguments. Returns TRUE if at least one argument is readable by the current user and evaluates to non-NIL. _Note that evaluation of args may be parallelised across a number of processors, so you *cannot* use this for flow control._ + +# (print arg write-stream) + +Public. Takes two arguments, the second of which must be a WRIT that the current user has access to. Writes the canonical printed form of the first argument to the second argument. + +# (quote arg) + +Public. Takes one argument. Returns that argument, protecting it from evaluation. + +# (read arg) + +Public. Takes one argument. If that argument is either an STRG or a READ, parses successive characters from that argument to construct an S-expression in the current environment and returns it. + +# (type arg) + +Public. Takes one argument. If that argument is readable by the current user, returns a string interned in the *core.types* namespace representing the tag value of the argument, unless the argument is a VECP in which case the value returned represents the tag value of the [[vector space]] object indicated by the VECP. + diff --git a/docs/Free-list.md b/docs/Free-list.md new file mode 100644 index 0000000..2b1fc13 --- /dev/null +++ b/docs/Free-list.md @@ -0,0 +1,7 @@ + + +A free list is a list of FREE cells consed together. When a cell is deallocated, it is consed onto the front of the free list, and the system free-list pointer is updated to point to it. A cell is allocated by popping the front cell off the free list. + +If we attempt to allocate a new cell and the free list is empty, we allocate a new code page, cons all its cells onto the free list, and then pop the front cell off it. + +However, because we wish to localise volatility in memory in order to make maintaining a consistent backup image easier, it may be worth maintaining a separate free list for each page, and allocating cells not from the front of the active free list but from the free list of the currently most active page. diff --git a/docs/Hashing-structure-writ-large.md b/docs/Hashing-structure-writ-large.md new file mode 100644 index 0000000..05e698a --- /dev/null +++ b/docs/Hashing-structure-writ-large.md @@ -0,0 +1,156 @@ +In Lisp, there's an expectation that any object may act as a key in a hash table. What that means, in practice, is that if a list + +```lisp +'(foo bar ban) +``` + +is a key, and we pass a list + +```lisp +'(foo bar ban) +``` + +as a query, we ought to get the value to which the first instance of `'(foo bar ban)' was bound, even if the two instances are not the same instance. Which means we have to compute the hash value by exploring the whole structure, no matter how deep and convoluted it may be. + +## The cost of this + +The cost of this, in the [post scarcity software environment](https://git.journeyman.cc/simon/post-scarcity) is potentially enormous: is potentially a blocker which could bring the whole project down. The post-scarcity architecture as currently conceived allows for 264 cons cells. Take the most obvious example of a wholly linear, non-branching structure, a string: it would be perverse, but possible to have a single string which occupied the entire address space. + +But to be less perverse, the text of English Wictionary is 3.9 billion words, so it's reasonable to assume that the text of the Encyclopaedia Brittanica is of the same order of magnitude. There are, on average, 4.7 characters in an English word, plus slightly more than one for punctuation, so we can round that up to six. So the string required to store the text of the Encyclopedia Brittanica would be approximately 24 billion characters long; and storing that in a string would not, in the context of the post-scarcity software environment, be utterly perverse. + +But the cost of hashing it would be enormous: would be even greater in the hypercube architecture of the proposed [post scarcity hardware](Post-scarcity-hardware.html) than on one with a [von Neumann architecture](https://en.wikipedia.org/wiki/Von_Neumann_architecture), since we cannot even split the string into chunks to take advantage of parallelism (since the string will almost certainly be non-contiguous in memory), so the hash has to be computed in a single thread, and also since all the cells of the string -- inevitably the majority -- not native to the memory map of the processor node calculating the hash have to be fetched hop-de-hop across the lattice of the hypercube, with each hop costing a minimum of six clock ticks (about 260 clock ticks over a serial link). + +A fully populated post scarcity hardware implementation -- i.e. one large enough to contain such perverse strings -- would be a hypercube of side 1625, which means the longest path between any pair of nodes is 812 hops, which means the average path is 406 hops. But, one in every four hops, if the machine is built as I currently conceive it, is a serial link. So the average cost of fetching a datum from an arbitrary node is (6 x 3 x (406 / 4)) + (260 x (406 / 4)), which is to say, roughly, 28,700 clock ticks. + +So to fetch the whole string takes about 30,000 x 24,000,000,000, or 720,000,000,000,000 clock ticks, which, assuming a 3GHz clock, is about quarter of a million seconds, or three days. + +To make matters worse, suppose we now stored the hash value in a hash table as the value of that string so as to avoid having to compute it again, we could then not ever garbage collect the string, since that hash table would contain a pointer to it. + +So clearly, hashing structures when required in the post scarcity software environment just will not work. + +## Finding a solution + +Necessarily, most data structures in the post scarcity software environment must be immutable, because most of the time we will be operating on copies of them in compute nodes remote from the node to which they are native. Thus, we can compute a hash value when the structure is first created, and cache it on the structure itself. + +This option first occurred to me in the special case of string-like-things (strings, atoms, keywords). Because a wide (32 bit UTF) character sits in 32 bits of memory, and a string cell has to sit in the memory footprint of a cons cell, my string payload had 32 unused bits: + +```c +/** + * payload of a string cell. At least at first, only one UTF character will + * be stored in each cell. The doctrine that 'a symbol is just a string' + * didn't work; however, the payload of a symbol cell is identical to the + * payload of a string cell. + */ +struct string_payload { + wint_t character; /* the actual character stored in this cell */ + uint32_t padding; /* unused padding to word-align the cdr */ + struct cons_pointer cdr; +}; +``` + +So it was straightforward to reassign that unused `padding` as a cache for the hash value: + +```c +/** + * payload of a string cell. At least at first, only one UTF character will + * be stored in each cell. The doctrine that 'a symbol is just a string' + * didn't work; however, the payload of a symbol or keyword cell is identical + * to the payload of a string cell, except that a keyword may store a hash + * of its own value in the padding. + */ +struct string_payload { + /** the actual character stored in this cell */ + wint_t character; + /** a hash of the string value, computed at store time. */ + uint32_t hash; + /** the remainder of the string following this character. */ + struct cons_pointer cdr; +}; +``` + +But new items can be consed onto the front of lists, and that means, in practice, new characters can be consed onto the front of strings, too. What this means is that + +```lisp +(hash "the quick brown fox jumped over the lazy dog") +``` + +and + +```lisp +(hash (append "the" "quick brown fox jumped over the lazy dog")) +``` + +must return the same value. But, obviously, we don't want to have to walk the whole structure to compute the hash, because we cannot know in principle, when passed a string, whether or not it is extremely long. + +The answer that occurred to me, for strings, is as follows: + +```c +/** + * Return a hash value for this string like thing. + * + * What's important here is that two strings with the same characters in the + * same order should have the same hash value, even if one was created using + * `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function + * has that property. I doubt that it's the most efficient hash function to + * have that property. + * + * returns 0 for things which are not string like. + */ +uint32_t calculate_hash(wint_t c, struct cons_pointer ptr) +{ + struct cons_space_object *cell = &pointer2cell(ptr); + uint32_t result = 0; + + switch (cell->tag.value) + { + case KEYTV: + case STRINGTV: + case SYMBOLTV: + if (nilp(ptr)) + { + result = (uint32_t)c; + } + else + { + result = ((uint32_t)c * + cell->payload.string.hash) & + 0xffffffff; + } + } + + return result; +} + +``` + +That is to say, the hash value is the least significant 32 bits of the product of multiplying the hash of the tail of the string by the character code of the character added. This means we have a very small fixed cost -- one 32 bit integer multiplication -- every time a character is added to a string, rather than an enormous cost every time the hash value of a string is required. I *believe* this is a good trade-off, just as I believe using reference counting rather than mark-and-sweep for garbage collection is a good trade-off: it's better, in my opinion, to have steady is slightly slower than optimal performance from the machine than for it to intermittently lock up for no apparent reason. + +In any case, what this means is that getting the hash value -- by the standard hashing function -- of a string cell is absurdly cheap: it's just a bit mask on the cell. + +Is this a good hash function? Probably not. A hash function should ideally distribute arbitrary values pretty evenly between hash buckets, and this one is probably biased. Perhaps at some stage someone will propose a better one. But in practice, I believe that this will do for now. It is, after all, extremely cheap. + +## To generalise, or not to generalise? + +Certainly in Clojure practice, keys in hash maps are almost always 'keywords', a particular variety of string-like-thing. Nevertheless, Clojure, like Common Lisp (and many, perhaps all, other lisps) allows, in principal, that any value can be used as a key in a hash map. + +The hack outlined above of using 32 bits of previously unused space in the string payload works because there were 32 unused bits in the string payload. While a hash function with similar properties can be imagined for cons cells, there are not currently any unused bits in a cons payload. To add a hash value would require adding more bits to every cons space object. + +Our current cons space object is 256 bits: + +``` ++-----+--------------+----------------+--------------+--------------+ +| header | payload | ++ +--------------+--------------+ +| | car | cdr | ++-----+--------------+----------------+--------------+--------------+ +| tag | count / mark | access-control | cons-pointer | cons-pointer | ++-----+--------------+----------------+--------------+--------------+ +| 32 | 32 | 64 | 64 | 64 | ++-----+--------------+----------------+--------------+--------------+ +``` + +This means that cells are word aligned in a 64 bit address space, and a perfect fit for a reasonably predictable future general purpose processor architecture with a 256 bit address bus. If we're now going to add more bits for hash cache, it would be perverse to add less than 64 bits because we'd lose word alignment; and it's not particularly likely, I think, that we'll see future processors with a 320 bit address bus. + +It would be possible to steal some bits out of either the tag, the count, or both -- 32 bits for the tag, in particular, is absurdly generous, but it does help greatly in debugging. + +For now, I'm of a mind to cache hash values only for string-like-things, and, if users want to use other types of values as keys in hash maps, use access-time hashing functions. After all, this works well enough in Common Lisp. \ No newline at end of file diff --git a/docs/Home.md b/docs/Home.md new file mode 100644 index 0000000..9efd688 --- /dev/null +++ b/docs/Home.md @@ -0,0 +1,30 @@ +# Post Scarcity Software Environment: general documentation + +Work towards the implementation of a software system like that described in [Post Scarcity Software](http://blog.journeyman.cc/2006/02/post-scarcity-software.html). + +## Note on canonicity + +*Originally most of this documentation was on a wiki attached to the [GitHub project](https://github.com/simon-brooke/post-scarcity); when that was transferred to [my own foregejo instance](https://git.journeyman.cc/simon/post-scarcity) the wiki was copied. However, it's more convenient to keep documentation in the project with the source files, and version controlled in the same Git repository. So while both wikis still exist, they should no longer be considered canonical. The canonical version is in `/docs`, and is incorporated by [Doxygen](https://www.doxygen.nl/) into the generated documentation — which is generated into `/doc` using the command `make doc`.* + +## AWFUL WARNING 1 + +This does not work. It isn't likely to work any time soon. If you want to learn Lisp, don't start here; try Clojure, Scheme or Common Lisp (in which case I recommend Steel Bank Common Lisp). If you want to learn how Lisp works, still don't start here. This isn't ever going to be anything like a conventional Lisp environment. + +What it sets out to be is a Lisp-like system which: + +* Can make use (albeit not, at least at first, very efficiently) of machines with at least [Zettabytes](http://highscalability.com/blog/2012/9/11/how-big-is-a-petabyte-exabyte-zettabyte-or-a-yottabyte.html) of RAM; +* Can make reasonable use of machines with at least tens of thousands of processors; +* Can concurrently support significant numbers of concurrent users, all doing different things, without them ever interfering with one another; +* Can ensure that users cannot escalate privilege; +* Can ensure users private data remains private. + +When Linus Torvalds sat down in his bedroom to write Linux, he had something usable in only a few months. BUT: + +* Linus was young, energetic, and extremely talented; I am none of those things. +* Linus was trying to build a clone of something which already existed and was known to work. Nothing like what I'm aiming for exists. +* Linus was able to adopt the GNU user space stack. There is no user space stack for this idea; I don't even know what one would look like. + +## AWFUL WARNING 2 + +This project is necessarily experimental and exploratory. I write code, it reveals new problems, I think about them, and I mutate the design. The documentation in this wiki does not always keep up with the developing source code. + diff --git a/docs/Homogeneity.md b/docs/Homogeneity.md new file mode 100644 index 0000000..064585a --- /dev/null +++ b/docs/Homogeneity.md @@ -0,0 +1,6 @@ +A homogeneity is a [[regularity]] which has a validation funtion associated with each key. A member can only be added to a homogeneity if not only does it have all the required keys, but the value of each key in the candidate member satisfies the validation function for that key. For example, the validation function for the age of a person might be something like + +``` +(fn [value] + (and (integer? value) (positive? value) (< value 140))) +``` \ No newline at end of file diff --git a/docs/How-do-we-notate-paths.md b/docs/How-do-we-notate-paths.md index 7cdbcb0..03403c5 100644 --- a/docs/How-do-we-notate-paths.md +++ b/docs/How-do-we-notate-paths.md @@ -4,7 +4,7 @@ In order to make the namespaces thing work, we need a convenient way to notate p In this discussion, a **namespace** is just a named, mutable hashmap (but not necessarily mutable by all users; indeed namespaces will almost always be mutable only by selected users. I cannot presently see a justified use for a publicly writable namespace). '**Named**', of a hashmap, merely means there is some path from the privileged root namespace which is the value of `oblist` which leads to that hashmap. A **path** is in principle just a sequence of keys, such that the value of each successive key is bound to a namespace in the namespace bound by its predecessor. The evaluable implementation of paths will be discussed later. -I think also that there must be a privileged **session** namespace, containing information about the current session, which the user can read but not write. +I think also that there must be a privileged **session** namespace, containing information about the current session, which the user can read but not write. The session namespace will be indicated by the privileged name '§'. ## Security considerations diff --git a/docs/Implementing-post-scarcity-hardware.md b/docs/Implementing-post-scarcity-hardware.md new file mode 100644 index 0000000..b8e0bc8 --- /dev/null +++ b/docs/Implementing-post-scarcity-hardware.md @@ -0,0 +1,72 @@ +The address space hinted at by using 64 bit cons-space and a 64 bit vector space containing objects each of whose length may be up to 1.4e20 bytes (2^64 of 64 bit words) is so large that a completely populated post-scarcity hardware machine can probably never be built. But that doesn't mean I'm wrong to specify such an address space: if we can make this architecture work for machines that can't (yet, anyway) be built, it will work for machines that can; and, changing the size of the pointers, which one might wish to do for storage economy, can be done with a few edits to consspaceobject.h. + +But, for the moment, let's discuss a potential 32 bit psh machine, and how it might be built. + +## Pass one: a literal implementation + + Let's say a processing node comprises a two core 32 bit processor, such as an ARM, 4GB of RAM, and a custom router chip. On each node, core zero is the actual processing node, and core one handles communications. We arrange these on a printed circuit board that is 4 nodes by 4 nodes. Each node is connected to the nodes in front, behind, left and right by tracks on the board, and by pins to the nodes on the boards above and below. On the edges of the board, the tracks which have no 'next neighbour' lead to some sort of reasonably high speed bidirectional serial connection — I'm imagining optical fibre (or possibly pairs of optical fibre, one for each direction). These boards are assembled in stacks of four, and the 'up' pins on the top board and the 'down' pins (or sockets) on the bottom board connect to similar high speed serial connectors. + + This unit of 4 boards — 64 compute nodes — now forms both a logical and a physical cube. Let's call this cube module a crystal. Connect left to right, top to bottom and back to front, and you have a hypercube. But take another identical crystal, place it along side, connect the right of crystal A to the left of crystal B and the right of B to the left of A, leaving the tops and bottoms and fronts and backs of those crystals still connected to themselves, and you have a larger cuboid with more compute power and address space but slightly lower path efficiency. Continue in this manner until you have four layers of four crystals, and you have a compute unit of 4096 nodes. So the basic 4x4x4 building block — the 'crystal' — is a good place to start, and it is in some measure affordable to build — low numbers of thousands of pounds, even for a prototype. + + I imagine you could get away with a two layer board — you might need more, I'm no expert in these things, but the data tracks between nodes can all go on one layer, and then you can have a raster bus on the other layer which carries power, backup data, and common signals (if needed). + + So, each node has 4Gb of memory (or more, or less — 4Gb here is just illustrative). How is that memory organised? It could be treated as a heap, or it could be treated as four separate pages, but it must store four logical blocks of data: its own curated conspage, from which other nodes can request copies of objects; its own private housekeeping data (which can also be a conspage, but from which other nodes can't request copies); its cache of copies of data copied from other nodes; and its heap. + + Note that a crystal of 64 nodes each with 4Gb or RAM has a total memory of 256Gb, which easily fits onto a single current generation hard disk or SSD module. So I'm envisaging that either the nodes take turns to back up their memory to backing store all the time during normal operation. They (obviously) don't need to backup their cache, since they don't curate it. + + What does this cost? About £15 per processor chip, plus £30 for memory, plus the router, which is custom but probably still in tens of pounds, plus a share of the cost of the board; probably under £100 per node, or £6500 for the 'crystal'. + +## Pass two: a virtual implementation + + OK, OK, this crystal cube is a pretty concept, but let's get real. Using one core of each of 64 chips makes the architecture very concrete, but it's not necessarily efficient, either computationally or financially. + + 64 core ARM chips already exist: + + 1. [Qualcom Hydra](https://eltechs.com/hydra-is-the-name-of-qualcomms-64-core-arm-server-processor/) - 64 of 64 bit cores; + 2. [Macom X-Gene](https://www.apm.com/products/data-center/x-gene-family/x-gene/) - 64 of 64 bit cores; + 2. [Phytium Mars](https://www.nextplatform.com/2016/09/01/details-emerge-chinas-64-core-arm-chip/) - 64 cores, but frustratingly this does not say whether cores are 32 or 64 bit + + There are other interesting chips which aren't strictly 64 core: + + 1. [Cavium ThunderX](https://www.servethehome.com/exclusive-first-cavium-thunderx-dual-48-core-96-core-total-arm-benchmarks) - ARM; 96 cores, each 64 bit, in pairs of two, shipping now; + 2. [Sparc M8](https://www.servethehome.com/oracle-sparc-m8-released-32-cores-256-threads-5-0ghz/) - 32 of 64 bit cores each capable of 8 concurrent threads; shipping now. + +## Implementing the virtual hypercube + + Of course, these chips are not designed as hypercubes. We can't route our own network of physical connections into the chips, so our communications channels have to be virtual. But we can implement a communications channel as a pair of buffers, an 'upstream' buffer writable by the lower-numbered processor and readable by the higher, and a 'downstream' buffer writable by the higher numbered processor and readable by the lower. Each buffer should be at least big enough to write a whole cons page object into, optionally including a cryptographic signature if that is implemented. Each pair of buffers also needs at least four bits of flags, in order to be able, for each direction, to be able to signal + + 0. Idle — the processor at the receiving end is idle and can accept work; + 1. Busy writing — the processor at the sending end is writing data to the buffer, which is not yet complete; + 2. Ready to read — the processor at the sending end has written data to the buffer, and it is complete; + 3. Read — the processor at the receiving end has read the current contents of the buffer. + + Thus I think it takes at least six clock ticks to write the buffer (set busy-writing, copy four 64 bit words into the buffer, set ready-to-read) and five to read it out — again, more if the messages are cryptographically signed — for an eleven clock tick transfer (the buffers may be allocated in main memory, but in practice they will always live in L2 cache). That's probably cheaper than making a stack frame. All communications channels within the 'crystal' cost exactly the same. + + But note! As in the virtual design, a single thread cannot at the same time execute user program and listen to communications from neighbours. So a node has to be able to run two threads. Whether that's two threads on a single core, or two cores per node, is a detail. But it makes the ThunderX and Spark M8 designs look particularly interesting. + + But note that there's one huge advantage that this single-chip virtual crystal has over the literal design: all cores access the same memory pool. Consequently, vector space objects never have to be passed hop, hop, hop across the communications network, all can be accessed directly; and to pass a list, all you have to pass is its first cons cell. So any S-Expression can be passed from any node to any of its 6 proximal neighbours in one hop. + + There are downsides to this, too. While communication inside the crystal is easier and quicker, communication between crystals becomes a lot more complex and I don't yet even have an idea how it might work. Also, contention on the main address bus, with 64 processors all trying to write to and read from the same memory at the same time, is likely to be horrendous, leading to much lower speed than the solution where each node has its own memory. + + On a cost side, you probably fit this all onto one printed circuit board as against the 4 of the 'literal' design; the single processor chip is likely to cost around £400; and the memory will probably be a little cheaper than on the literal design; and you don't need the custom routers, or the connection hardware, or the optical transceivers. So the cost probably looks more like £5,000. Note also that this virtual crystal has 64 bit processors (although address bus contention will almost certainly burn all that advantage and more). + +An experimental post-scarcity machine can be built now — and I can almost afford to build it. I don't have the skills, of course; but I can learn. + + + +## Size of a fully populated machine + +### Memory size + +To fully implement the software specification as currently written, each node would need 128Gb of RAM for its curated cons space alone (since we can have 232 cons cells each of 32 bytes); an amount of memory for vector space; substantial cache of objects being processed by the node but curated by other nodes; and scratchpad space. + +How much memory for vector space? The current software specification allows for vectors up to 32 times the total address space of currently available 64 bit processors. But not only could such objects not easily be stored with current generation technology, they could also not be copied across the hypercube lattice in any useful sort of time. So functions which operate on large vector space objects would necessarily have to migrate to the node where the object is curated, rather than have the object migrate. I don't currently have an account of how this could be done. + +However, obviously it is unaffordable to build a machine which can explore problems like that as a first prototype, so this is at present academic. + +### Lattice size + +If we hold to the doctrine of one cons page per node, which has the advantage of making addressing reasonably simple, then there can be up to 232, or 4,294,967,296 nodes, forming a hypercube of 1625 x 1625 x 1625 nodes. The total address space of this machine would be of the order of 79,228,162,514,264,337,593,543,950,336 bytes, or 7.9x1028. This is about 7 brontobytes - far beyond the zetabytes of my original sketch. + +Hello, I seem to have designed a computer which would terrify even the [Magratheans](https://hitchhikers.fandom.com/wiki/Magrathea). + diff --git a/docs/Interning-strings.md b/docs/Interning-strings.md new file mode 100644 index 0000000..c03516d --- /dev/null +++ b/docs/Interning-strings.md @@ -0,0 +1,98 @@ +# Interning strings + +I'm trying to understand what it means to intern a name in an environment with a messy and possibly shifting graph of namespaces. + +My current thinking is that in data terms a name is just a string. In evaluation terms, an unquoted string (in lexical terms one unprotected by enclosing quotation marks) is a name, while a quoted string is 'a string'. So, supposing the name **froboz** is not bound in the current environment, + + (eval froboz) + +causes an unbound variable exception to be thrown, while + + (eval "froboz") + +returns the value **"froboz"**. This begs the question of whether there's any difference between **"froboz"** and **'froboz**, and the answer is that at this point I don't know. + +There will be a concept of a root [[namespace]], in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. + +There must be some notation to say distinguish a request for the value of a name in the root namespace and the value of a name in the current namespace. For now I'm proposing that: + + (eval froboz) + +will return the value that **froboz** is bound to in the current namespace; + + (eval .froboz) + +will return the value that **froboz** is bound to in the root namespace; + + (eval foobar.froboz) + +will return the value that **froboz** is bound to in a namespace which is the value of the name **foobar** in the current namespace; and that + + (eval .system.users.simon.environment.froboz) + +will return the value that **froboz** is bound to in the environment of the user of the system called **simon**. + +The exact path separator syntax may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain. + +Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [[hashtable]] of individual path elements. + +Obviously this means there may be arbitrarily many paths which reference the same data item. This is intended. + +## Related functions + +### (intern! string) + +Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception. + +### (intern! string T) + +Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [[access control]] lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. + +### (intern! string T write-access-list) + +Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [[access control]] list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. + +### (set! string value) + +Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception. + +### (set! string value T) + +Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [[access control]] lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. + +### (set! string value T write-access-list) + +Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [[access control]] list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. + +### (put! string token value) + +Considers *string* as the path to some namespace, and binds *token* in that namespace to *value*. *Token* should not contain any path separator syntax. If the namespace doesn't exist or if the current user is not entitled to write to the namespace, throws an exception. + +### (string-to-path string) + +Behaviour as follows: + (string-to-path "foo.bar.ban") => ("foo" "bar" "ban") + (string-to-path ".foo.bar.ban") => ("" "foo" "bar" "ban") + +Obviously if the current user can't read the string, throws an exception. + +### (path-to-string list-of-strings) + +Behaviour as follows: + (path-to-string '("foo" "bar" "ban")) => "foo.bar.ban" + (path-to-string '("" "foo" "bar" "ban")) => ".foo.bar.ban" + +Obviously if the current user can't read some element of *list-of-strings*, throws an exception. + +### (interned? string) + +Returns a string lexically identical to *string* if *string*, considered as a path, is bound (i.e. +1. all the non-terminal elements of the path are bound to namespaces, +2. all these namespaces are readable by the current user; +3. the terminal element is bound in the last of these; + +Returns nil if *string* is not so bound, but all namespaces along the path are readable by the current user. + +I'm not certain what the behaviour should be if some namespace on the path is not readable. The obvious thing is to throw an access control exception, but there are two possible reasons why not: +1. It may turn out that this occurs too often, and this just becomes a nuisance; +2. From a security point of view, is evidence that there is something there to which you don't have access (but that is in a sense an argument against ever throwing an access exception at all). \ No newline at end of file diff --git a/docs/Lazy-Collections.md b/docs/Lazy-Collections.md new file mode 100644 index 0000000..22a7f5b --- /dev/null +++ b/docs/Lazy-Collections.md @@ -0,0 +1,36 @@ +# Lazy Collections + +If we're serious about a massively parallel architecture, and especially if we're serious about passing argument evaluation off to peer processors, then it would be madness not to implement lazy collections. + +Architecturally lazy collections violate the 'everything is immutable' rule, but only in a special case: you can do the equivalent of `replacd` on a cell that forms part of lazy collection, but only as you create it, before you release it to another process to be consumed; and you may only do it once, to replace the `NIL` list termination value with a pointer to a new lazy sell. + +From the consumer's point of view, assuming for the moment that the consumer is a peer processor, it looks just like a list, except that when you request an element which is, as it were, at the write cursor — in other words, the producing process hasn't yet generated the next element in the collection — the request will block. + +## How are lazy sequences created? + +Essentially, lazy collections are created by a very few primitive functions; indeed, it may boil down to just two,`read` which reads characters from a stream, and `mapc` which applies a function to successive values from a sequence. `reduce` may be a third lazy-generating function, but I suspect that it may be possible to write `reduce` using `mapc`. + +## What does a lazy sequence look like? + +Essentially you can have a lazy sequence of objects, which looks exactly like a list except that it's lazy, of a lazy sequence of characters, which looks exactly like a string except that it's lazy. For practical purposes it would be possible for `mapc` to generate perfectly normal `CONS` cells and for `read` to generate perfectly normal `STRG` cells, but we've actually no shortage of tags, and I think it would be useful for debugging and also for process scheduling to know whether one is dealing with a lazy construct or not. so I propose three new tags: + +* `LZYC` — like a cons cell, but lazy; +* `LZYS` — like a string cell, but lazy; +* `LZYW` — the thing at the end of a lazy sequence which does some work when kicked. + +I acknowledge that, given that keywords and symbols are also sequences of characters, one might also have lazy symbols and lazy keywords but I'm struggling to think of situations in which these would be useful. + +## How do we compute with lazy sequences in practice? + +Consider the note [[parallelism]]. Briefly, this proposes that a compile time judgement is made at the probable cost of evaluating each argument; that the one deemed most expensive to evaluate is reserved to be evaluated on the local node, and for the rest, a judgement is made as to whether it would be cheaper to hand them off to peers or to evaluate them locally. Well, for functions which return lazies –– and the compiler should certainly be able to infer whether a function will return a lazy — it will always make sense to hand them off, if there is an available idle peer to which to hand off. In fact, lazy-producers are probably the most beneficial class of function calls to hand off, since, if handed off to a peer, the output of the function can be consumed without any fancy scheduling on the local node. Indeed, if all lazy-producers can be reliably handed off, we probably don't need a scheduler at all. + +## How do lazy sequences actually work? + +As you iterate down a lazy list, you may come upon a cell whose `CDR` points to a 'Lazy Worker' (`WRKR`) cell. This is a pointer to a function. You (by which I mean the CDR function — just the ordinary everyday CDR function) mark the cell as locked, and call the function. + +1. It may compute and return the next value; or +2. it may return a special marker (which cannot be `NIL`, since that's a legitimate value), indicating that there will be no further values; or +3. it may block, waiting for the next value to arrive from a stream or something; or +4. it may return a special value (which I suspect may just be its own address) to indicate that 'yes, there are in principle more values to come but they're not ready yet'. + +In cases 1 above, you replace the `CDR` (hard replace — actual immutability defying change) of the sequence cell you were looking at with a new sequence cell of the same type whose `CAR` points to the newly delivered value and whose `CDR` points to the `WRKR` cell. diff --git a/docs/Memory-management.md b/docs/Memory-management.md new file mode 100644 index 0000000..c8da27b --- /dev/null +++ b/docs/Memory-management.md @@ -0,0 +1,80 @@ +# Memory management + +Most of the memory management ideas that I want to experiment with this thing are documented in essays on my blog: + +1. [Functional languages, memory management, and modern language runtimes](https://www.journeyman.cc/blog/posts-output/2013-08-23-functional-languages-memory-management-and-modern-language-runtimes/) +2. [Reference counting, and the garbage collection of equal sized objects](https://www.journeyman.cc/blog/posts-output/2013-08-25-reference-counting-and-the-garbage-collection-of-equal-sized-objects/) + +Brief summary: + +# The problem + +My early experience included Lisps with older, pre-generational, mark and sweep garbage collectors. The performance of these was nothing like as bad as some modern texts claim, but they did totally halt execution of the program for a period of seconds at unpredictable intervals. This is really undesirable. + +I became interested in reference counting garbage collectors, because it seemed likely that these would generate shorter pauses in execution. But received wisdom was that mark-and-sweep outperformed reference counting (which it probably does, overall), and that in any case generational garbage collection has so improved mark and sweep performance that the problem has gone away. I don't wholly accept this. + +## Separating cons space from vector space + +Lisps generate lots and lots of very small, equal sized objects: cons cells and other things which are either the same size as or even smaller than cons cells and which fit into the same memory footprint. Furthermore, most of the volatility is in cons cells - they are often extremely short lived. Larger objects are allocated much more infrequently and tend to live considerably longer. + +Because cons cells are all the same size, and because integers and doubles fit into the memory footprint of a cons cell, if we maintain an array of memory units of this size then we can allocate them very efficiently because we never have to move them - we can always allocate a new object in memory vacated by deallocating an old one. Deallocation is simply a matter of pushing the deallocated cell onto the front of the free list; allocation is simply a matter of popping a cell off the free list. + +By contrast, a conventional software heap fragments exactly because we allocate variable sized objects into it. When an object is deallocated, it leaves a hole in the heap, into which we can only allocate objects of the same size or smaller. And because objects are heterogeneously sized, it's probable that the next object we get to allocate in it will be smaller, leaving even smaller unused holes. + +Consequently we end up with a memory like a swiss cheese - by no means fully occupied, but with holes which are too small to fit anything useful in. In order to make memory in this state useful, you have to mark and sweep it. + +So my first observation is that [[cons space]] and what I call [[vector space]] - that is, the heap into which objects which won't fit into the memory footprint of a cons cell are allocated - are systematically different and require different garbage collection strategies. + +## Reference counting: the objections + +### Lockin from reference count overflow + +Older reference counting Lisps tended to allocate very few bits for the reference count. Typically a cons cell was allocated in 32 bits, with two twelve bit pointers, leaving a total of eight bits for the tag bits and the reference counter bits. So you had reference counters with only eight or sixteen possible values. When a reference counter hits the top value which can be stored in its field, it cannot be further incremented. So you cannot ever decrement it, because you don't know whether it represents `max-value` or, e.g., `max-value + 21`. So any cell which ended up with that number of other cells pointing to it, even if only very temporarily, got locked into memory and couldn't be garbage collected. + +But modern computers have vastly more memory than the computers on which those Lisps ran. My desktop machine now has more than 16,000 times as much memory as my very expensive workstation of only thirty years ago. We can afford much bigger reference counter fields. So the risk of hitting the maximum reference count value is much lower. + +### Lockin from circular data structures + +The other 'fault' of older reference counting Lisps is that in older Lisps, cons cells were not immutable. There were functions *RPLACA* and *RPLACD* which overwrote the value of the CAR and CDR pointers of a cons cell respectively. Thus it was possible to create circular data structures. In a reference counting Lisp, a circular data structure can never be garbage collected even if nothing outside the circle any longer points to it, because each cell in the circle is pointed to by another cell in the circle. Worse, any data structure outside the circle that is pointed to by a cell in the circle also cannot ever be garbage collected. + +So badly designed programs on reference counting Lisps could leak memory badly and consequently silt up and run out of allocatable store. + +But modern Lisps - like Clojure - use immutable data structures. The nature of immutable data structures is that an older node can never point to a newer node. So circular data structures cannot be constructed. + +### Performance + +When a memory management system with a reference counting garbage collector allocates a new cons cell, it needs to increment the reference counts on each of the cells the new cell points to. One with a mark-and-sweep garbage collector doesn't have to do this. When the system deallocates a cell, it has to decrement the counts on each of the cells it pointed to. One with a mark-and-sweep garbage collector doesn't have to do this. Overall, many well informed people have claimed to me, the performance of memory management system with a mark-and-sweep collector is a bit better than one with a reference counting garbage collector. + +That's probably true. + +## Why I think reference counting is nevertheless a good idea + +A reference counting garbage collector does a little bit of work every time a cell (or something else that points to a cell) is deallocated. It's unlikely ever to pause the system for noticeable time. In the extreme case, when you remove the one link that points to a massive, complex data structure, the cascade of deallocations might produce a noticeable pause but in most programs that's a very rare occurrence. You could even run the deallocator in a separate thread, evening out its impact on performance even further. + +Also, over the thirty years, the performance of our computers has also improved immeasurably. My desktop machine now has over 6,000 times the performance of a DEC VAX. We can afford to be a little bit inefficient. If reference counting were to prove to be 10% slower overall, it might still be preferable if it gave smoother performance. + +## Separate freelists for different sized holes + +We're still left with the possibility of fragmenting heap space in the manner I've described. Doing clever memory management of heap space can't be done if we depend on the memory management functions provided by the C or Rust compilers and their standard libraries, because while we know the size and location of memory allocations they've done for Lisp objects, we don't necessarily know the size or location of memory allocations they've made for other things. + +So if we're going to do clever memory management of heap space, we're probably going to have to claim heap space from the system in pages and allocate our objects within these pages. This bothers me both because there's a possibility of space wasted at the edges of the pages, and because it becomes more complex to allocate objects that are bigger than a page. + +The alternative is to bypass the standard library memory allocation and just allocate it ourselves, which will be tricky; but we can then manage the whole of the address space available to our process. + +Either way, most of the Lisp objects we allocate will be of a few sizes. A default hashtable is always yay big, for example; it has this many buckets. How many 'this many' is I don't yet know, but the point is it will be a standard number. When a hashtable overflows that standard size, we'll automatically replace it with another of a bigger, but still standard size. + +We're going to store strings in cons space, not vector space. There aren't a lot of things we're going to store in vector space. Probably raster images, or sound objects, will be the only ones which are truly variable in size. + +So if we have three or four fixed sizes which accommodate most of our vector space objects, we should create free lists for each of those sizes. When deallocating a default sized hashtable, for example, we'll link the newly freed memory block onto a special purpose freelist of blocks the size of a default sized hashtable; when we want to allocate a new default sized hashtable, we'll first check that freelist and, if it has one, pop it from there, before we ask the system to allocate new virgin memory. + +## Conclusion + +Even the 'separate freelists for different sized objects' idea won't prevent vector space fragmenting, although it may slow it considerably. Ultimately, mark and sweep of vector space will be needed and will be very expensive. It can be made much less expensive by dividing cons pointers into a page number field and an offset field rather than being a simple memory address, but that will make all memory access slower, so it too is a trade off. + +There are several possible approaches to optimising garbage collection. I want to try as many as possible of these approaches, although I'm not convinced that any of them will prove in the end better than a conventional generational garbage collector. Still, they're worth trying. + +What we need to do is build a system into which different memory management subsystems can be plugged, and to develop a set of benchmarks which aggressively test memory allocation and deallocation, and then see how the different possibilities perform in practice. + +## Further reading + +I've written a [number of essays](https://blog.journeyman.cc/search/label/Memory%20management) on memory management, of which I'd particularly point you to [Reference counting, and the garbage collection of equal sized objects](https://blog.journeyman.cc/2013/08/reference-counting-and-garbage.html). \ No newline at end of file diff --git a/docs/Names-of-things.md b/docs/Names-of-things.md new file mode 100644 index 0000000..7ac9ab2 --- /dev/null +++ b/docs/Names-of-things.md @@ -0,0 +1,10 @@ +* **assoc list** An assoc list is any list all of whose elements are cons-cells. +* **association** Anything which associates names with values. An *assoc list* is an association, but so it a *map*, a *namespace*, a *regularity* and a *homogeneity*. +* **homogeneity** A [[homogeneity]] is a *regularity* which has a validation funtion associated with each key. +* **keyword** A [[keyword]] is a token whose denotation starts with a colon and which has a limited range of allowed characters, not including punctuation or spaces, which evaluates to itself irrespective of the current binding environment. +* **map** A map in the sense of a Clojure map; immutable, adding a name/value results in a new map being created. A map may be treated as a function on *keywords*, exactly as in Clojure. +* **namespace** A namespace is a mutable map. Generally, if a namespace is shared, there will be a path from the oblist to that namespace. +* **oblist** The oblist is a privileged namespace which forms the root of all canonical paths. It is accessed at present by the function `(oblist)`, but it can be denoted in paths by the empty keyword. +* **path** A [[path]] is a list of keywords, with special notation and semantics. +* **regularity** A [[regularity]] is a map whose values are maps, all of whose members share the same keys. A map may be added to a regularity only if it has all the keys the regularity expects, although it may optionally have more. It is legitimate for the same map to be a member of two different regularities, if it has a union of their keys. Keys in a regularity must be keywords. Regularities are roughly the same sort of thing as objects in object oriented programming or tables in databases, but the values of the keys are not policed (see `homogeneity`). + \ No newline at end of file diff --git a/docs/Parallelism.md b/docs/Parallelism.md new file mode 100644 index 0000000..eef803a --- /dev/null +++ b/docs/Parallelism.md @@ -0,0 +1,43 @@ +# Parallelism + +If this system doesn't make reasonably efficient use of massively parallel processors, it's failed. The sketch hardware for which it's designed is [[Post Scarcity Hardware]]; that system probably won't ever exist but systems somewhat like it almost certainly will, because we're up against the physical limits on the performance of a von Neumann machine, and the only way we can increase performance now is by going increasingly parallel. + +So on such a system, every function invocation may normally delegate every argument to a different processor, if there is another processor free (which there normally will be). Only special forms, like *cond*, which implement explicit flow control, should serialise evaluation. + +Therefore the semantics of every function must assume that the order of the evaluation of arguments is undetermined, and that the environment in which each argument is evaluated cannot be influenced by the evaluation of any other argument. Where the semantics of a function violate this expectation, this must be made explicit in the documentation and there should probably be a naming convention indicating this also. + +This means, for example, that `and` and `or` cannot be used for flow of control. + +## Determining when to hand off computation of an argument to another node + +There's obviously a cost of transferring an argument to another node. The argument must be passed to the peer, and, if the argument points to something which isn't already in the peer's cache, the peer will need to fetch that something; and finally, the peer will have to pass the result back. + +Communications links to other nodes will be of varying speeds. Communication with a peer which is on the same piece of silicon will be fast, with a peer accessed over a parallel slower, with a peer accessed over a serial bus slower still. So one of the things each node must do in boot is to handshake with each of its proximal neighbours and determine the connection speed. This gives us a feeling for the cost of handoff. + +The other variable is the cost of computation. + +Suppose we are evaluating + +``` +(add 2 2) +``` + +Then there's clearly no point in handing anything off to a peer, since the arguments each evaluate to themselves. + +If we're evaluating + +``` +(add (cube-root pi) (multiply 2 2) (factorial 1000)) +``` + +Then clearly the first and third arguments are going to be costly to compute. As a programmer, I can see that by inspection; the goal has to be for the compiler to be able to assign functions to cost classes. + +If the node which starts the evaluation evaluates the most costly argument itself, then it's reasonable to suppose that by the time it's finished that the neighbours to whom it handed off the other two will have completed and returned their results (or will do so sooner than the original node could compute them). So the heuristics seem to be + +1. Don't hand off anything which evaluates to itself; +2. Don't hand off the argument the compiler predicts will be most expensive; +3. Only hand off to a slow to reach neighbour arguments the compiler predicts will be very expensive. + +Note that there will be different costs here depending whether we have one memory map per node (i.e. each node curates one cons page and its own vector space, and must copy objects from other nodes into its own space before it can compute on them), or one memory map per crystal, in which case nodes on the same crystal do not need to copy data across. + +Copying data, especially if it comes from a node further than a proximal neighbour, will be extremely expensive. \ No newline at end of file diff --git a/docs/Paths.md b/docs/Paths.md new file mode 100644 index 0000000..8cb1c6c --- /dev/null +++ b/docs/Paths.md @@ -0,0 +1,9 @@ +# Paths + +*See also [[How do we notate paths?]], which in part supercedes this.* + +A path is essentially a list of keywords. + +However, the path `(:aardvark :beluga :coeleocanth :dodo)` may be denoted `:aardvark:beluga:coeleocanth:dodo` and will be expanded into a list by the reader. If the value of `:ardvark` in the current environment is a map, and the value of `:beluga` in that map is a map, and the value of `:coeleocanth` in that map is a map, then the value of the path `:aardvark:beluga:coeleocanth:dodo` is whatever the value of `:dodo` is in the map indicated by `:aardvark:beluga:coeleocanth`; however if the path cannot be fully satisfied the value is `nil`. + +The notation `::aardvark:beluga:coeleocanth:dodo` is expanded by the reader into `((oblist) :aardvark :beluga :coeleocanth :dodo)`, or, in other words, is a path from the root namespace. \ No newline at end of file diff --git a/docs/Plan-overview.md b/docs/Plan-overview.md new file mode 100644 index 0000000..01a6aee --- /dev/null +++ b/docs/Plan-overview.md @@ -0,0 +1,12 @@ +# Plan overview + +1. Specify enough of memory arrangement and core functions that I can build something that can start, read (parse) a stream, allocate some memory, print what it's got, and exit. *(achieved)* +2. Build the above. *(achieved)* +3. Fully specify eval/apply, lambda, and def; make a decision whether to eval compiled code, interpreted code, or (at this stage) both. In the long term I want to eval compiled code only, but that requires working out how to generate the right code! *(achieved)* +4. Build enough of the system that I can write and evaluate new functions. *(achieved)* +5. Build enough of the system that two users can log in simultaneously with different identities, so as to be able to test user separation and privacy, but also sharing. +6. Try seriously to get compilation working. +7. Get system persistence working. +8. Get an emulated multi-node system working. +9. Get a bare-metal node working. +10. Get a hypercube (even if of only 2x2x2 nodes) working. diff --git a/docs/Post-scarcity-hardware.md b/docs/Post-scarcity-hardware.md new file mode 100644 index 0000000..74bfb3b --- /dev/null +++ b/docs/Post-scarcity-hardware.md @@ -0,0 +1,178 @@ +_I wrote this essay in 2014; it was previously published on my blog, [here](http://blog.journeyman.cc/2014/10/post-scarcity-hardware.html)_ + +Eight years ago, I wrote an essay which I called [[Post Scarcity Software]]. It's a good essay; there's a little I'd change about it now - I'd talk more about the benefits of immutability - but on the whole it's the nearest thing to a technical manifesto I have. I've been thinking about it a lot the last few weeks. The axiom on which that essay stands is that modern computers - modern hardware - are tremendously more advanced than modern software systems, and would support much better software systems than we yet seem to have the ambition to create. + +That's still true, of course. In fact it's more true now than it was then, because although the pace of hardware change is slowing, the pace of software change is still glacial. So nothing I'm thinking of in terms of post-scarcity computing actually needs new hardware. + +Furthermore, I'm a software geek. I know very little about hardware; but I'm very much aware that as parallelism increases, the problems of topology in hardware design get more and more difficult. I've no idea how physically to design the machines I'm thinking of. But nevertheless I have been thinking more and more, recently, about the design of post-scarcity hardware to support post-scarcity software. + +And I've been thinking, particularly, about one issue: process spawning on a new processor, on modern hardware, with modern operating systems, is ridiculously expensive. + +# A map of the problem + +What got me thinking about this was watching the behaviour of the [Clojure](http://clojure.org/) map function on my eight core desktop machine. + +Mapping, in a language with immutable data, in inherently parallelisable. There is no possibility of side effects, so there is no particular reason for the computations to be run serially on the same processor. MicroWorld, being a cellular automaton, inherently involves repeatedly mapping a function across a two dimensional array. I was naively pleased that this could take advantage of my modern hardware - I thought - in a way in which similarly simple programs written in Java couldn't... + +...and then was startled to find it didn't. When running, the automaton would camp on a single core, leaving the other seven happily twiddling their thumbs and doing minor Unixy background stuff. + +What? + +It turns out that Clojure's default *map* function simply serialises iterations in a single process. Why? Well, one finds out when one investigates a bit. Clojure provides two different versions of parallel mapping functions, *pmap* and *clojure.core.reducers/map*. So what happens when you swap *map* for *pmap*? Why, performance improves, and all your available cores get used! + +Except... + +Performance doesn't actually improve very much. Consider this function, which is the core function of the [MicroWorld](http://blog.journeyman.cc/2014/08/modelling-settlement-with-cellular.html) engine: + +
+    (defn map-world
+      "Apply this `function` to each cell in this `world` to produce a new world.
+       the arguments to the function will be the world, the cell, and any
+   `   additional-args` supplied. Note that we parallel map over rows but
+       just map over cells within a row. That's because it isn't worth starting
+       a new thread for each cell, but there may be efficiency gains in
+       running rows in parallel."
+      ([world function]
+        (map-world world function nil))
+      ([world function additional-args]
+        (into []
+           (pmap (fn [row]
+                    (into [] (map
+                             #(apply function
+                                     (cons world (cons % additional-args)))
+                             row)))
+                  world))))
+
+ +As you see, this maps across a two dimensional array, mapping over each of the rows of the array, and, within each row, mapping over each cell in the row. As you can see, in this current version, I parallel map over the rows but serial map over the cells within a row. + +Here's why: + +## Hybrid parallel/non-parallel version + +This is the current default version. It runs at about 650% processor loading - i.e. it maxes out six cores and does some work on a seventh. The eighth core is doing all the Unix housekeeping. + + (time (def x1 (utils/map-world + (utils/map-world w heightmap/tag-altitude (list hm)) + heightmap/tag-gradient))) + "Elapsed time: 24592.327364 msecs" + #'mw-explore.optimise/x1 + +## Pure parallel version + +Runs at about 690% processor loading - almost fully using seven cores. But, as you can see, fully one third slower. + + (time (def x2 (utils/map-world-p-p + (utils/map-world-p-p w heightmap/tag-altitude (list hm)) + heightmap/tag-gradient))) + "Elapsed time: 36762.382725 msecs" + #'mw-explore.optimise/x2 + +(For completeness, the *clojure.core.reducers/map* is even slower, so is not discussed in any further detail) + +## Non parallel version + +Maxes out one single core, takes about 3.6 times as long as the hybrid version. But, in terms of processor cycles, that's a considerable win - because 6.5 cores for 24 seconds is 156 seconds, so there's a 73% overhead in running threads across multiple cores. + + (time (def x2 (utils/map-world-n-n + (utils/map-world-n-n w heightmap/tag-altitude (list hm)) + heightmap/tag-gradient))) + "Elapsed time: 88412.883849 msecs" + #'mw-explore.optimise/x2 + +Now, I need to say a little more about this. It's obvious that there's a considerable set-up/tear-down cost for threads. The reason I'm using *pmap* for the outer mapping but serial *map* for the inner mapping rather than the other way round is to do more work in each thread. + +However, I'm still simple-mindedly parallelising the whole of one map operation and serialising the whole of the other. This particular array is 2048 cells square - so over four million cells in total. But, by parallelising the outer map operation, I'm actually asking the operating system for 2048 threads - far more than there are cores. I have tried to write a version of map using [Runtime.getRuntime().availableProcessors()](http://stackoverflow.com/questions/1980832/java-how-to-scale-threads-according-to-cpu-cores) to find the number of processors I have available, and then partitioned the outer array into that number of partitions and ran the parallel map function over that partitioning: + + (defn adaptive-map + "An implementation of `map` which takes note of the number of available cores." + [fn list] + (let [cores (.availableProcessors (. Runtime getRuntime )) + parts (partition-all (/ (count list) cores) list)] + (apply concat (pmap #(map fn %) parts)))) + +Sadly, as [A A Milne wrote](http://licoricelaces.livejournal.com/234435.html), 'It's a good sort of brake But it hasn't worked yet.' + +But that's not what I came to talk about. I came to talk about the draft... + +We are reaching the physical limits of the speed of switching a single processor. That's why our processors now have multiple cores. And they're soon going to have many more cores. Both Oracle ([SPARC](http://www.theregister.co.uk/2014/08/18/oracle_reveals_32core_10_beeellion_transistor_sparc_m7/)) and [ARM](http://www.enterprisetech.com/2014/05/08/arm-server-chips-scale-32-cores-beyond/) are demoing chips with 32 cores, each 64 bits wide, on a single die. [Intel and MIPS are talking about 48 core, 64 bit wide, chips](http://www.cpushack.com/2012/11/18/48-cores-and-beyond-why-more-cores/). A company called [Adapteva is shipping a 64 core by 64 bit chip](http://www.adapteva.com/products/silicon-devices/e64g401/), although I don't know what instruction set family it belongs to. Very soon we will have more; and, even if we don't have more cores on a physical die, we will have motherboards with multiple dies, scaling up the number of processors even further. + +# The Challenge + +The challenge for software designers - and, specifically, for runtime designers - is to write software which can use these chips reasonably efficiently. But the challenge, it seems to me, for hardware designers, is to design hardware which makes it easy to write software which can use it efficiently. + +## Looking for the future in the past, part one + +Thinking about this, I have been thinking about the [Connection Machine](http://en.wikipedia.org/wiki/Connection_Machine). I've never really used a Connection Machine, but there was once one in a lab which also contained a Xerox Dandelion I was working on, so I know a little bit about them. A Connection Machine was a massively parallel computer having a very large number - up to 65,536 - of very simple processors (each processor had a register width of one bit). Each processor node had a single LED lamp; when in use, actively computing something, this lamp would be illuminated. So you could see visually how efficient your program was at exploiting the computing resource available. + +\[Incidentally while reading up on the Connection Machine I came across this [delightful essay](http://longnow.org/essays/richard-feynman-connection-machine/) on Richard Feynman's involvement in the project - it's of no relevance to my argument here, but nevertheless I commend it to you\] + +The machine was programmed in a pure-functional variant of Common Lisp. Unfortunately, I don't know the details of how this worked. As I understand it each processor had its own local memory but there was also a pool of other memory known as 'main RAM'; I'm guessing that each processor's memory was preloaded with a memory image of the complete program to run, so that every processor had local access to all functions; but I don't know this to be true. I don't know how access to main memory was managed, and in particular how contention on access to main memory was managed. + +What I do know from reading is that each processor was connected to twenty other processors in a fixed topology known as a hypercube. What I remember from my own observation was that a computation would start with just one or a small number of nodes lit, and flash across the machine as deeply recursive functions exploded from node to node. What I surmise from what I saw is that passing a computation to an unoccupied adjacent node was extremely cheap. + +A possibly related machine from the same period which may also be worth studying but about which I know less was the [Meiko Computing Surface](http://www.new-npac.org/projects/cdroms/cewes-1999-06-vol1/nhse/hpccsurvey/orgs/meiko/meiko.html). The Computing Surface was based on the [Transputer T4](http://en.wikipedia.org/wiki/Transputer#T4:_32-bit) processor, a 32 bit processor designed specifically for parallel processing. Each transputer node had its own local store, and very high speed serial links to its four nearest neighbours. As far as I know there was no shared store. The Computing Surface was designed to be programmed in a special purpose language, [Occam](http://en.wikipedia.org/wiki/Occam_(programming_language)). Although I know that Edinburgh University had at one time a Computing Surface with a significant number of nodes, I don't know how many 'a significant number' is. It may have been hundreds of nodes but I'm fairly sure it wasn't thousands. However, each node was of course significantly more powerful than the Connection Machine's one bit nodes. + +## A caveat + +One of the lessons we learned in those high, far off, arrogant days was that special purpose hardware that could do marvellous things but was expensive lost out to much less capable but cheaper general purpose hardware. There's no point in designing fancy machines unless there's some prospect that they can be mass produced and widely used, because otherwise they will be too expensive to be practical; which presumes not only that they have the potential to be widely used, but also that you (or someone else related to the project) is able to communicate that potential to people with enough money to back the project. + +# Hardware for Post Scarcity software + +Before going forward with this argument, lets go back. Let's go back to the idea of the Clojure map function. In fact, let's go back to the idea of a function. + +If a processor is computing a function, and that function has an argument, then before the function can be computed the value of the argument must be computed; and, as the function cannot be computed until the value of the argument has been computed, there is no point in handing off the processing of the argument to another processor, because the first processor will then necessarily be idle until the value is returned. So it may just as well recurse up the stack itself. + +However, if a function has two arguments and values of both must be computed, then if the first processor can hand off processing of one of them to another, similar, processor, potentially the two can be processed in the time in which the original processor could process just one. Provided, that is, that the cost of handing off processing to another processor is substantially less than the cost of evaluating the argument - which is to say, as a general thing, the closer one can get the cost of handing off to another processor to the cost of allocating a stack frame on the current processor, the better. And this is where current-generation hardware is losing out: that cost of handing off is just way too high. + +Suppose, then, that our processor is a compute node in a Connection-Machine-like hypercube, able to communicate directly at high speed with twenty close neighbours (I'll come back to this point in detail later). Suppose also that each neighbour-connection has a 'busy' line, which the neighbour raises when it is itself busy. So our processor can see immediately without any need for doing a round-robin which of its neighbours are available to do new work. + +Our processor receives a function call with seven arguments, each of which is a further function call. It hands six of these off to idle neighbours, pushes one onto its own local stack, computes it, and recurses back to the original stack frame, waits for the last of the other six to report back a value, and then carries on with its processing. + +The fly in the ointment here is memory access. I assume all the processors have significant read-only cache (they don't need read-write cache, we're dealing with immutable data; and they only need a very small amount of scratchpad memory). If all six of the other processors find the data they need (for these purposes the executable function definition is also data) in local cache, all is good, and this will be very fast. But what if all have cache misses, and have to request the data from main memory? + +This comes down to topology. I'm not at all clear how you even manage to have twenty separate data channels from a single node. To have a data channel from each node, separately, to main memory simply isn't possible - not if you're dealing with very large numbers of compute nodes. So the data bus has to be literally a bus, available to all nodes simultaneously. Which means, each node that wants some data from main memory must ask for it, and then sit watching the bus, waiting for it to be delivered. Which also means that as data is sent out on the bus, it needs to be tagged with what data it is. + +## Looking for the future in the past, part two + +In talking about the Connection Machine which lurked in the basement of Logica's central London offices, I mentioned that it lurked in a lab where one of the [Xerox 1108 Dandelions](http://en.wikipedia.org/wiki/Interlisp) I was employed to work on was also located. The Dandelion was an interesting machine in itself. In typical computers - typical modern computers, but also typical computers of thirty years ago - the microcode has virtually the status of hardware. While it may technically be software, it is encoded immutably into the chip when the chip is made, and can never be changed. + +The Dandelion and its related machines weren't like that. Physically, the Dandelion was identical to the Star workstations which Xerox then sold for very high end word processing. But it ran different microcode. You could load the microcode; you could even, if you were very daring, write your own microcode. In its Interlisp guise, it had all the core Lisp functions as single opcodes. It had object oriented message passing - with full multiple inheritance and dynamic selector-method resolution - as a single opcode. But it also had another very interesting instruction: [BITBLT](http://en.wikipedia.org/wiki/Bit_blit), or 'Bit Block Transfer'. + +This opcode derived from yet another set, that developed for an earlier version of the same processor on which Smalltalk was first implemented. It copied an arbitrary sized block of bits from one location in memory to another location in memory, without having to do any tedious and time consuming messing about with incrementing counters (yes, of course counters were being incremented underneath, but they were in registers only accessible to the the microcode and which ran, I think, significantly faster than the 'main' registers). This highly optimised block transfer routine allowed a rich and responsive WIMP interface on a large bitmapped display on what weren't, underneath it all, actually terribly powerful machines. + +## BITBLT for the modern age + +Why is BITBLT interesting to us? Well, if we can transfer the contents of only one memory location over the bus in a message, and every message also needs a start-of-message marker and an object reference, then clearly the bus is going to run quite slowly. But if we can say, OK, here's an object which comprises this number of words, coming sequentially after this header, then the amount of overhead to queuing messages on the bus is significantly reduced. But, we need not limit ourselves to outputting as single messages on the bus, data which was contiguous in main memory. + +Most of the things which will be requested will be either vectors (yes, Java fans, an object is a vector) or lists. Vectors will normally point to other objects which will be needed at the same time as the vector itself is needed; list structures will almost always do so. Vectors will of course normally be contiguous in memory but the things they point to won't be contiguous with them; lists are from this point of view like structures of linked vectors such that each vector has only two cells. + +So we can envisage a bus transfer language which is in itself like a very simple lisp, except decorated with object references. So we might send the list '(1000 (2000) 3000) over the bus as notionally + +[ #00001 1000 [ #00002 2000 ] 3000 ] + +where '[' represents start-of-object, '#00001' is an object reference, '1000' is a numeric value, and ']' is end-of-object. How exactly is this represented on the bus? I'll come back to that; it isn't the main problem just now. + +## Requesting and listening + +Each processor can put requests onto the 'address bus'. Because the address bus is available to every processing node, every processing node can listen to it. And consequently every processing node does listen to it, noting every request that passes over the bus in a local request cache, and removing the note when it sees the response come back over the data bus. + +When a processing node wants a piece of data, it first checks its local memory to see whether it already has a copy. If it does, fine, it can immediately process it. If not, it checks to see whether the piece of data has already been requested. If it has not, it requests it. Then it waits for it to come up the bus, copies it off into local store and processes it. + +That all sounds rather elaborate, doesn't it? An extremely expensive way of accessing shared storage? + +Well, actually, no. I think it's not. Let's go back to where we began: to map. + +Mapping is a very fundamental computing operation; it's done all the time. Apply this same identical function to these closely related arguments, and return the results. + +So, first processor gets the map, and passes a reference to the function and arguments, together with indices indicating which arguments to work on, to each of its unemployed neighbours. One of the neighbours then makes a request for the function and the list of arguments. Each other processor sees the request has been made, so just waits for the results. While waiting, each in this second tier of processors may sub-partition its work block and farm out work to unemployed third tier neighbours, and so on. As the results come back up the bus, each processor takes its local copy and gets on with its partition, finally passing the results back to the neighbour who originally invoked it. + +## The memory manager + +All this implies that somewhere in the centre of this web, like a fat spider, there must be a single agent which is listening on the address bus for requests for memory objects, and fulfilling those requests by writing the objects out to the data bus. That agent is the memory manager; it could be software running on a dedicated processor, or it could be hardware. It really doesn't matter. It's operating a simple fundamental algorithm, maintaining a garbage collected heap of memory items and responding to requests. It shouldn't be running any 'userspace' code. + +Obviously, there has to be some way for processor nodes to signal to the memory manager that they want to store new persistent objects; there needs to be some way of propagating back which objects are still referenced from code which is in play, and which objects are no longer referenced and may be garbage collected. I know I haven't worked out all the details yet. Furthermore, of course, I know that I know virtually nothing about hardware, and have neither the money nor the skills to build this thing, so like my enormous game engine which I really know I'll never finish, it's really more an intellectual exercise than a project. + +But... I do think that somewhere in these ideas there are features which would enable us to build higher performance computers which we could actually program, with existing technology. I wouldn't be surprised to see systems fairly like what I'm describing here becoming commonplace within twenty years. + +\[Note to self: when I come to rework this essay it would be good to reference [Steele and Sussman, Design of LISP-based Processors](http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-514.pdf).\] \ No newline at end of file diff --git a/docs/Post-scarcity-software.md b/docs/Post-scarcity-software.md new file mode 100644 index 0000000..8f31771 --- /dev/null +++ b/docs/Post-scarcity-software.md @@ -0,0 +1,259 @@ +_This is the text of my essay Post-scarcity Software, originally published in 2006 on my blog [here](http://blog.journeyman.cc/2006/02/post-scarcity-software.html)._ + +For years we've said that our computers were Turing equivalent, equivalent to Turing's machine U. That they could compute any function which could be computed. They aren't, of course, and they can't, for one very important reason. U had infinite store, and our machines don't. We have always been store-poor. We've been mill-poor, too: our processors have been slow, running at hundreds, then a few thousands, of cycles per second. We haven't been able to afford the cycles to do any sophisticated munging of our data. What we stored - in the most store intensive format we had - was what we got, and what we delivered to our users. It was a compromise, but a compromise forced on us by the inadequacy of our machines. + +The thing is, we've been programming for sixty years now. When I was learning my trade, I worked with a few people who'd worked on Baby - the Manchester Mark One - and even with two people who remembered Turing personally. They were old then, approaching retirement; great software people with great skills to pass on, the last of the first generation programmers. I'm a second generation programmer, and I'm fifty. Most people in software would reckon me too old now to cut code. The people cutting code in the front line now know the name Turing, of course, because they learned about U in their first year classes; but Turing as a person - as someone with a personality, quirks, foibles - is no more real to them than Christopher Columbus or Noah, and, indeed, much less real than Aragorn of the Dunedain. + +In the passing generations we've forgotten things. We've forgotten the compromises we've made; we've forgotten the reasons we've made them. We're no longer poor. The machine on which I'm typing this - my personal machine, on my desk, used by no-one but me - has the processor power of slightly over six thousand DEC VAXes; it has the one hundred and sixty two thousand times as much core store as the ICL 1900 mainframe on which I learned Pascal. Yet both the VAX and the 1900 were powerful machines, capable of supporting dozens of users at the same time. Compared to each individual user of the VAX, of the 1900, I am now incalculably rich. Vastly. Incomprehensibly. + +And it's not just me. With the exception of those poor souls writing embedded code for micro-controllers, every programmer now working has processor and store available to him which the designers of the languages and operating systems we still use could not even have dreamed of. UNIX was designed when 32 bit machines were new, when 16,384 bytes was a lot of memory and very expensive. VMS - what we now call 'Windows XP' - is only a few years younger. + +The compromises of poverty are built into these operating systems, into our programming languages, into our brains as programmers; so deeply ingrained that we've forgotten that they are compromises, we've forgotten why we chose them. Like misers counting grains on the granary floor while outside the new crop is falling from the stalks for want of harvesting, we sit in the middle of great riches and behave as though we were destitute. + +One of the things which has made this worse in recent years is the rise of Java, and, following slavishly after it, C#. Java is a language which was designed to write programs for precisely those embedded micro-controllers which are still both store and mill poor. It is a language in which the mind-set of poverty is consciously ingrained. And yet we have adopted it as a general purpose programming language, something for which it is not at all suitable, and in doing so have taught another generation of programmers the mind-set of poverty. Java was at least designed; decisions were made for reasons, and, from the point of view of embedded micro-controllers, those reasons were good. C# is just a fit of pique as software. Not able to 'embrace and extend' Java, Microsoft aped it as closely as was possible without breaching Sun's copyright. Every mistake, every compromise to poverty ingrained in Java is there in C# for all the world to see. + +It's time to stop this. Of course we're not as wealthy as Turing. Of course our machines still do not have infinite store. But we now have so much store - and so many processor cycles - that we should stop treating them as finite. We should program as if we were programming for U. + +# Store, Name and Value + +So let's start with what we store, what we compute on: values. For any given column within a table, for every given instance variable in a class, every record, every object is constrained to have a value with a certain format. + +This is, of course, historical. Historically, when storage was expensive we stored textual values in fields of fixed width to economise on storage; we still do so largely because that's what we've always done rather than because there's any longer any rational reason to. Historically, when storage and computation were expensive, we stored numbers in twos-complement binary strings in a fixed number of bytes. That's efficient, both of store and of mill. + +But it is no longer necessary, nor is it desirable, and good computer languages such as LISP transparently ignores the difference between the storage format of different numbers. For example: + + (defun factorial (n) + (cond + ((eq n 1) 1) + (t (* n (factorial (- n 1)))))) + + ;; a quick way to generate very big numbers... + +We can add the value of factorial 100 to an integer, say 2, in just the same way that we can add any other two numbers: + + (+ (fact 100) 2) + 933262154439441526816992388562667004907159682643816214685929638952175999932299156089414639761565182862536979208272237582511852109168 64000000000000000000000002 + +We can multiply the value of factorial 100 by a real number, say pi, in just the same way as we can add any other two numbers: + + (* (factorial 100) pi) + 2.931929528260332*10^158 + +The important point to note here is that there's no explicit call to a bignum library or any other special coding. LISP's arithmetic operators don't care what the underlying storage format of a number is, or rather, are able transparently to handle any of the number storage formats - including bignums - known to the system. There's nothing new about this. LISP has been doing this since the late 1960s. Which is as it should be, and, indeed, as it should be in storage as well as in computation. + +A variable or a database field (I'll treat the two as interchangeable, because, as you will see, they are) may reasonably have a validation rule which says that a value which represents the longitude of a point on the Earth in degrees should not contain a value which is greater than 360. That validation rule is domain knowledge, which is a good thing; it allows the system to have some vestige of common sense. The system can then throw an exception when it is asked to store 764 as the longitude of a point, and this is a good thing. + +Why then should a database not throw an exception when, for example, a number is too big to fit in the internal representation of a field? To answer, here's a story I heard recently, which seems to be apocryphal, but which neatly illustrates the issue just the same. + +_The US Internal Revenue Service have to use a non-Microsoft computer to process Bill Gate's income tax, because Microsoft computers have too small an integer representation to represent his annual income._ + +Twos complement binary integers stored in 32 bits can represent plus or minus 2,147,483,648, slightly over two US billion. So it's easily possible that Bill Gates' income exceeds this. Until recently, Microsoft operating systems ran only on computers with a register size of 32 bits. Worryingly, the default integer size of my favourite database, Postgres, is also 32 bits. + +This is just wrong. Nothing in the domain of income places any fixed upper bound on the income a person may receive. Indeed, with inflation, the upper limit on incomes as quantity is likely to continue to rise. Should we patch the present problem by upping the size of the integer to eight bytes? + +In Hungary after the end of World War II inflation ran at 4.19 * 10^16 percent per month - prices doubled every 15 hours. Suppose Gates' income in US dollars currently exceeds the size of a thirty two bit integer, it would take at most 465 hours - less than twenty days - to exceed US$9,223,372,036,854,775,808. What's scary is how quickly you'd follow him. If your present annual salary is just thirty three thousand of your local currency units, then given that rate of inflation, you would overflow a sixty-four bit integer in just 720 hours, or less than a month. + +Lots of things in perfectly ordinary domains are essentially unbounded. They aren't shorts. They aren't longs. They aren't doubles. They're numbers. And a system asked to store a number should store a number. Failure to store a number because it's size violates some constraint derived from domain knowledge is desirable behaviour; failure to store a number because it size violates the internal storage representation of the system is just bad, outdated, obsolete system design. Yes, it's efficient of compute power on thirty-two bit processors to store values in thirty-two bit representations. Equally, it's efficient of disk space for a database to know in advance just how mush disk it has to reserve for each record in a table, so that to skip to the Nth record it merely has to skip forward (N * record-size) bytes. + +But we're no longer short of either processor cycles or disk space. For a database to reject a value because it cannot be stored in a particular internal representation is industrial archaeology. It is a primitive and antiquated workaround from days of hardware scarcity. In these days of post-scarcity computing, it's something we should long have forgotten, long have cast aside. + +This isn't to say that integers should never be stored in thirty-two bit twos complement binary strings. Of course they should, when it's convenient to do so. It's a very efficient storage representation. Of course, when a number overflows a thirty two bit cell, the runtime system has got to throw an exception, has got to deal with it, and consequently the programmer who writes the runtime system has still got to know about and understand the murky aspects of internal storage formats. + +Perhaps the language designer, and the programmer who writes the language compiler should, too, but personally I don't think so. I think that at the layer in the system - the level of abstraction - at which the compiler writer works, the operator 'plus' should just be a primitive. It takes two numbers, and returns a number. That's all. The details of whether that's a float, a double, a rational or a bignum should not be in the least relevant at the level of language. There is a difference which is important between a real number and an integer. The old statistical joke about the average family having 2.4 children is funny precisely because it violates our domain knowledge. No family has 2.4 children. Some things, including children, are discrete, however indiscreet you may think them. They come in integral quantities. But they don't come in short quantities or long quantities. Shorts and longs, floats and doubles are artefacts of scarcity of store. They're obsolete. + +From the point of view of the runtime designer, the difference between a quantity that can be stored in two bytes, or four, or eight must matter. From the point of view of the application designer, the language designer, even the operating system designer, they should disappear. An integer should be an integer, whether it represents the number of toes on your left foot (about 5), the number of stars in the galaxy (about 1x1011) or the number of atoms in the universe (about 1x1079). Similarly, a real number should be just a real number. + +This isn't to say we can't do data validation. It isn't to say we can't throw a soft exception - or even a hard one - when a value stored in a variable or field violates some expectation, which may be an expectation about size. But that should be an expectation based on domain knowledge, and domain knowledge alone; it should not be an expectation based on implementation knowledge. + +Having ranted now for some time about numbers, do you think I'm finished? I'm not. We store character values in databases in fields of fixed size. How big a field do we allocate for someone's name? Twenty four characters? Thirty-two? We've all done it. And then we've all found a person who violates our previous expectation of the size of a name, and next time we've made the field a little bigger. But by the time we've made a field big enough to store Charles Philip Arthur George Windsor or Sirimavo Ratwatte Dias Bandaranaike we've negated the point of fixed width fields in the first place, which was economy. There is no natural upper bound to the length of a personal name. There is no natural upper bound to the length of a street address. Almost all character data is a representation at some level of things people say, and the human mind doesn't work like that. + +Of course, over the past fifty years, we've tried to make the human mind work like that. We've given addresses standardised 'zip codes' and 'postcodes', we've given people standardised 'social security numbers' and 'identity codes'. We've tried to fit natural things into fixed width fields; we've tried to back-port the inadequacies of our technology onto the world. It's stupid, and it's time we stopped. + +So how long is a piece of string? How long is a string of characters? It's unbounded. Most names are short, because short names are convenient and memorable. But that does not mean that for any given number of characters, it's impossible that there should be something with a normal name of that length. And names are not the only things we store in character strings. In character strings we store things people say, and people talk a lot. + +At this point the C programmers, the Java programmers are looking smug. Our strings, they say, are unbounded. Sorry lads. A C string is a null terminated sequence of bytes. It can in principle be any length. Except that it lives in a malloced lump of heap (how quaint, manually allocating store) and the maximum size of a lump of heap you can malloc is size_t, which may be 231, 232, 263 or 264 depending on the system. Minus one, of course, for the null byte. In Java, similarly, the size of a String is an int, and an int, in Java, means 231. + +Interestingly, Paul Graham, in his essay 'The Hundred YearLanguage', suggests doing away with stings altogether, and representing them as lists of characters. This is powerful because strings become S-expressions and can be handled as S-expressions; but strings are inherently one-dimensional and S-expressions are not. So unless you have some definite collating sequence for a branching 'string' it's meaning may be ambiguous. Nevertheless, in principle and depending on the internal representation of a CONS cell, a list of characters can be of indefinite extent, and, while it isn't efficient of storage, it is efficient of allocation and deallocation; to store a list of N characters does not require us to have a contiguous lump of N bytes available on the heap; nor does it require us to shuffle the heap to make a contiguous lump of that size available. + +So; to reprise, briefly. + +A value is just a value. The internal representation of a value is uninteresting, except to the designer and author of the runtime system - the virtual machine. For programmers at every other level the internal representation of every value is DKDC: don't know, don't care. This is just as true of things which are fundamentally things people say, things which are lists and things which are pools, as it is of numbers. The representation that the user - including the programmer - deals with is the representation which is convenient and comfortable. It does not necessarily have anything to do with the storage representation; the storage representation is something the runtime system deals with, and that the runtime system effectively hides. Operators exposed by the virtual machine are operators on values. It is a fundamental error, a failure of the runtime designer's most basic skill and craft, for a program ever to fail because a value could not be represented in internal representation - unless the store available to the system is utterly exhausted. + +# Excalibur and the Pool + +A variable is a handle in a namespace; it gives a name to a value, so that we can recall it. Storing a value in a variable never causes an exception to be thrown because the value cannot be stored. But it may, reasonably, justifiably, throw an exception because the value violates domain expectations. Furthermore, this exception can be either soft or hard. We might throw a soft exception if someone stored, in a variable representing the age of a person in years, the value 122. We don't expect people to reach one hundred and twenty two years of age. It's reasonable to flag back to whatever tried to set this value that it is out of the expected range. But we should store it, because it's not impossible. If, however, someone tries to store 372 in a variable representing longitude in degrees, we should throw a hard exception and not store it, because that violates not merely a domain expectation but a domain rule. + +So a variable is more than just a name. It is a slot: a name with some optional knowledge about what may reasonably be associated with itself. It has some sort of setter method, and possibly a getter method as well. + +I've talked about variables, about names and values. Now I'll talk about the most powerful abstraction I use - possibly the most powerful abstraction in software - the namespace. A namespace is a sort of pool into which we can throw arbitrary things, tagging each with a distinct name. When we return to the pool and invoke a name, the thing in the pool to which we gave that name appears. + +## Regularities: tables, classes, patterns + +Database tables, considered as sets of namespaces, have a special property: they are regular. Every namespace which is a record in the same table has the same names. A class in a conventional object oriented language is similar: each object in the class has the same set of named instance variables. They match a pattern: they are in fact constrained to match it, simply by being created in that table or class. + +Records in a table, and instance variables in a class, also have another property in common. For any given name of a field or instance variable, the value which each record or object will store under that name is of the same type. If 'Age' is an integer in the definition of the table or class, the Age of every member will be an integer. This property is different from regularity, and, lacking a better word for it, I'll call it homogeneity. A set of spaces which are regular (i.e. share the same names) need not be homogeneous (i.e. share the same value types for those names), but a set which is homogeneous must be regular. + +But records in a table, in a view, in a result set are normally in themselves values whose names are the values of the key field. And the tables and views, too, are values in a namespace whose names are the table names, and so on up. Namespaces, like Russian dolls, can be nested indefinitely. By applying names to the nested spaces at each level, we can form a path of names to every space in the meta-space and to each value in each space, provided that the meta-space forms an acyclic directed graph (this is, after all, the basis of the XPath language. Indeed, we can form paths even if the graph has cycles, provided every cycle in the graph has some link back to the root. + +## Social mobility + +It's pretty useful to gather together all objects in the data space which match the same pattern; it's pretty useful for them all to have distinct names. So the general concept of a regularity which is itself a namespace is a useful one, even if the names have to be gensymed. + +To be in a class (or table), must a space be created in that class (or table)? I don't see why. One of my earlier projects was an inference engine called Wildwood, in which objects inferred their own class by exploring the taxonomy of classes until they found the one in which they felt most comfortable. I think this is a good model. You ought to be able to give your dataspace a good shake and then pull out of it as a collection all the objects which match any given pattern, and this collection ought to be a namespace. It ought to be so even if the pattern did not previously exist in the data space as the definition of a table or class or regularity or whatever you care to call it. + +A consequence of this concept is that objects which acquire new name-value pairs may move out of the regularity in which they were created either to exist as stateless persons in the no-man's land of the dataspace, or into a new regularity; or may form the seed around which a new regularity can grow. An object which acquires a value for one of its names which violates the validation constraints of one homogeneity may similarly move out into no-man's land or into another. In some domains, in some regularities, it may be a hard error to do this (i.e. the system will prevent it). In some domains, in some regularities, it may be a soft error (i.e. the system allows it under protest). In some domains, in some regularities, it may be normal; social mobility of objects will be allowed. + +## Permeability + +There's another feature of namespaces which gets hard wired into lots of software structures without very often being generalised, and that is permeability, semi-translucency. In my toolkit Jacquard, for example, values are first searched for in the namespace of http parameters; if not found there, in the namespace of cookies; next, in the namespace of session variables, then in local configuration parameters, finally in global configuration parameters. There is in effect a layering of semi-translucent namespaces like the veils of a dancer. + +It's not a pattern that's novel or unique to Jacquard, of course. But in Jacquard it's hard wired and in all the other contexts in which I've seen this pattern it's hardwired. I'd like to be able to manipulate the veils; to add, or remove, of alter the layering. I'd like this to be a normal thing to be able to do. +The Name of the Rose: normativeness and hegemony +I have a friend called Big Nasty. Not everyone, of course, calls him Big Nasty. His sons call him 'Dad'. His wife calls him 'Norman'. People who don't know him very well call him 'Mr Maxwell'. He does not have one true name. + +The concept of a true name is a seductive one. In many of the traditions of magic - and I have always seen software as a technological descendant or even a technological implementation of magic - a being invoked by its true name must obey. In most modern programming languages, things tend to have true names. There is a protocol for naming Java packages which is intended to guarantee that every package written anywhere in the world has a globally unique true name. Globally unique true names do then have utility. It's often important when invoking something to be certain you know exactly what it is you're invoking. + +But it does not seem to me that this hegemonistic view of the dataspace is required by my messy conception. Certainly it cannot be true that an object has only one true name, since it may be the value of several names within several spaces (and of course this is true of Java; a class well may have One True Name, but I can still create an instance variable within an object whose name is anythingILike, and have its value is that class). + +The dataspace I conceive is a soup. The relationships between regularities are not fixed, and so paths will inevitably shift. And in the dataspace, one sword can be in many pools - or even many times in the same pool, under different names - at the same time. We can shake the dataspace in different ways to see different views on the data. There should be no One True hegemonistic view. + +This does raise the question, 'what is a name'. In many modern relational databases, all primary keys are abstract and are numbers, even if natural primary keys exist in the data - simply because it is so easy to create a table with an auto-incrementer on the key field. Easy, quick, convenient, lazy, not always a good thing. In terms of implementation details, namespaces are implemented on top of hash tables, and any data object can be hashed. So can anything be a name? + +In principle yes. However, my preference would be to purely arbitrarily say no. My preference would be to say that a name must be a 'thing people say', a pronounceable sequence of characters; and also, with no specific upper bound, reasonably short. + +## The Problem with Syntax + +Let me start by saying that I really don't understand the problem with syntax. Programming language designers spend a lot of time worrying about it, but I believe they're simply missing the point. People say 'I can't learn LISP because I couldn't cope with all the brackets'. People - the Dylan team, for one - have developed systems which put a skin of 'normal' (i.e., ALGOL-like) syntax on top of LISP. I personally won't learn Python because I don't trust a language where white space is significant. But in admitting that prejudice I'm admitting to a mistake which most software people make. + +We treat code as if it wasn't data. We treat code as if it were different, special. This is the mistake made by the LISP2 brigade, when they gave their LISPs (ultimately including Common LISP) separate namespaces, one for 'code' and one for 'data'. It's a fundamental mistake, a mistake which fundamentally limits our ability to even think about software. + +What do I mean by this? + +Suppose I ask my computer to store pi, 3.14159265358979. Do I imagine that somewhere deep within the machine there is a bitmap representation of the characters? No, of course I don't. Do I imagine there's a vector starting with the bytes 50 46 49 51 49 53 57 ...? Well, of course, there might be, but I hope there isn't because it would be horribly inefficient. No, I hope and expect there's an IEEE 754 binary encoding of the form 01100100100001111...10. But actually, frankly, I don't know, and I don't care, provided that it is stored and that it can be computed with. + +However, as to what happens if I then ask my computer to show me the value it has stored, I do know and I do care. I expect it to show me the character string '3.14159265358979' (although I will accept a small amount of rounding error, and I might want it to be truncated to a certain number of significant figures). The point is, I expect the computer to reflect the value I have stored back to me in a form which it is convenient for me to read, and, of course, it can. + +We don't, however, expect the computer to be able to reflect back an executable for us in a convenient form, and that is in itself a curious thing. If we load, for example, the UNIX command 'ls' into a text editor, we don't see the source code. We see instead, the raw internal format. And the amazing thing is that we tolerate this. + +It isn't even that hard to write a 'decompiler' which can take a binary and reflect back source code in a usable form. Here, for example, is a method I wrote: + + /** + * Return my action: a method, to allow for specialisation. Note: this + * method was formerly 'getAction()'; it has been renamed to disambiguate + * it from 'action' in the sense of ActionWidgets, etc. + */ + public String getNextActionURL( Context context ) throws Exception + { + String nextaction = null; + + HttpServletRequest request = + (HttpServletRequest) context.get( REQUESTMAGICTOKEN ); + + if ( request != null ) + { + StringBuffer myURL = request.getRequestURL( ); + + if ( action == null ) + { + nextaction = myURL.toString( ); + + // If I have no action, default my action + // to recall myself + } + else + { + nextaction = + new URL( new URL( myURL.toString( ) ), action ).toString( ); + + // convert my action into a fully + // qualified URL in the context of my + // own + } + } + else + { // should not happen! + throw new ServletException( "No request?" ); + } + + return nextaction; + } + +and here is the result of 'decompiling' that method with an open-source Java decompiler, jreversepro: + + public String getNextActionURL(Context context) + throws Exception + { + Object object = null; + HttpServletRequest httpservletrequest = + (HttpServletRequest)context.get( "servlet_request"); + String string; + if (httpservletrequest != null) { + StringBuffer stringbuffer = httpservletrequest.getRequestURL(); + if (action == null) + string = stringbuffer.toString(); + else + string = new URL(new URL(stringbuffer.toString()) , + action).toString(); + } + else + throw new ServletException("No request?"); + + return (string); + } + +As you can see, the comments have been lost and some variable names have changed, but the code is essentially the same and is perfectly readable. And this is with an internal form which has not been designed with decompilation in mind. If decompilation had been designed for in the first place, the binary could have contained pointers to the variable names and comments. Historically we haven't done this, both for 'intellectual property' reasons and because of store poverty. In future, we can and will. + +Again, like so much in software, this isn't actually new. The microcomputer BASICs of the seventies and eighties 'tokenised' the source input by the user. This tokenisation was not of course compilation, but it was analogous to it. The internal form of the program that was stored was much terser then the representation the user typed. But when the user asked to list the program, it was expanded into its original form. + +Compilation - even compilation into the language of a virtual machine - is much more sophisticated than tokenising, of course. Optimisation means that many source constructs may map onto one object construct, and even that one source construct may in different circumstances map onto many object constructs. Nevertheless it is not impossible - nor even hugely difficult - to decompile object code back into readable, understandable and editable source. + +But Java syntax is merely a format. When I type a date into a computer, say '05-02-2005', and ask it to reflect that date back to me, I expect it to be able to reflect back to me '05-02-2006'. But I expect it to be able to reflect back to an American '02-05-2006', and to either of us 'Sunday 5th February 2006' as well. I don't expect the input format to dictate the output format. I expect the output format to reflect the needs and expectations of the person to whom it is displayed. + +To summarise, again. + +Code is data. The internal representation of data is Don't Know, Don't Care. The output format of data is not constrained by the input format; it should suit the use to which it is to be put, the person to whom it is to be displayed. + +Thus if the person to whom my Java code is reflected back is a LISP programmer, it should be reflected back in idiomatic LISP syntax; if a Python programmer, in idiomatic Python syntax. Let us not, for goodness sake, get hung up about syntax; syntax is frosting on the top. What's important is that the programmer editing the code should edit something which is clearly understandable to him or her. + +This has, of course, a corollary. In InterLISP, one didn't edit files 'out of core' with a text editor. One edited the source code of functions as S-expressions, in core, with a structure editor. The canonical form of the function was therefore the S-expression structure, and not the printed representation of it. If a piece of code - a piece of executable binary, or rather, of executable DKDC - can be reflected back to users with a variety of different syntactic frostings, none of these can be canonical. The canonical form of the code, which must be stored in version control systems or their equivalent, is the DKDC itself; and to that extent we do care and do need to know, at least to the extent that we need to know that the surface frosting can again be applied systematically to the recovered content of the archive. + +# If God does not write LISP + +I started my professional life writing LISP on Xerox 1108s and, later, 1186s - Dandelions and Daybreaks, if you prefer names to numbers. When I wanted to multiply two numbers, I multiplied two numbers. I didn't make sure that the result wouldn't overflow some arbitrary store size first. When a function I wrote broke, I edited in its structure in its position on the stack, and continued the computation. I didn't abort the computation, find a source file (source file? How crude and primitive), load it into a text editor, edit the text, save it, check for syntax errors, compile it, load the new binary, and restart the computation. That was more than twenty years ago. It is truly remarkable how software development environments have failed to advance - have actually gone backwards - in that time. + +LISP's problem is that it dared to try to behave as though it were a post-scarcity language too soon. The big LISP machines - not just the Xerox machines, the LMI, Symbolics, Ti Explorer machines - were vastly too expensive. My Daybreak had 8Mb of core and 80Mb of disk when PCs usually didn't even have the full 640Kb. They were out-competed by UNIX boxes from Sun and Apollo, which delivered less good software development environments but at a much lower cost. They paid the price for coming too early: they died. And programmers have been paying the price for their failure ever since. + +But you only have to look at a fern moss, a frond of bracken, an elm sapling, the water curling over the lip of a waterfall, to know that if God does not write LISP She writes some language so similar to LISP as to make no difference. DNA encodes recursive functions; turbulent fluids move in patterns formed by recursion, whorls within whorls within whorls. + +The internal structure, then, of the post scarcity language is rather lisp-like. Don't get hung up on that! Remember that syntax isn't language, that the syntax you see need not be the syntax I see. What I mean by saying the language is lisp-like is that its fundamental operation is recursion, that things can easily be arranged into arbitrary structures, that new types of structure can be created on the fly, that new code (code is just data, after all) can be created and executed on the fly, that there is no primacy of the structures and the code created by the programmer over the structures and code created by the running system; that new code can be loaded and linked seamlessly into a running system at any time. That instead of little discrete programs doing little discrete specialised things in separate data spaces each with its own special internal format and internal structures, the whole data space of all the data available to the machine (including, of course, all the code owned by the machine) exists in a single, complex, messy, powerful pool. That a process doesn't have to make a special arrangement, use a special protocol, to talk to another process or to exchange data with it. + +In that pool, the internal storage representation of data objects is DKDC. We neither have nor need to have access to it. It may well change over time without application layer programs even being aware or needing to be aware of the change, certainly without them being recompiled. + +The things we can store in the dataspace include: + +1. **integers** of any size +1. **reals** to any appropriate degree of precision +1. **rationals, complex numbers**, and other things we might want to compute with +1. **dates, times**, and other such useful things +1. **things people say** of any extent, from names to novels +1. **lists of any extent**, branching or not +1. **slots** associations of names with some setter and, perhaps, getter knowledge which determine what values can be stored under that name +1. **namespaces** collections, extensible or not, of slots +1. **regularities** collections of namespaces each of which share identical names +1. **homogeneities** collections of namespaces each of which share identical slots +1. **functions** all executable things are 'functions' in a lispy sense. They are applied to arguments and return values. They may or may not have internal expectations as to the value type of those arguments. +1. **processes** I don't yet have a good feeling for what a post-scarcity process looks like, at top level. It may simply be a thread executing a function; I don't know. I don't know whether there needs to be one specially privileged executive process. + +Things which we no longer store - which we no longer store because they no longer have any utility - include + +1. **shorts, longs, doubles**, etc specific internal representation types. You saw that coming. +1. **tables**, and with them, **relational databases** and **relational database management systems** no longer needed because the pool is itself persistent (although achieving the efficiency of data access that mature RDBMS give us may be a challenge). +1. **files** You didn't see that coming? + +Files are the most stupid, arbitrary way to store data. Again, with a persistent data pool, they cease to have any purpose. Post scarcity, there are no files and there is no filesystem. There's no distinction between in core and out of core. Or rather, if there are files and a filesystem, if there is a distinction between in core and out of core, that distinction falls under the doctrine of DKDC: we don't know about it, and we don't care about it. When something in the pool wants to use or refer to another something, then that other something is available in the pool. Whether it was there all along, or whether it was suddenly brought in from somewhere outside by the runtime system, we neither know nor care. If things in the pool which haven't been looked at for a long time are sent to sulk elsewhere by the runtime system that is equally uninteresting. Things which are not referenced at all, of course, may be quietly dropped by the runtime system in the course of normal garbage collection. + +One of the things we've overloaded onto the filesystem is security. In core, in modern systems, each process guards its own pool of store jealously, allowing other processes to share data with it only through special channels and protocols, even if the two processes are run by the same user identity with the same privilege. That's ridiculous. Out of core, data is stored in files often with inscrutable internal format, each with its own permissions and access control list. + +It doesn't need to be that way. Each primitive data item in core - each integer, each list node, each slot, each namespace - can have its own access control mechanism. Processes, as such, will never 'own' data items, and will certainly never 'own' chunks of store - at the application layer, even the concept of a chunk of store will be invisible. A process can share a data item it has just created simply by setting an appropriate access policy on it, and programmers will be encouraged normally to be as liberal in this sharing as security allows. So the slot Salary of the namespace Simon might be visible only to the user Simon and the role Payroll, but that wouldn't stop anyone else looking at the slot Phone number of the same namespace. + +Welcome, then, to post scarcity computing. It may not look much like what you're used to, but if it doesn't it's because you've grown up with scarcity, and even since we left scarcity behind you've been living with software designed by people who grew up with scarcity, who still hoard when there's no need, who don't understand how to use wealth. It's a richer world, a world without arbitrary restrictions. If it looks a lot like Alan Kay (and friends)'s Croquet, that's because Alan Kay has been going down the right path for a long time. \ No newline at end of file diff --git a/docs/Regularity.md b/docs/Regularity.md new file mode 100644 index 0000000..0b6d400 --- /dev/null +++ b/docs/Regularity.md @@ -0,0 +1,20 @@ +# Regularity + +A regularity is a map whose values are maps, all of whose members share the same keys. A map may be added to a regularity only if it has all the keys the regularity expects, although it may optionally have more. It is legitimate for the same map to be a member of two different regularities, if it has a union of their keys. Keys in a regularity must be keywords. Regularities are roughly the same sort of thing as classes in object oriented programming or tables in databases, but the values of the keys are not policed (see homogeneity). + +A regularity may also have an association of methods, that is, functions which accept a member of the regularity as their first argument; this set of methods forms an API to the regularity. Of course a full hierarchical object oriented model can be layered on top of this, but a regularity does not in itself have any concept of class inheritance. + +But, for example, if we have a regularity whose members represent companies, and those companies each have employees, then there might be a method :payroll of companies which might internally look like: + +(lambda (company) + (reduce + (map do-something-to-get-salary (:employees company)))) + +which would be accessed + +(with ((companies . ::shared:pool:companies) + (acme . companies:acme-widgets)) + (companies:methods:payroll acme)) + +But salary is not a property of a company, it's a property of an employee; so what is this thing called do-something-to-get-salary? It's a method on the regularity of employees, so in this example, it is ::shared:pool:employees:methods:salary. + +There are issues that I haven't resolved yet about the mutability of regularities and homogeneities; obviously, in order to provide multi-user visibility of current values of shared data, some regularities must be mutable. But mutability has potentially very serious perfomance issues for the hypercube architecture, so I think that in general they should not be. \ No newline at end of file diff --git a/docs/Stack.md b/docs/Stack.md new file mode 100644 index 0000000..3cdf0c8 --- /dev/null +++ b/docs/Stack.md @@ -0,0 +1,40 @@ +# Stack + +The C (and I assume but don't know) Rust stack are contiguous blocks of memory which grow down from the top of the virtual memory map allocated by the operating system to the process. The Lisp stack doesn't have to be the same as the C stack and in fact probably cannot be if I want to have multiple Lisp threads running concurrently in the same process. + +If the Lisp stack and the implementation language stack are different, then it's more awkward for Lisp to call functions written in the implementation language and vice versa, but not impossible. + +Past Lisps have implemented stack as lists and as vectors. Both work. My own guess is that it possibly best to have a standard sized stack frame allocated in vector space, so that each frame is a contiguous block of memory. A stack frame needs to contain parameters, a return pointer, and somewhere the caller will pick up the return value from. I think a stack frame should have the following: + + +-----------------+-----------------+---------------------------------------------------+ + | tag | 0...31 | 'STCK' | + +-----------------+-----------------+---------------------------------------------------+ + | vecp-pointer | 32...95 | cons-pointer to my VECP (or NIL?) | + +-----------------+-----------------+---------------------------------------------------+ + | size | 96...159 | 77 | + +-----------------+-----------------+---------------------------------------------------+ + | tag | 160...167 | 0 | + +-----------------+-----------------+---------------------------------------------------+ + | parameter 1 | 168...231 | cons-pointer to first param | + +-----------------+-----------------+---------------------------------------------------+ + | parameter 2 | 232...295 | cons-pointer to second param | + +-----------------+-----------------+---------------------------------------------------+ + | parameter 3 | 296...359 | cons-pointer to third param | + +-----------------+-----------------+---------------------------------------------------+ + | more params | 360...423 | cons-pointer to list of further params | + +-----------------+-----------------+---------------------------------------------------+ + | return pointer | 424...487 | memory address of the instruction to return to | + +-----------------+-----------------+---------------------------------------------------+ + | return value | 488...551 | cons pointer to return value | + +-----------------+-----------------+---------------------------------------------------+ + | prior frame ptr | 552...615 | cons-pointer to preceding stack frame VECP | + +-----------------+-----------------+---------------------------------------------------+ + +Note that every argument to a Lisp function must be a cons space object passed by reference (i.e., a cons pointer). If the actual argument is actually a [[vector space]] object, then what we pass is a reference to the VECP object which references that vector. + +I'm not certain we need a prior frame pointer; if we don't, we may not need a VECP pointing to a stack frame, since nothing can point to a stack frame other than the next stack frame(s) up the stack (if we parallelise *map*, *and* and so on) which to implement a multi-thread system we essentially must have, there may be two or more successor frames to any frame. In fact to use a massively multiprocessor machine efficiently we must normally evaluate each parameter in a separate thread, with only special forms such as *cond* which impose explicit control flow evaluating their clauses serially in a single thread. + +*Uhhhmmm... to be able to inspect a stack frame, we will need a pointer to the stack frame. Whether that pointer should be constructed when the stack frame is constructed I don't know. It would be overhead for something which would infrequently be used.* + +However, modern systems with small numbers of processors and expensive thread construction and tear-down would perform **terribly** if all parameter evaluation was parallelised, so for now we can't do that, even though the semantics must be such that later we can. + \ No newline at end of file diff --git a/docs/Sysout-and-sysin.md b/docs/Sysout-and-sysin.md new file mode 100644 index 0000000..9a3ae7a --- /dev/null +++ b/docs/Sysout-and-sysin.md @@ -0,0 +1,19 @@ +# Sysout and sysin + +We need a mechanism to persist a running system to backing store, and restore it from backing store. + +This might, actually, turn out not to be terribly hard, but is potentially horrendous, particularly if we're talking about very large (multi-terabyte) memory images. + +If we use paged memory, as many UNIX systems do, then memory pages periodically get written to disk and the sum total of the memory pages on disk represent an image of the state of system memory. The problem with this is that the state of system memory is changing all the time, and if some pages are out of date with respect to others you don't have a consistent image. + +However, the most volatile area of memory is at the outer end of [[cons space]], since that is where cons cells are most likely to die and consequently where new cons cells are most likely to be allocated. We could conceivably take advantage of this by maintaining a per-page [[free list]], and preferentially allocating from the currently busiest page. Volatility in [[vector space]] is likely to be significantly lower, but significantly more distributed. However, if we stick to the general rule that objects aren't mutable, volatility happens only by allocating new objects or deallocating old ones. So it may be the case that if we make a practice of flushing vector space pages when that page is written to, and flushing the active cons space pages regularly, we may at any time achieve a consistent memory image on disk even if it misses the last few seconds worth of changes in cons space. + +Otherwise it's worth looking at whether we could journal changes between page flushes. This may be reasonably inexpensive. + +If none of this works then persisting the system to backing media may mean halting the system, compacting vector space, writing the whole of active memory to a stream, and restarting the system. This is extremely undesirable because it means putting the system offline for a potentially extended period. + +----- + +Actually, I'm not sure the above works at all. To sysout a running system, you'd have to visit each node in turn and serialise its cons and vector pages. But if the system is still running when you do this, then you would probably end up with an inconsistent sysout. So you'd have to signal all nodes to halt before performing sysout. Further, you could not restore a sysout to a system with a smaller node count, or smaller node memory, to the system dumped. + +This is tricky! \ No newline at end of file diff --git a/docs/System-private-functions.md b/docs/System-private-functions.md new file mode 100644 index 0000000..304c0bc --- /dev/null +++ b/docs/System-private-functions.md @@ -0,0 +1,14 @@ +# System private functions + +**actually, I think this is a bad idea — or at least needs significantly more thought!** + +System-private functions are functions private to the system, which no normal user is entitled to access; these functions normally have an [[access control]] value of NIL. + +# (sys-access-control arg) + +System private. Takes one argument. Returns the access control list of its argument. + +# (sys-readable arg user) + +System private. Takes two arguments. Returns `TRUE` if the first argument is readable by the reader represented by the second argument; else `NIL`. + diff --git a/docs/Topology-of-the-hardware-of-the-deep-future.md b/docs/Topology-of-the-hardware-of-the-deep-future.md new file mode 100644 index 0000000..811a8d2 --- /dev/null +++ b/docs/Topology-of-the-hardware-of-the-deep-future.md @@ -0,0 +1,35 @@ +![HAL 9000 - a vision of the hardware of the deep future](https://vignette4.wikia.nocookie.net/2001/images/5/59/Hal_console.jpg/revision/latest?cb=20090823025755)In thinking about how to write a software architecture that won't quickly become obsolescent, I find that I'm thinking increasingly about the hardware on which it will run. + +In [[Post Scarcity Hardware]] I envisaged a single privileged node which managed main memory. Since then I've come to thing that this is a brittle design which will lead to bottle necks, and that each cons page will be managed by a separate node. So there needs to be a hardware architecture which provides the shortest possible paths between nodes. + +Well, actually... from a software point of view it doesn't matter. From a software point of view, provided it's possible for any node to request a memory item from any other node, that's enough, and, for the software to run (slowly), a linear serial bus would do. But part of the point of this thinking is to design hardware which is orders of magnitude faster than the [von Neumann architecture](https://en.wikipedia.org/wiki/Von_Neumann_architecture) allows. So for performance, cutting the number of hops to a minimum is important. + +I've been reading Danny Hillis' [thesis](https://dspace.mit.edu/bitstream/handle/1721.1/14719/18524280-MIT.pdf?sequence=2) and his book [The Connection Machine](https://books.google.co.uk/books/about/The_Connection_Machine.html?id=xg_yaoC6CNEC&redir_esc=y&hl=en) which, it transpires, is closely based on it. Danny Hillis was essentially trying to do what I am trying to do, but forty years ago, with the hardware limitations of forty years ago (but he was trying to do it in the right place, and with a useful amount of money that actually allowed him to build something physical, which I'm never likely to have). + +Hillis' solution to the topology problem, as I understand it (and note - I may not understand it very well) is as follows: + +![Second generation connection machine in use](http://www.digibarn.com/collections/parts/connection-machine-chip/cm2-500.jpg) + +If you take a square grid and place a processor at every intersection, it has at most four proximal neighbours, and, for a grid which is `x` cells in each direction, the longest path between two cells is `2x`. If you join the nodes on the left hand edge of the grid to the corresponding nodes on the right hand edge, you have a cylinder, and the longest path between two nodes is 1.5x. If you then join the nodes on the top of the grid to the nodes on the bottom, you have a torus - a figure like a doughnut or a bagel. Every single node has four proximal neighbours, and the longest path between any two nodes is `x`. + +So far so good. Now, let's take square grids and stack them. This gives each node at most six proximal neighbours. We form a cube, and the longest distance between two nodes is `3x`. We can link the nodes on the left of the cube to the corresponding nodes on the right and form a (thick walled) cylinder, and the longest distance between two nodes is `2.5x`. Now join the nodes at the top of the cube to the corresponding nodes at the bottom, and we have a thick walled torus. The maximum distance between is now `2x`. + +Let's stop for a moment and think about the difference between logical and physical topology. Suppose we have a printed circuit board with 100 processors on it in a regular grid. We probably could physically bend the circuit board to form a cylinder, but there's no need to do so. We achieve exactly the same connection architecture simply by using wires to connect the left side to the right. And if we use wires to connect those at the top with those at the bottom, we've formed a logical torus even though the board is still flat. + +It doesn't even need to be a square board. We could have each processor on a separate board in a rack, with each board having four connectors probably all along the same edge, and use patch wires to connect the boards together into a logical torus. + +So when we're converting our cube into a torus, the 'cube' *could* consist of a vertical stack of square boards each of which has a grid of processors on it. But it could also consist of a stack of boards in a rack, each of which has six connections, patched together to form the logical thick-walled torus. So now lets take additional patch leads and join the nodes that had been on the front of the logical cube to the corresponding nodes on the back of the logical cube, and we have a topology which has some of the properties of a torus and some of the properties of a sphere, and is just mind-bending if you try to visualise it. + +This shape is what I believe Hillis means by a [hypercube](https://en.wikipedia.org/wiki/Hypercube), although I have to say I've never found any of the visualisations of a hypercube in books or on the net at all helpful, and they certainly don't resemble the torusy-spherey thing I which visualise. + +It has the very useful property, however, that the longest distance between any two nodes is `1.5x`. + +Why is `1.5x` on the hypercube better than `1x` on the torus? Suppose you want to build a machine with about 1000 nodes. The square root of a thousand is just less than 32, so let's throw in an extra 24 nodes to make it a round 32. We can lay out 1024 nodes on a 32 x 32 square, join left to right, top to bottom, and we have a maximum path between two of 1024 nodes of 32 hops. Suppose instead we arrange our processors on ten boards each ten by ten, with vertical wires connecting each processor with the one above it and the one below it, as well tracks on the board linking each with those east, west, north and south. Connect the left hand side to the right, the front to the back and the top to the bottom, and we have a maximum path between any two of 1000 nodes of fifteen hops. That's twice as good. + +Obviously, if you increase the number of interconnectors to each processor above six, the paths shorten further but the logical topology becomes even harder to visualise. This doesn't matter - it doesn't actually have to be visualised - but wiring would become a nightmare. + +I've been thinking today about topologies which would allow higher numbers of connections and thus shorter paths, and I've come to this tentative conclusion. + +I can imagine topologies which tesselate triangle-tetrahedron-hypertetrahedron and pentagon-dodecahedron-hyperdodecahedron. There are possibly others. But the square-cube-hypercube model has one important property that those others don't (or, at least, it isn't obvious to me that they do). In the square-cube-hypercube model, every node can be addressed by a fixed number of coordinates, and the shortest path from any node to any other is absolutely trivial to compute. + +From this I conclude that the engineers who went before me - and who were a lot more thoughtful and expert than I am - were probably right: the square-cube-hypercube model, specifically toruses and hypercubes, is the right way to go. \ No newline at end of file diff --git a/docs/Users.md b/docs/Users.md new file mode 100644 index 0000000..e7ca536 --- /dev/null +++ b/docs/Users.md @@ -0,0 +1,9 @@ +# Users + +I'm not yet sure what sort of objects users are. They may just be lists, interned in a special namespace such as *system.users*. They may be special purpose [[vector space]] objects (although I don't see why, apart from to get a special tag, which might be useful). + +Every user object must contain credentials, and the credentials must be readable by system only; the credentials are either a hashed password or a cryptographic public key. The user object must also have an identifying name, and probably other identifying information. But it's not necessarily the case that every user on the system needs to be able to see the names of every other user on the system, so the identifying information (or the user object itself) may have [[access control]] lists. + +There is a problem here with the principle of [[immutability]]; if an access control list on an object _foo_ contains a pointer to my user object so that I can read _foo_, and I change my password, then the immutability rule says that a new copy of the *system.users* namespace is created with a new copy of my user object. This new user object isn't on any access control list so by changing my password I actually can't read anything. + +This means that what we put on access control lists is not user objects, but symbols (usernames) which are bound in *system.users* to user objects; the user object then needs a back-pointer to that username. A user group then becomes a list not of user objects but of interned user names. \ No newline at end of file diff --git a/docs/Vector-space.md b/docs/Vector-space.md new file mode 100644 index 0000000..7456674 --- /dev/null +++ b/docs/Vector-space.md @@ -0,0 +1,80 @@ +# Vector Space + +Vector space is what in conventional computer languages is known as 'the heap'. Because objects allocated in vector space are of variable size, vector space will fragment over time. Objects in vector space will become unreferenced, making them available for garbage collection and reallocation; but ultimately you will arrive at the situation where there are a number of small free spaces in vector space but you need a large one. Therefore there must ultimately be a mark-and-sweep garbage collector for vector space. + +To facilitate this, reference to every vector space object will be indirected through exactly one VECP object in [[cons space]]. If a live vector space object has to be moved in memory in order to compact the heap and to allocate a new object, only one pointer need be updated. This saves enormously on mark-and-sweep time, at the expense of a small overhead on access to vector space objects. + +Every vector space object must have a header, indicating that it is a vector space object and what sort of a vector space object it is. Each vector space object must have a fixed size, which is declared in its header. Beyond the header, the payload of a vector space object is undetermined. + +Note that, if cons-pointers are implemented simply as memory addresses, the cost of moving a cons page becomes huge, so a rational garbage collector would know about cons pages and do everything possible to avoid moving them. + +## The header + +As each vector space object has an associated VECP object in cons space, a vector space object does not need to contain either a reference count or an access control list. It does need a cons-pointer to its associated VECP object; it does need a tag (actually it doesn't, since we could put all the tags in cons space, but it is convenient for memory allocation debugging that each should have a tag). It's probably convenient for it to have a mark bit, since if garbage collection of vector space is implemented at all it needs to be mark-and-sweep. + +So the header looks like this + + +-----+--------------+------+------+--------------+ + | tag | vecp-pointer | size | mark | payload... / + +-----+--------------+------+------+------------+ + +**TODO:** I'm not satisfied with this header design. I think it should be a multiple of 64 bits, so that it is word aligned, for efficiency of fetch. Possibly it would be better to make the *size* field 31 bits with *mark* size one bit, and instead of having the value of *size* being the size of the object in bytes, it should be the size in 64 bit words, even though that makes the maximum allocatable object only 17 gigabytes. It should also be ordered *tag, size, mark, vecp-pointer*, in order to word align the *vecp-pointer* field. + +### Tag + +The tag will be a 32 bit unsigned integer in the same way and for the same reasons that it is in [[cons space]]: i.e., because it will be alternately readable as a four character ASCII string, which will aid memory debugging. + +### Vecp-pointer + +The vecp pointer is a back pointer to the VECP object in cons space which points to this vector space object. It is, therefore, obviously, the size of a [[cons pointer]], which is to say 64 bits. + +### Size + +Obviously a single vector space object cannot occupy the whole of memory, since there are other housekeeping things we need to get the system up and running. But there really should not be a reason why a program should not allocate all the remaining available memory as a single object if that's what it wants to do. So the size field should be the width of the address bus of the underlying machine; for the present, 64 bits. The value of the size field will be the whole size, in bytes, of the object including the header. + +### Mark + +It's probable that in version zero we won't implement garbage collection of vector space. C programs do not normally have any mechanism for compacting their heap; and vector space objects are much less likely than cons space objects to be transient. However, respecting the fact that in the long term we are going to want to be able to compact our vector space, I'll provide a mark field. This really only needs to be one bit, but, again for word alignment, we'll give it a byte. + +So the header now looks like this: + + +-----+--------------+------+------+------------------------+ + | 0 | 32 | 96 | 160 | 168 ...(167 + size) / + | tag | vecp-pointer | size | mark | payload... / + +-----+--------------+------+------+--------------------+ + +#### Alternative mark-bit strategy + +A thought which has recently occurred to me is that the mark bit could be the case bit of the least significant byte of the tag. So that if the tag read 'IMAG' (a raster image), for example, when marked it would read 'IMAg'. This saves having a separately allocated mark in the header, but retains debugging clarity. + +## Tags + +I really don't at this point have any idea what sorts of things we'll want to store in vector space. This is a non-exhaustive list of things I can think of just now. + +### BMAP + +A bitmap; a monochrome raster; a two dimensional array of bits. + +### EXEC + +We definitely need chunks of executable code - compiled functions. + +### HASH + +We definitely need hashtables. A hashtable is implemented as a pointer to a hashing function, and an array of N cons-pointers each of which points to an [[assoc list]] acting as a hash bucket. A hashtable is immutable. Any function which 'adds a new key/value pair to' a hashtable in fact returns a new hashtable containing all the key value bindings from the old one, with the new one added. Any function which 'changes a key/value pair' in a hashtable in fact returns a new value with the same bindings of all the keys except the one which has changed as the old one. + +In either case, anything which held a pointer to the old version still sees the old version, which continues to exist until everything which pointed to it has been deallocated. Only things which access the hashtable via a binding in a current namespace will see the new version. + +### NMSP + +A namespace. A namespace is a hashtable with some extra features. It has a parent pointer: NIL in the case of a namespace which was not created by 'adding to' or 'modifying' a pre-existing one, but where a pre-existing one was acted on, then that pre-existing one. It also must have an additional access control list, for users entitled to create new canonical versions of this namespace. + +A lot of thinking needs to be done here. It's tricky. If I get it wrong, the cost to either performance or security or both will be horrible. + +### RSTR + +A raster; a two dimensional array of 32 bit integers, typically interpreted as RGBA colour values. + +### VECT + +An actual vector; an array with cells of a fixed type (where, obviously, a cons pointer is one type). Has a finite number of dimensions, but probably not more than 4,294,967,296 will be supported (i.e. 32 bits for `dimensions`). \ No newline at end of file From a81b8b130a8bc3bea0523a34822bbf57ca4e58a8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 6 Jul 2025 10:29:55 +0100 Subject: [PATCH 41/90] First pass at fixing up wiki links in `/docs`. --- docs/Access-control.md | 6 +++--- docs/Cons-space.md | 18 +++++++++--------- docs/Core-functions.md | 8 ++++---- docs/Free-list.md | 1 + docs/Hashing-structure-writ-large.md | 2 ++ docs/Home.md | 4 ++-- docs/Homogeneity.md | 4 +++- docs/Interning-strings.md | 12 ++++++------ docs/Lazy-Collections.md | 2 +- docs/Memory-management.md | 10 +++++----- docs/Names-of-things.md | 8 ++++---- docs/Parallelism.md | 2 +- docs/Paths.md | 2 +- docs/Post-scarcity-hardware.md | 8 +++++--- docs/Post-scarcity-software.md | 4 +++- docs/Stack.md | 2 +- docs/Sysout-and-sysin.md | 2 +- docs/System-private-functions.md | 2 +- ...ology-of-the-hardware-of-the-deep-future.md | 2 +- docs/Users.md | 6 +++--- docs/Vector-space.md | 8 ++++---- 21 files changed, 61 insertions(+), 52 deletions(-) diff --git a/docs/Access-control.md b/docs/Access-control.md index 0f41a5d..07e4851 100644 --- a/docs/Access-control.md +++ b/docs/Access-control.md @@ -2,9 +2,9 @@ _ ote that a number of details not yet finalised are used in examples in this note. There must be some mechanism for creating fully qualified and partially qualified hierarchical names, but I haven't finalised it yet. In this note I've assumed that the portions of an hierarchical name are separated by periods ('.'); that fully qualified names start with a quote mark; and that where a name doesn't start with a quote mark, the first portion of it is evaluated in the current environment and its value assumed to be a fully qualified equivalent. All of these details may change._ -In a multi-user environment, access control is necessary in order for a user to be able to protect an item of data from being seen by someone who isn't authorised to see it. But actually, in a world of immutable data, it's less necessary than you might think. As explained in my note on [[Memory, threads and communication]], if there's strict immutability, and all user processes spawn from a common root process, then no user can see into any other user's data space anyway. +In a multi-user environment, access control is necessary in order for a user to be able to protect an item of data from being seen by someone who isn't authorised to see it. But actually, in a world of immutable data, it's less necessary than you might think. As explained in my note on [Memory, threads and communication](https://www.journeyman.cc/blog/posts-output/2017-01-08-post-scarcity-memory-threads-and-communication/), if there's strict immutability, and all user processes spawn from a common root process, then no user can see into any other user's data space anyway. -But that makes collaboration and communication impossible, so I've proposed namespaces be mutable. So the value of a name in a [[namespace]] will be a data item and inevitably that data item will be in some user's data space. So we do need an access control list on each data item. +But that makes collaboration and communication impossible, so I've proposed namespaces be mutable. So the value of a name in a [namespace](Namespace.html) will be a data item and inevitably that data item will be in some user's data space. So we do need an access control list on each data item. ## Initial thoughts @@ -24,7 +24,7 @@ As most data is immutable, there's no need for write access lists. If it exists, A sort-of minor exception to this is write streams. If you have normal access to a write stream, gatekept by the normal access lists, you can write to the stream; what you can't do is change where the stream points to. As you can't read from a write stream, there's still only one access list needed. -However, if (some) [[namespaces]] are mutable - and I believe some must be - then a namespace does need a write access list, in addition to its (normal) read access list. The structure of a write access list will be the same as of a read access list. +However, if (some) [namespaces](Namespace.html) are mutable - and I believe some must be - then a namespace does need a write access list, in addition to its (normal) read access list. The structure of a write access list will be the same as of a read access list. ### Modifying write access lists on mutable namespaces diff --git a/docs/Cons-space.md b/docs/Cons-space.md index 9e1005f..d954d06 100644 --- a/docs/Cons-space.md +++ b/docs/Cons-space.md @@ -36,11 +36,11 @@ A mark and sweep garbage collector actually only needs one mark bit, but for now ### Access control -Access control is a [[cons pointer]], see below; and is consequently the size of a cons pointer, which is presently 64 bits. An access control value of NIL means only system processes may access the cell; an access control value of TRUE means any user can access the cell; otherwise, the access control pointer points to the first cons cell of a list of allowed users/groups. The access control list is thus an ordinary list in ordinary cons space, and cells in an access control list can have access control lists of their own. As cons cells are immutable, infinite recursion is impossible; but it is nevertheless probably a good thing if access control list cells normally have an access control list of either TRUE or NIL. +Access control is a [cons pointer](cons pointer.html), see below; and is consequently the size of a cons pointer, which is presently 64 bits. An access control value of NIL means only system processes may access the cell; an access control value of TRUE means any user can access the cell; otherwise, the access control pointer points to the first cons cell of a list of allowed users/groups. The access control list is thus an ordinary list in ordinary cons space, and cells in an access control list can have access control lists of their own. As cons cells are immutable, infinite recursion is impossible; but it is nevertheless probably a good thing if access control list cells normally have an access control list of either TRUE or NIL. ### Car, Cdr: Cons pointers -A [[cons pointer]] is simply a pointer to a cons cell, and the simplest way to implement this is exactly as the memory address of the cons cell. +A [cons pointer](cons pointer.html) is simply a pointer to a cons cell, and the simplest way to implement this is exactly as the memory address of the cons cell. We have a fixed size vector of total memory, which we address in eight bit words (bytes) because that's the current convention. Our cons cell size is 32 bytes. So 31/32 of the possible values of a cons pointer are wasted - there cannot be a valid cons cell at that address. Also, our total memory must be divided between cons space, vector space and stack (actually stack could be implemented in either cons space or vector space, and ultimately may end up being implemented in cons space, but that's a highly non-trivial detail which will be addressed much later). In practice it's likely that less than half of the total memory available will be devoted to cons space. So 63/64 of the possible values of a cons pointer are wasted. @@ -50,7 +50,7 @@ One of the things I absolutely hate about modern computers is their tendency to That was acceptable when the JVM was a special purpose platform for developing software for small embedded devices, which is what it was originally designed for. But it's one of the compromises the JVM makes in order to work well on small embedded devices which is completely unacceptable for post-scarcity computing. And we won't accept it. -But be that as it may, we don't know at system initialisation time how much memory to reserve for cons space, and how much for vector space ('the heap'). If we reserve too much for cons space, we may run out of vector space while there's still cons space free, and vice versa. So we'll reserve cons space in units: [[cons pages]]. If our cons pointers are absolute memory addresses, then it becomes very expensive to move a cons page in memory, because all the pointers in the whole system to any cell on the page need to be updated. +But be that as it may, we don't know at system initialisation time how much memory to reserve for cons space, and how much for vector space ('the heap'). If we reserve too much for cons space, we may run out of vector space while there's still cons space free, and vice versa. So we'll reserve cons space in units: [cons pages](cons pages.html). If our cons pointers are absolute memory addresses, then it becomes very expensive to move a cons page in memory, because all the pointers in the whole system to any cell on the page need to be updated. (**NOTE**: As my thinking has developed, I'm now envisaging one cons page per compute node, which means that on each node the division between cons space and vector space will have to be fixed) @@ -79,13 +79,13 @@ A cons cell. The tag value of a CONS cell is that unsigned 32 bit integer which, ### FREE -An unassigned cons cell. The tag value of a FREE cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'FREE'. The count of a FREE cell is always zero. The mark of a free cell is always zero. The access control value of a FREE cell is always NIL. The Car of a FREE cell is always NIL (address zero). The Cdr of a FREE cell is a cons-pointer to the next FREE cell (the [[free list]] pointer). +An unassigned cons cell. The tag value of a FREE cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'FREE'. The count of a FREE cell is always zero. The mark of a free cell is always zero. The access control value of a FREE cell is always NIL. The Car of a FREE cell is always NIL (address zero). The Cdr of a FREE cell is a cons-pointer to the next FREE cell (the [free list](free list.html) pointer). ### INTR An integer; possibly an integer which isn't a big integer. The tag value of a INTR cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'INTR'. The count of a INTR cell is always non-zero. The mark is up to the garbage collector. -There's fundamentally two ways to do this; one is we store up to 128 bit signed integers in the payload of an INTR cell, and have some other tag for an integer ('[[bignum]]') which overflows 128 bits and must thus be stored in another data structure; or else we treat one bit as a 'bignum' flag. If the bignum flag is clear we treat the remaining 127 bits as an unsigned 127 bit integer; if set, we treat the low 64 bits of the value as a cons pointer to the data structure which represents the bignum. +There's fundamentally two ways to do this; one is we store up to 128 bit signed integers in the payload of an INTR cell, and have some other tag for an integer ('[bignum](bignum.html)') which overflows 128 bits and must thus be stored in another data structure; or else we treat one bit as a 'bignum' flag. If the bignum flag is clear we treat the remaining 127 bits as an unsigned 127 bit integer; if set, we treat the low 64 bits of the value as a cons pointer to the data structure which represents the bignum. ### NIL @@ -105,13 +105,13 @@ A real number. The tag value of a REAL cell is that unsigned 32 bit integer whic A string. The tag value of a STRG cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'STRG'. The count of a STRG cell is always non-zero. The mark is up to the garbage collector. The Car of an STRG cell contains a single UTF character. The Cdr of an STRG cell contains a cons-pointer to the remainder of the string, or NIL if this is the end of the string. -Note that in this definition a string is not an atom, which is probably right. But we also at this stage don't have an idea of a [[symbol]]. Very likely we'll end up with the idea that a string which is bound to a value in a namespace is for our purposes a symbol. +Note that in this definition a string is not an atom, which is probably right. But we also at this stage don't have an idea of a [symbol](Interning-strings.html). Very likely we'll end up with the idea that a string which is bound to a value in a namespace is for our purposes a symbol. Note, however, that there's a risk that we might have two instances of strings comprising identical characters in identical order, one of which was bound in a namespace and one of which wasn't; string equality is something to worry about. ### TIME -At nanosecond resolution (if I've done my arithmetic right), 128 bits will represent a span of 1 x 10²² years, or much longer than from the big bang to the [estimated date of fuel exhaustion of all stars](https://en.wikipedia.org/wiki/Timeline_of_the_far_future). So I think I'll arbitrarily set an epoch 14Bn years before the UNIX epoch and go with that. The time will be unsigned - there is no time before the big bang. +At nanosecond resolution (if I've done my arithmetic right), 128 bits will represent a span of 1 x 1022 years, or much longer than from the big bang to the [estimated date of fuel exhaustion of all stars](https://en.wikipedia.org/wiki/Timeline_of_the_far_future). So I think I'll arbitrarily set an epoch 14Bn years before the UNIX epoch and go with that. The time will be unsigned - there is no time before the big bang. ### TRUE @@ -121,7 +121,7 @@ The canonical true value. May not actually exist at all: the cell-pointer whose A pointer into vector space. The tag value of a VECP cell is that unsigned 32 bit integer which, when considered as an ASCII string, reads 'VECP'. The count of a VECP cell is always non-zero. The mark is up to the garbage collector. The payload is the a pointer to a vector space object. On systems with an address bus up to 128 bits wide, it's simply the address of the vector; on systems with an address bus wider than 128 bits, it's probably an offset into an indirection table, but that really is a problem for another day. -As an alternate implementation on hardware with a 64 bit address bus, it might be sensible to have the Car of the VECP cell simply the memory address of the vector, and the Cdr a pointer to the next VECP cell, maintained automatically in the same way that a [[free list]] is maintained. This way we automatically hold a list of all live vector space objects, which would help in garbage collecting vector space. +As an alternate implementation on hardware with a 64 bit address bus, it might be sensible to have the Car of the VECP cell simply the memory address of the vector, and the Cdr a pointer to the next VECP cell, maintained automatically in the same way that a [free list](Free-list.html) is maintained. This way we automatically hold a list of all live vector space objects, which would help in garbage collecting vector space. Every object in vector space shall have exactly one VECP cell in cons space which refers to it. Every other object which wished to hold a reference to that object shall hold a cons pointer to VECP cell that points to the object. Each object in vector space shall hold a backpointer to the VECP cell which points to it. This means that if vector space needs to be shuffled in order to free memory, for each object which is moved only one pointer need be updated. @@ -136,4 +136,4 @@ I'm not yet certain what the payload of a WRIT cell is; it is implementation dep ## Cons pages -Cons cells will be initialised in cons pages. A cons page is a fixed size array of cons cells. Each cell is initialised as FREE, and each cell, as it is initialised, is linked onto the front of the system [[free list]]. Cons pages will exist in [[vector space]], and consequently each cons page will have a vector space header. \ No newline at end of file +Cons cells will be initialised in cons pages. A cons page is a fixed size array of cons cells. Each cell is initialised as FREE, and each cell, as it is initialised, is linked onto the front of the system [free list](Free-list.html). Cons pages will exist in [vector space](Vector-space.html), and consequently each cons page will have a vector space header. \ No newline at end of file diff --git a/docs/Core-functions.md b/docs/Core-functions.md index 772fd32..7f3cea5 100644 --- a/docs/Core-functions.md +++ b/docs/Core-functions.md @@ -1,6 +1,6 @@ # Core functions -In the specifications that follow, a word in all upper case refers to a tag value, defined on either the [[cons space]] or the [[vector space]] page. +In the specifications that follow, a word in all upper case refers to a tag value, defined on either the [cons space](Cons-space.html) or the [vector space](Vector-space.html) page. # (and args...) @@ -16,7 +16,7 @@ Public. Takes an arbitrary number of arguments, which should either all be CONS # (assoc key store) -Public. Takes two arguments, a key and a store. The store may either be a CONS forming the head of a list formatted as an [[assoc list]], or else a VECP pointing to a HASH. If the key is readable by the current user, returns the value associated with that key in the store, if it exists and is readable by the current user, else NIL. +Public. Takes two arguments, a key and a store. The store may either be a CONS forming the head of a list formatted as an [assoc list](Assoc-list.html), or else a VECP pointing to a HASH. If the key is readable by the current user, returns the value associated with that key in the store, if it exists and is readable by the current user, else NIL. # (car arg) @@ -57,7 +57,7 @@ _Note: I'm not sure what happens if the STRG is already bound in the HASH. A nor # (lambda args forms...) -Public. Takes an arbitrary number of arguments. Considers the first argument ('args') as a set of formal parameters, and returns a function composed of the forms with those parameters bound. Where I say 'returns a function', this is in initial prototyping probably an interpreted function (i.e. a code tree implemented as an S-expression), but in a usable version will mean a VECP (see [[cons space#VECP]]) pointing to an EXEC (see [[vector space#EXEC]]) vector. +Public. Takes an arbitrary number of arguments. Considers the first argument ('args') as a set of formal parameters, and returns a function composed of the forms with those parameters bound. Where I say 'returns a function', this is in initial prototyping probably an interpreted function (i.e. a code tree implemented as an S-expression), but in a usable version will mean a VECP (see [cons space](Cons-space.html#VECP)) pointing to an EXEC (see [vector space#EXEC](Vector-space.html#EXEC)) vector. # (nil? arg) @@ -89,5 +89,5 @@ Public. Takes one argument. If that argument is either an STRG or a READ, parses # (type arg) -Public. Takes one argument. If that argument is readable by the current user, returns a string interned in the *core.types* namespace representing the tag value of the argument, unless the argument is a VECP in which case the value returned represents the tag value of the [[vector space]] object indicated by the VECP. +Public. Takes one argument. If that argument is readable by the current user, returns a string interned in the *core.types* namespace representing the tag value of the argument, unless the argument is a VECP in which case the value returned represents the tag value of the [vector space](Vector-space.html) object indicated by the VECP. diff --git a/docs/Free-list.md b/docs/Free-list.md index 2b1fc13..645983b 100644 --- a/docs/Free-list.md +++ b/docs/Free-list.md @@ -1,4 +1,5 @@ +# Free list A free list is a list of FREE cells consed together. When a cell is deallocated, it is consed onto the front of the free list, and the system free-list pointer is updated to point to it. A cell is allocated by popping the front cell off the free list. diff --git a/docs/Hashing-structure-writ-large.md b/docs/Hashing-structure-writ-large.md index 05e698a..fb59df7 100644 --- a/docs/Hashing-structure-writ-large.md +++ b/docs/Hashing-structure-writ-large.md @@ -1,3 +1,5 @@ +# Hashing structure writ large + In Lisp, there's an expectation that any object may act as a key in a hash table. What that means, in practice, is that if a list ```lisp diff --git a/docs/Home.md b/docs/Home.md index 9efd688..e045ef1 100644 --- a/docs/Home.md +++ b/docs/Home.md @@ -1,6 +1,6 @@ # Post Scarcity Software Environment: general documentation -Work towards the implementation of a software system like that described in [Post Scarcity Software](http://blog.journeyman.cc/2006/02/post-scarcity-software.html). +Work towards the implementation of a software system like that described in [Post Scarcity Software](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/). ## Note on canonicity @@ -26,5 +26,5 @@ When Linus Torvalds sat down in his bedroom to write Linux, he had something usa ## AWFUL WARNING 2 -This project is necessarily experimental and exploratory. I write code, it reveals new problems, I think about them, and I mutate the design. The documentation in this wiki does not always keep up with the developing source code. +This project is necessarily experimental and exploratory. I write code, it reveals new problems, I think about them, and I mutate the design. This documentation does not always keep up with the developing source code. diff --git a/docs/Homogeneity.md b/docs/Homogeneity.md index 064585a..6349406 100644 --- a/docs/Homogeneity.md +++ b/docs/Homogeneity.md @@ -1,4 +1,6 @@ -A homogeneity is a [[regularity]] which has a validation funtion associated with each key. A member can only be added to a homogeneity if not only does it have all the required keys, but the value of each key in the candidate member satisfies the validation function for that key. For example, the validation function for the age of a person might be something like +# Homogeneity + +A homogeneity is a [regularity](Regularity.html) which has a validation funtion associated with each key. A member can only be added to a homogeneity if not only does it have all the required keys, but the value of each key in the candidate member satisfies the validation function for that key. For example, the validation function for the age of a person might be something like ``` (fn [value] diff --git a/docs/Interning-strings.md b/docs/Interning-strings.md index c03516d..b92ded5 100644 --- a/docs/Interning-strings.md +++ b/docs/Interning-strings.md @@ -12,7 +12,7 @@ causes an unbound variable exception to be thrown, while returns the value **"froboz"**. This begs the question of whether there's any difference between **"froboz"** and **'froboz**, and the answer is that at this point I don't know. -There will be a concept of a root [[namespace]], in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. +There will be a concept of a root [namespace](Namespace.html), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. There must be some notation to say distinguish a request for the value of a name in the root namespace and the value of a name in the current namespace. For now I'm proposing that: @@ -34,7 +34,7 @@ will return the value that **froboz** is bound to in the environment of the user The exact path separator syntax may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain. -Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [[hashtable]] of individual path elements. +Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.html) of individual path elements. Obviously this means there may be arbitrarily many paths which reference the same data item. This is intended. @@ -46,11 +46,11 @@ Binds *string*, considered as a path, to **NIL**. If some namespace along the pa ### (intern! string T) -Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [[access control]] lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. +Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. ### (intern! string T write-access-list) -Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [[access control]] list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. +Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [access control](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. ### (set! string value) @@ -58,11 +58,11 @@ Binds *string*, considered as a path, to *value*. If some namespace along the pa ### (set! string value T) -Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [[access control]] lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. +Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. ### (set! string value T write-access-list) -Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [[access control]] list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. +Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [access control](Access-control.html) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception. ### (put! string token value) diff --git a/docs/Lazy-Collections.md b/docs/Lazy-Collections.md index 22a7f5b..56d2725 100644 --- a/docs/Lazy-Collections.md +++ b/docs/Lazy-Collections.md @@ -22,7 +22,7 @@ I acknowledge that, given that keywords and symbols are also sequences of charac ## How do we compute with lazy sequences in practice? -Consider the note [[parallelism]]. Briefly, this proposes that a compile time judgement is made at the probable cost of evaluating each argument; that the one deemed most expensive to evaluate is reserved to be evaluated on the local node, and for the rest, a judgement is made as to whether it would be cheaper to hand them off to peers or to evaluate them locally. Well, for functions which return lazies –– and the compiler should certainly be able to infer whether a function will return a lazy — it will always make sense to hand them off, if there is an available idle peer to which to hand off. In fact, lazy-producers are probably the most beneficial class of function calls to hand off, since, if handed off to a peer, the output of the function can be consumed without any fancy scheduling on the local node. Indeed, if all lazy-producers can be reliably handed off, we probably don't need a scheduler at all. +Consider the note [parallelism](Parallelism.html). Briefly, this proposes that a compile time judgement is made at the probable cost of evaluating each argument; that the one deemed most expensive to evaluate is reserved to be evaluated on the local node, and for the rest, a judgement is made as to whether it would be cheaper to hand them off to peers or to evaluate them locally. Well, for functions which return lazies –– and the compiler should certainly be able to infer whether a function will return a lazy — it will always make sense to hand them off, if there is an available idle peer to which to hand off. In fact, lazy-producers are probably the most beneficial class of function calls to hand off, since, if handed off to a peer, the output of the function can be consumed without any fancy scheduling on the local node. Indeed, if all lazy-producers can be reliably handed off, we probably don't need a scheduler at all. ## How do lazy sequences actually work? diff --git a/docs/Memory-management.md b/docs/Memory-management.md index c8da27b..8eb3726 100644 --- a/docs/Memory-management.md +++ b/docs/Memory-management.md @@ -15,15 +15,15 @@ I became interested in reference counting garbage collectors, because it seemed ## Separating cons space from vector space -Lisps generate lots and lots of very small, equal sized objects: cons cells and other things which are either the same size as or even smaller than cons cells and which fit into the same memory footprint. Furthermore, most of the volatility is in cons cells - they are often extremely short lived. Larger objects are allocated much more infrequently and tend to live considerably longer. +Lisps generate lots and lots of very small, equal sized objects: cons cells and other things which are either the same size as or even smaller than cons cells and which fit into the same memory footprint. Furthermore, most of the volatility is in cons cells — they are often extremely short lived. Larger objects are allocated much more infrequently and tend to live considerably longer. -Because cons cells are all the same size, and because integers and doubles fit into the memory footprint of a cons cell, if we maintain an array of memory units of this size then we can allocate them very efficiently because we never have to move them - we can always allocate a new object in memory vacated by deallocating an old one. Deallocation is simply a matter of pushing the deallocated cell onto the front of the free list; allocation is simply a matter of popping a cell off the free list. +Because cons cells are all the same size, and because integers and doubles fit into the memory footprint of a cons cell, if we maintain an array of memory units of this size then we can allocate them very efficiently because we never have to move them — we can always allocate a new object in memory vacated by deallocating an old one. Deallocation is simply a matter of pushing the deallocated cell onto the front of the free list; allocation is simply a matter of popping a cell off the free list. By contrast, a conventional software heap fragments exactly because we allocate variable sized objects into it. When an object is deallocated, it leaves a hole in the heap, into which we can only allocate objects of the same size or smaller. And because objects are heterogeneously sized, it's probable that the next object we get to allocate in it will be smaller, leaving even smaller unused holes. -Consequently we end up with a memory like a swiss cheese - by no means fully occupied, but with holes which are too small to fit anything useful in. In order to make memory in this state useful, you have to mark and sweep it. +Consequently we end up with a memory like a swiss cheese — by no means fully occupied, but with holes which are too small to fit anything useful in. In order to make memory in this state useful, you have to mark and sweep it. -So my first observation is that [[cons space]] and what I call [[vector space]] - that is, the heap into which objects which won't fit into the memory footprint of a cons cell are allocated - are systematically different and require different garbage collection strategies. +So my first observation is that [cons space](Cons-space.html) and what I call [vector space](Vector-space.html) — that is, the heap into which objects which won't fit into the memory footprint of a cons cell are allocated — are systematically different and require different garbage collection strategies. ## Reference counting: the objections @@ -39,7 +39,7 @@ The other 'fault' of older reference counting Lisps is that in older Lisps, cons So badly designed programs on reference counting Lisps could leak memory badly and consequently silt up and run out of allocatable store. -But modern Lisps - like Clojure - use immutable data structures. The nature of immutable data structures is that an older node can never point to a newer node. So circular data structures cannot be constructed. +But modern Lisps — like Clojure — use immutable data structures. The nature of immutable data structures is that an older node can never point to a newer node. So circular data structures cannot be constructed. ### Performance diff --git a/docs/Names-of-things.md b/docs/Names-of-things.md index 7ac9ab2..0269f43 100644 --- a/docs/Names-of-things.md +++ b/docs/Names-of-things.md @@ -1,10 +1,10 @@ * **assoc list** An assoc list is any list all of whose elements are cons-cells. * **association** Anything which associates names with values. An *assoc list* is an association, but so it a *map*, a *namespace*, a *regularity* and a *homogeneity*. -* **homogeneity** A [[homogeneity]] is a *regularity* which has a validation funtion associated with each key. -* **keyword** A [[keyword]] is a token whose denotation starts with a colon and which has a limited range of allowed characters, not including punctuation or spaces, which evaluates to itself irrespective of the current binding environment. +* **homogeneity** A [homogeneity](Homogeneity.html) is a *regularity* which has a validation funtion associated with each key. +* **keyword** A [keyword](Keyword.html) is a token whose denotation starts with a colon and which has a limited range of allowed characters, not including punctuation or spaces, which evaluates to itself irrespective of the current binding environment. * **map** A map in the sense of a Clojure map; immutable, adding a name/value results in a new map being created. A map may be treated as a function on *keywords*, exactly as in Clojure. * **namespace** A namespace is a mutable map. Generally, if a namespace is shared, there will be a path from the oblist to that namespace. * **oblist** The oblist is a privileged namespace which forms the root of all canonical paths. It is accessed at present by the function `(oblist)`, but it can be denoted in paths by the empty keyword. -* **path** A [[path]] is a list of keywords, with special notation and semantics. -* **regularity** A [[regularity]] is a map whose values are maps, all of whose members share the same keys. A map may be added to a regularity only if it has all the keys the regularity expects, although it may optionally have more. It is legitimate for the same map to be a member of two different regularities, if it has a union of their keys. Keys in a regularity must be keywords. Regularities are roughly the same sort of thing as objects in object oriented programming or tables in databases, but the values of the keys are not policed (see `homogeneity`). +* **path** A [path](How-do-we-notate-paths.html) is a list of keywords, with special notation and semantics. +* **regularity** A [regularity](Regularity.html) is a map whose values are maps, all of whose members share the same keys. A map may be added to a regularity only if it has all the keys the regularity expects, although it may optionally have more. It is legitimate for the same map to be a member of two different regularities, if it has a union of their keys. Keys in a regularity must be keywords. Regularities are roughly the same sort of thing as objects in object oriented programming or tables in databases, but the values of the keys are not policed (see `homogeneity`). \ No newline at end of file diff --git a/docs/Parallelism.md b/docs/Parallelism.md index eef803a..3757197 100644 --- a/docs/Parallelism.md +++ b/docs/Parallelism.md @@ -1,6 +1,6 @@ # Parallelism -If this system doesn't make reasonably efficient use of massively parallel processors, it's failed. The sketch hardware for which it's designed is [[Post Scarcity Hardware]]; that system probably won't ever exist but systems somewhat like it almost certainly will, because we're up against the physical limits on the performance of a von Neumann machine, and the only way we can increase performance now is by going increasingly parallel. +If this system doesn't make reasonably efficient use of massively parallel processors, it's failed. The sketch hardware for which it's designed is [Post Scarcity Hardware](Post-scarcity-hardware.html); that system probably won't ever exist but systems somewhat like it almost certainly will, because we're up against the physical limits on the performance of a von Neumann machine, and the only way we can increase performance now is by going increasingly parallel. So on such a system, every function invocation may normally delegate every argument to a different processor, if there is another processor free (which there normally will be). Only special forms, like *cond*, which implement explicit flow control, should serialise evaluation. diff --git a/docs/Paths.md b/docs/Paths.md index 8cb1c6c..2ff3475 100644 --- a/docs/Paths.md +++ b/docs/Paths.md @@ -1,6 +1,6 @@ # Paths -*See also [[How do we notate paths?]], which in part supercedes this.* +*See also [How do we notate paths?](How do we notate paths?.html), which in part supercedes this.* A path is essentially a list of keywords. diff --git a/docs/Post-scarcity-hardware.md b/docs/Post-scarcity-hardware.md index 74bfb3b..cea036e 100644 --- a/docs/Post-scarcity-hardware.md +++ b/docs/Post-scarcity-hardware.md @@ -1,6 +1,8 @@ -_I wrote this essay in 2014; it was previously published on my blog, [here](http://blog.journeyman.cc/2014/10/post-scarcity-hardware.html)_ +# Implementing post scarcity hardware -Eight years ago, I wrote an essay which I called [[Post Scarcity Software]]. It's a good essay; there's a little I'd change about it now - I'd talk more about the benefits of immutability - but on the whole it's the nearest thing to a technical manifesto I have. I've been thinking about it a lot the last few weeks. The axiom on which that essay stands is that modern computers - modern hardware - are tremendously more advanced than modern software systems, and would support much better software systems than we yet seem to have the ambition to create. +_I wrote this essay in 2014; it was previously published on my blog, [here](https://www.journeyman.cc/blog/posts-output/2017-09-19-implementing-postscarcity-hardware/)_ + +Eight years ago, I wrote an essay which I called [Post Scarcity Software](Post-scarcity-software.html). It's a good essay; there's a little I'd change about it now - I'd talk more about the benefits of immutability - but on the whole it's the nearest thing to a technical manifesto I have. I've been thinking about it a lot the last few weeks. The axiom on which that essay stands is that modern computers - modern hardware - are tremendously more advanced than modern software systems, and would support much better software systems than we yet seem to have the ambition to create. That's still true, of course. In fact it's more true now than it was then, because although the pace of hardware change is slowing, the pace of software change is still glacial. So nothing I'm thinking of in terms of post-scarcity computing actually needs new hardware. @@ -22,7 +24,7 @@ It turns out that Clojure's default *map* function simply serialises iterations Except... -Performance doesn't actually improve very much. Consider this function, which is the core function of the [MicroWorld](http://blog.journeyman.cc/2014/08/modelling-settlement-with-cellular.html) engine: +Performance doesn't actually improve very much. Consider this function, which is the core function of the [MicroWorld](https://www.journeyman.cc/blog/posts-output/2014-08-26-modelling-settlement-with-a-cellular-automaton/) engine:
     (defn map-world
diff --git a/docs/Post-scarcity-software.md b/docs/Post-scarcity-software.md
index 8f31771..07fcbf9 100644
--- a/docs/Post-scarcity-software.md
+++ b/docs/Post-scarcity-software.md
@@ -1,4 +1,6 @@
-_This is the text of my essay Post-scarcity Software, originally published in 2006 on my blog [here](http://blog.journeyman.cc/2006/02/post-scarcity-software.html)._
+# Post Scarcity Software
+
+_This is the text of my essay Post-scarcity Software, originally published in 2006 on my blog [here](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/)._
 
 For years we've said that our computers were Turing equivalent, equivalent to Turing's machine U. That they could compute any function which could be computed. They aren't, of course, and they can't, for one very important reason. U had infinite store, and our machines don't. We have always been store-poor. We've been mill-poor, too: our processors have been slow, running at hundreds, then a few thousands, of cycles per second. We haven't been able to afford the cycles to do any sophisticated munging of our data. What we stored - in the most store intensive format we had - was what we got, and what we delivered to our users. It was a compromise, but a compromise forced on us by the inadequacy of our machines.
 
diff --git a/docs/Stack.md b/docs/Stack.md
index 3cdf0c8..04ebe72 100644
--- a/docs/Stack.md
+++ b/docs/Stack.md
@@ -30,7 +30,7 @@ Past Lisps have implemented stack as lists and as vectors. Both work. My own gue
     | prior frame ptr | 552...615       | cons-pointer to preceding stack frame VECP        |
     +-----------------+-----------------+---------------------------------------------------+
 
-Note that every argument to a Lisp function must be a cons space object passed by reference (i.e., a cons pointer). If the actual argument is actually a [[vector space]] object, then what we pass is a reference to the VECP object which references that vector.
+Note that every argument to a Lisp function must be a [cons space object](Cons-space.html) passed by reference (i.e., a cons pointer). If the actual argument is actually a [vector space](Vector-space.html) object, then what we pass is a reference to the VECP object which references that vector.
 
 I'm not certain we need a prior frame pointer; if we don't, we may not need a VECP pointing to a stack frame, since nothing can point to a stack frame other than the next stack frame(s) up the stack (if we parallelise *map*, *and* and so on) which to implement a multi-thread system we essentially must have, there may  be two or more successor frames to any frame. In fact to use a massively multiprocessor machine efficiently we must normally evaluate each parameter in a separate thread, with only special forms such as *cond* which impose explicit control flow evaluating their clauses serially in a single thread.
 
diff --git a/docs/Sysout-and-sysin.md b/docs/Sysout-and-sysin.md
index 9a3ae7a..cabd2e3 100644
--- a/docs/Sysout-and-sysin.md
+++ b/docs/Sysout-and-sysin.md
@@ -6,7 +6,7 @@ This might, actually, turn out not to be terribly hard, but is potentially horre
 
 If we use paged memory, as many UNIX systems do, then memory pages periodically get written to disk and the sum total of the memory pages on disk represent an image of the state of system memory. The problem with this is that the state of system memory is changing all the time, and if some pages are out of date with respect to others you don't have a consistent image.
 
-However, the most volatile area of memory is at the outer end of [[cons space]], since that is where cons cells are most likely to die and consequently where new cons cells are most likely to be allocated. We could conceivably take advantage of this by maintaining a per-page [[free list]], and preferentially allocating from the currently busiest page. Volatility in [[vector space]] is likely to be significantly lower, but significantly more distributed. However, if we stick to the general rule that objects aren't mutable, volatility happens only by allocating new objects or deallocating old ones. So it may be the case that if we make a practice of flushing vector space pages when that page is written to, and flushing the active cons space pages regularly, we may at any time achieve a consistent memory image on disk even if it misses the last few seconds worth of changes in cons space. 
+However, the most volatile area of memory is at the outer end of [cons space](Cons-space.html), since that is where cons cells are most likely to die and consequently where new cons cells are most likely to be allocated. We could conceivably take advantage of this by maintaining a per-page [free list](Free-list.html), and preferentially allocating from the currently busiest page. Volatility in [vector space](Vector-space.html) is likely to be significantly lower, but significantly more distributed. However, if we stick to the general rule that objects aren't mutable, volatility happens only by allocating new objects or deallocating old ones. So it may be the case that if we make a practice of flushing vector space pages when that page is written to, and flushing the active cons space pages regularly, we may at any time achieve a consistent memory image on disk even if it misses the last few seconds worth of changes in cons space. 
 
 Otherwise it's worth looking at whether we could journal changes between page flushes. This may be reasonably inexpensive.
 
diff --git a/docs/System-private-functions.md b/docs/System-private-functions.md
index 304c0bc..c0b3eea 100644
--- a/docs/System-private-functions.md
+++ b/docs/System-private-functions.md
@@ -2,7 +2,7 @@
 
 **actually, I think this is a bad idea — or at least needs significantly more thought!**
 
-System-private functions are functions private to the system, which no normal user is entitled to access; these functions normally have an [[access control]] value of NIL.
+System-private functions are functions private to the system, which no normal user is entitled to access; these functions normally have an [access control](Access-control.html) value of NIL.
 
 # (sys-access-control arg)
 
diff --git a/docs/Topology-of-the-hardware-of-the-deep-future.md b/docs/Topology-of-the-hardware-of-the-deep-future.md
index 811a8d2..c7af777 100644
--- a/docs/Topology-of-the-hardware-of-the-deep-future.md
+++ b/docs/Topology-of-the-hardware-of-the-deep-future.md
@@ -1,6 +1,6 @@
 ![HAL 9000 - a vision of the hardware of the deep future](https://vignette4.wikia.nocookie.net/2001/images/5/59/Hal_console.jpg/revision/latest?cb=20090823025755)In thinking about how to write a software architecture that won't quickly become obsolescent, I find that I'm thinking increasingly about the hardware on which it will run.
 
-In [[Post Scarcity Hardware]] I envisaged a single privileged node which managed main memory. Since then I've come to thing that this is a brittle design which will lead to bottle necks, and that each cons page will be managed by a separate node. So there needs to be a hardware architecture which provides the shortest possible paths between nodes.
+In [Post Scarcity Hardware](Post-scarcity-hardware.html) I envisaged a single privileged node which managed main memory. Since then I've come to thing that this is a brittle design which will lead to bottle necks, and that each cons page will be managed by a separate node. So there needs to be a hardware architecture which provides the shortest possible paths between nodes.
 
 Well, actually... from a software point of view it doesn't matter. From a software point of view, provided it's possible for any node to request a memory item from any other node, that's enough, and, for the software to run (slowly), a linear serial bus would do. But part of the point of this thinking is to design hardware which is orders of magnitude faster than the [von Neumann architecture](https://en.wikipedia.org/wiki/Von_Neumann_architecture) allows. So for performance, cutting the number of hops to a minimum is important.
 
diff --git a/docs/Users.md b/docs/Users.md
index e7ca536..a6bd5ad 100644
--- a/docs/Users.md
+++ b/docs/Users.md
@@ -1,9 +1,9 @@
 # Users
 
-I'm not yet sure what sort of objects users are. They may just be lists, interned in a special namespace such as *system.users*. They may be special purpose [[vector space]] objects (although I don't see why, apart from to get a special tag, which might be useful).
+I'm not yet sure what sort of objects users are. They may just be lists, interned in a special namespace such as *system.users*. They may be special purpose [vector space](Vector-space.html) objects (although I don't see why, apart from to get a special tag, which might be useful).
 
-Every user object must contain credentials, and the credentials must be readable by system only; the credentials are either a hashed password or a cryptographic public key. The user object must also have an identifying name, and probably other identifying information. But it's not necessarily the case that every user on the system needs to be able to see the names of every other user on the system, so the identifying information (or the user object itself) may have [[access control]] lists.
+Every user object must contain credentials, and the credentials must be readable by system only; the credentials are either a hashed password or a cryptographic public key. The user object must also have an identifying name, and probably other identifying information. But it's not necessarily the case that every user on the system needs to be able to see the names of every other user on the system, so the identifying information (or the user object itself) may have [access control](Access-control.html) lists.
 
-There is a problem here with the principle of [[immutability]]; if an access control list on an object _foo_ contains a pointer to my user object so that I can read _foo_, and I change my password, then the immutability rule says that a new copy of the *system.users* namespace is created with a new copy of my user object. This new user object isn't on any access control list so by changing my password I actually can't read anything.
+There is a problem here with the principle of [immutability](Immutability.html); if an access control list on an object _foo_ contains a pointer to my user object so that I can read _foo_, and I change my password, then the immutability rule says that a new copy of the *system.users* namespace is created with a new copy of my user object. This new user object isn't on any access control list so by changing my password I actually can't read anything.
 
 This means that what we put on access control lists is not user objects, but symbols (usernames) which are bound in *system.users* to user objects; the user object then needs a back-pointer to that username. A user group then becomes a list not of user objects but of interned user names.
\ No newline at end of file
diff --git a/docs/Vector-space.md b/docs/Vector-space.md
index 7456674..528b04c 100644
--- a/docs/Vector-space.md
+++ b/docs/Vector-space.md
@@ -2,7 +2,7 @@
 
 Vector space is what in conventional computer languages is known as 'the heap'. Because objects allocated in vector space are of variable size, vector space will fragment over time. Objects in vector space will become unreferenced, making them available for garbage collection and reallocation; but ultimately you will arrive at the situation where there are a number of small free spaces in vector space but you need a large one. Therefore there must ultimately be a mark-and-sweep garbage collector for vector space.
 
-To facilitate this, reference to every vector space object will be indirected through exactly one VECP object in [[cons space]]. If a live vector space object has to be moved in memory in order to compact the heap and to allocate a new object, only one pointer need be updated. This saves enormously on mark-and-sweep time, at the expense of a small overhead on access to vector space objects.
+To facilitate this, reference to every vector space object will be indirected through exactly one VECP object in [cons space](Cons-space.html). If a live vector space object has to be moved in memory in order to compact the heap and to allocate a new object, only one pointer need be updated. This saves enormously on mark-and-sweep time, at the expense of a small overhead on access to vector space objects.
 
 Every vector space object must have a header, indicating that it is a vector space object and what sort of a vector space object it is. Each vector space object must have a fixed size, which is declared in its header. Beyond the header, the payload of a vector space object is undetermined.
 
@@ -22,11 +22,11 @@ So the header looks like this
     
 ### Tag
 
-The tag will be a 32 bit unsigned integer in the same way and for the same reasons that it is in [[cons space]]: i.e., because it will be alternately readable as a four character ASCII string, which will aid memory debugging.
+The tag will be a 32 bit unsigned integer in the same way and for the same reasons that it is in [cons space](Cons-space.html): i.e., because it will be alternately readable as a four character ASCII string, which will aid memory debugging.
 
 ### Vecp-pointer
 
-The vecp pointer is a back pointer to the VECP object in cons space which points to this vector space object. It is, therefore, obviously, the size of a [[cons pointer]], which is to say 64 bits.
+The vecp pointer is a back pointer to the VECP object in cons space which points to this vector space object. It is, therefore, obviously, the size of a [cons pointer](consspaceobject_8h.html#structcons__pointer), which is to say 64 bits.
 
 ### Size
 
@@ -61,7 +61,7 @@ We definitely need chunks of executable code - compiled functions.
 
 ### HASH
 
-We definitely need hashtables. A hashtable is implemented as a pointer to a hashing function, and an array of N cons-pointers each of which points to an [[assoc list]] acting as a hash bucket. A hashtable is immutable. Any function which 'adds a new key/value pair to' a hashtable in fact returns a new hashtable containing all the key value bindings from the old one, with the new one added. Any function which 'changes a key/value pair' in a hashtable in fact returns a new value with the same bindings of all the keys except the one which has changed as the old one.
+We definitely need hashtables. A hashtable is implemented as a pointer to a hashing function, and an array of N cons-pointers each of which points to an [assoc list](Hybrid-assoc-lists.html) acting as a hash bucket. A hashtable is immutable. Any function which 'adds a new key/value pair to' a hashtable in fact returns a new hashtable containing all the key value bindings from the old one, with the new one added. Any function which 'changes a key/value pair' in a hashtable in fact returns a new value with the same bindings of all the keys except the one which has changed as the old one.
 
 In either case, anything which held a pointer to the old version still sees the old version, which continues to exist until everything which pointed to it has been deallocated. Only things which access the hashtable via a binding in a current namespace will see the new version.
 

From 7b2deae88cce4f76977ea357f3d4fd1f3ca51737 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 6 Jul 2025 11:13:01 +0100
Subject: [PATCH 42/90] Second pass on fixing up documentation. Still some
 links not fixed.

---
 Doxyfile               |  3 ++-
 docs/Access-control.md |  6 ++++--
 docs/Cons-space.md     |  2 ++
 docs/Core-functions.md |  4 +++-
 src/io/history.c       | 14 ++++++++++++++
 src/io/history.h       | 14 ++++++++++++++
 6 files changed, 39 insertions(+), 4 deletions(-)
 create mode 100644 src/io/history.c
 create mode 100644 src/io/history.h

diff --git a/Doxyfile b/Doxyfile
index 2b6b284..1a06dca 100644
--- a/Doxyfile
+++ b/Doxyfile
@@ -790,7 +790,7 @@ WARN_LOGFILE           = doxy.log
 # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING
 # Note: If this tag is empty the current directory is searched.
 
-INPUT                  = src docs
+INPUT                  = src docs lisp
 
 # This tag can be used to specify the character encoding of the source files
 # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
@@ -817,6 +817,7 @@ INPUT_ENCODING         = UTF-8
 
 FILE_PATTERNS          = *.c \
                          *.h \
+                         *.lisp \
                          *.markdown \
                          *.md 
                         
diff --git a/docs/Access-control.md b/docs/Access-control.md
index 07e4851..693959e 100644
--- a/docs/Access-control.md
+++ b/docs/Access-control.md
@@ -1,6 +1,8 @@
 # Access control
-_
-ote that a number of details not yet finalised are used in examples in this note. There must be some mechanism for creating fully qualified and partially qualified hierarchical names, but I haven't finalised it yet. In this note I've assumed that the portions of an hierarchical name are separated by periods ('.'); that fully qualified names start with a quote mark; and that where a name doesn't start with a quote mark, the first portion of it is evaluated in the current environment and its value assumed to be a fully qualified equivalent. All of these details may change._
+
+*Not yet implemented*
+
+_Note that a number of details not yet finalised are used in examples in this note. There must be some mechanism for creating fully qualified and partially qualified hierarchical names, but I haven't finalised it yet. In this note I've assumed that the portions of an hierarchical name are separated by periods ('.'); that fully qualified names start with a quote mark; and that where a name doesn't start with a quote mark, the first portion of it is evaluated in the current environment and its value assumed to be a fully qualified equivalent. All of these details may change._
 
 In a multi-user environment, access control is necessary in order for a user to be able to protect an item of data from being seen by someone who isn't authorised to see it. But actually, in a world of immutable data, it's less necessary than you might think. As explained in my note on [Memory, threads and communication](https://www.journeyman.cc/blog/posts-output/2017-01-08-post-scarcity-memory-threads-and-communication/), if there's strict immutability, and all user processes spawn from a common root process, then no user can see into any other user's data space anyway.
 
diff --git a/docs/Cons-space.md b/docs/Cons-space.md
index d954d06..053f4f7 100644
--- a/docs/Cons-space.md
+++ b/docs/Cons-space.md
@@ -1,5 +1,7 @@
 # Cons space
 
+*See [cons_space_object.h](consspaceobject_8h.html), [cons_page.h](conspage_8h.html).*
+
 Cons space is a space which contains cons cells, and other objects whose memory representation fits into the footprint of a cons cell. A cons cell comprises:
 
     +-----+-------+------+----------------+--------------+--------------+
diff --git a/docs/Core-functions.md b/docs/Core-functions.md
index 7f3cea5..c05c2e4 100644
--- a/docs/Core-functions.md
+++ b/docs/Core-functions.md
@@ -1,5 +1,7 @@
 # Core functions
 
+*See [ops/lispops.h](lispops_8h.html).*
+
 In the specifications that follow, a word in all upper case refers to a tag value, defined on either the [cons space](Cons-space.html) or the [vector space](Vector-space.html) page.
 
 # (and args...)
@@ -16,7 +18,7 @@ Public. Takes an arbitrary number of arguments, which should either all be CONS
 
 # (assoc key store)
 
-Public. Takes two arguments, a key and a store. The store may either be a CONS forming the head of a list formatted as an [assoc list](Assoc-list.html), or else a VECP pointing to a HASH. If the key is readable by the current user, returns the value associated with that key in the store, if it exists and is readable by the current user, else NIL.
+Public. Takes two arguments, a key and a store. The store may either be a CONS forming the head of a list formatted as an [assoc list](Hybrid-assoc-lists.html), or else a VECP pointing to a HASH. If the key is readable by the current user, returns the value associated with that key in the store, if it exists and is readable by the current user, else NIL.
 
 # (car arg)
 
diff --git a/src/io/history.c b/src/io/history.c
new file mode 100644
index 0000000..3f22821
--- /dev/null
+++ b/src/io/history.c
@@ -0,0 +1,14 @@
+/*
+ * history.c
+ * 
+ * Maintain, and recall, a history of things which have been read from standard
+ * input. Necessarily the history must be stored on the user session, and not be
+ * global.
+ *
+ * I *think* history will be maintained as a list of forms, not of strings, so
+ * only forms which have successfully been read can be recalled, and forms which
+ * have not been completed when the history function is invoked will be lost. 
+ *
+ * (c) 2025 Simon Brooke 
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
\ No newline at end of file
diff --git a/src/io/history.h b/src/io/history.h
new file mode 100644
index 0000000..74355b5
--- /dev/null
+++ b/src/io/history.h
@@ -0,0 +1,14 @@
+/*
+ * history.h
+ * 
+ * Maintain, and recall, a history of things which have been read from standard
+ * input. Necessarily the history must be stored on the user session, and not be
+ * global.
+ *
+ * I *think* history will be maintained as a list of forms, not of strings, so
+ * only forms which have successfully been read can be recalled, and forms which
+ * have not been completed when the history function is invoked will be lost. 
+ *
+ * (c) 2025 Simon Brooke 
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
\ No newline at end of file

From e41ae1aa8b0c1ee05beda09842b278951a64873f Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Tue, 3 Feb 2026 17:20:55 +0000
Subject: [PATCH 43/90] OK, big win: the oblist is now a hashmap, and it works.
 I have clear ideas now about how to implement namespaces. There are probably
 regressions in this, but progress nevertheless!

---
 lisp/defun.lisp          |   2 -
 src/init.c               |  19 ++-
 src/io/io.h              |   2 +-
 src/io/print.c           |   2 +-
 src/memory/hashmap.c     | 231 ++-----------------------------
 src/memory/hashmap.h     |  17 ---
 src/memory/vectorspace.c |   1 +
 src/ops/intern.c         | 292 ++++++++++++++++++++++++++++++++++++---
 src/ops/intern.h         |  29 ++++
 src/ops/lispops.c        |   3 +-
 src/repl.c               |  10 ++
 11 files changed, 345 insertions(+), 263 deletions(-)

diff --git a/lisp/defun.lisp b/lisp/defun.lisp
index a6d80f5..a18c33a 100644
--- a/lisp/defun.lisp
+++ b/lisp/defun.lisp
@@ -1,5 +1,3 @@
-(set! list (lambda l l))
-
 (set! symbolp (lambda (x) (equal (type x) "SYMB")))
 
 (set! defun!
diff --git a/src/init.c b/src/init.c
index 3f3566c..4443469 100644
--- a/src/init.c
+++ b/src/init.c
@@ -36,7 +36,6 @@
 #include "io/fopen.h"
 #include "time/psse_time.h"
 
-// extern char *optarg; /* defined in unistd.h */
 
 /**
  * Bind this compiled `executable` function, as a Lisp function, to
@@ -160,14 +159,22 @@ int main( int argc, char *argv[] ) {
         print_banner(  );
     }
 
-    debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP );
-
     initialise_cons_pages(  );
 
-    debug_print( L"Initialised cons pages, about to bind\n", DEBUG_BOOTSTRAP );
+//     TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
+//     What actually goes wrong is: 
+//     1. the hashmap is created; 
+//     2. everything bound in init seems to get initialised properly;
+//     3. the REPL starts up;
+//     4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
+//     5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
+//     Hypothesis: binding stuff into a hashmap oblist either isn't happening or 
+//      is wrking ok, but retrieving from a hashmap oblist is failing.
+    debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
 
-//    TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly
-//    oblist = inc_ref( make_hashmap( 32, NIL, TRUE ) );
+    oblist = make_hashmap( 32, NIL, TRUE );
+
+    debug_print( L"About to bind\n", DEBUG_BOOTSTRAP );
 
     /*
      * privileged variables (keywords)
diff --git a/src/io/io.h b/src/io/io.h
index f350c13..dc9e8de 100644
--- a/src/io/io.h
+++ b/src/io/io.h
@@ -36,5 +36,5 @@ struct cons_pointer
 lisp_slurp( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env );
 
-
+char *lisp_string_to_c_string( struct cons_pointer s );
 #endif
diff --git a/src/io/print.c b/src/io/print.c
index 8f4b88e..5061b10 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -102,7 +102,7 @@ void print_map( URL_FILE * output, struct cons_pointer map ) {
             print( output, hashmap_get( map, key ) );
 
             if ( !nilp( c_cdr( ks ) ) ) {
-                url_fputws( L", ", output );
+                url_fputws( L" ", output );
             }
         }
 
diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c
index fcbff31..f2911e5 100644
--- a/src/memory/hashmap.c
+++ b/src/memory/hashmap.c
@@ -18,81 +18,6 @@
 #include "memory/hashmap.h"
 #include "memory/vectorspace.h"
 
-/**
- * Return a hash value for the structure indicated by `ptr` such that if
- * `x`,`y` are two separate structures whose print representation is the same
- * then `(sxhash x)` and `(sxhash y)` will always be equal.
- */
-uint32_t sxhash( struct cons_pointer ptr ) {
-    // TODO: Not Yet Implemented
-    /* TODO: should look at the implementation of Common Lisp sxhash?
-     * My current implementation of `print` only addresses URL_FILE
-     * streams. It would be better if it also addressed strings but
-     * currently it doesn't. Creating a print string of the structure
-     * and taking the hash of that would be one simple (but not necessarily
-     * cheap) solution.
-     */
-    /* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp
-     * and is EXTREMELY complex, and essentially has a different dispatch for
-     * every type of object. It's likely we need to do the same.
-     */
-    return 0;
-}
-
-/**
- * Get the hash value for the cell indicated by this `ptr`; currently only
- * implemented for string like things and integers.
- */
-uint32_t get_hash( struct cons_pointer ptr ) {
-    struct cons_space_object *cell = &pointer2cell( ptr );
-    uint32_t result = 0;
-
-    switch ( cell->tag.value ) {
-        case INTEGERTV:
-            /* Note that we're only hashing on the least significant word of an
-             * integer. */
-            result = cell->payload.integer.value & 0xffffffff;
-            break;
-        case KEYTV:
-        case STRINGTV:
-        case SYMBOLTV:
-            result = cell->payload.string.hash;
-            break;
-        case TRUETV:
-            result = 1;         // arbitrarily
-            break;
-        default:
-            result = sxhash( ptr );
-            break;
-    }
-
-    return result;
-}
-
-/**
- * Free the hashmap indicated by this `pointer`.
- */
-void free_hashmap( struct cons_pointer pointer ) {
-    struct cons_space_object *cell = &pointer2cell( pointer );
-
-    if ( hashmapp( pointer ) ) {
-        struct vector_space_object *vso = cell->payload.vectorp.address;
-
-        dec_ref( vso->payload.hashmap.hash_fn );
-        dec_ref( vso->payload.hashmap.write_acl );
-
-        for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) {
-            if ( !nilp( vso->payload.hashmap.buckets[i] ) ) {
-                debug_printf( DEBUG_ALLOC,
-                              L"Decrementing bucket [%d] of hashmap at 0x%lx\n",
-                              i, cell->payload.vectorp.address );
-                dec_ref( vso->payload.hashmap.buckets[i] );
-            }
-        }
-    } else {
-        debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" );
-    }
-}
 
 /**
  * A lisp function signature conforming wrapper around get_hash, q.v..
@@ -103,32 +28,6 @@ struct cons_pointer lisp_get_hash( struct stack_frame *frame,
     return make_integer( get_hash( frame->arg[0] ), NIL );
 }
 
-/**
- * Make a hashmap with this number of buckets, using this `hash_fn`. If 
- * `hash_fn` is `NIL`, use the standard hash funtion.
- */
-struct cons_pointer make_hashmap( uint32_t n_buckets,
-                                  struct cons_pointer hash_fn,
-                                  struct cons_pointer write_acl ) {
-    struct cons_pointer result = make_vso( HASHTV,
-                                           ( sizeof( struct cons_pointer ) *
-                                             ( n_buckets + 2 ) ) +
-                                           ( sizeof( uint32_t ) * 2 ) );
-
-    struct hashmap_payload *payload =
-        ( struct hashmap_payload * ) &pointer_to_vso( result )->payload;
-
-    payload->hash_fn = inc_ref( hash_fn );
-    payload->write_acl = inc_ref( write_acl );
-
-    payload->n_buckets = n_buckets;
-    for ( int i = 0; i < n_buckets; i++ ) {
-        payload->buckets[i] = NIL;
-    }
-
-    return result;
-}
-
 /**
  * Lisp funtion of up to four args (all optional), where
  * 
@@ -195,80 +94,9 @@ 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 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 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 const *to = pointer_to_vso( result );
-                struct hashmap_payload to_pl = to->payload.hashmap;
-
-                for ( int i = 0; i < to_pl.n_buckets; i++ ) {
-                    to_pl.buckets[i] = from_pl.buckets[i];
-                    inc_ref( to_pl.buckets[i] );
-                }
-            }
-        }
-    } else {
-        result =
-                make_exception( c_string_to_lisp_string
-                                ( L"Arg to `clone_hashmap` must "
-                                  L"be a readable hashmap.`" ), NIL );
-    }
-
-    return result;
-}
-
-/**
- * Store this `val` as the value of this `key` in this hashmap `mapp`. If
- * current user is authorised to write to this hashmap, modifies the hashmap and
- * returns it; if not, clones the hashmap, modifies the clone, and returns that.
- */
-struct cons_pointer hashmap_put( struct cons_pointer mapp,
-                                 struct cons_pointer key,
-                                 struct cons_pointer val ) {
-    // TODO: if current user has write access to this hashmap
-    if ( hashmapp( mapp ) && !nilp( key ) ) {
-        struct vector_space_object *map = pointer_to_vso( mapp );
-
-        if ( nilp( authorised( mapp, map->payload.hashmap.write_acl ) ) ) {
-            mapp = clone_hashmap( mapp );
-            map = pointer_to_vso( mapp );
-        }
-        uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
-
-        map->payload.hashmap.buckets[bucket_no] =
-            inc_ref( make_cons( make_cons( key, val ),
-                                map->payload.hashmap.buckets[bucket_no] ) );
-    }
-
-    return mapp;
-}
-
-struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key ) {
-    struct cons_pointer result = NIL;
-    if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) {
-        struct vector_space_object *map = pointer_to_vso( mapp );
-        uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
-
-        result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] );
-    }
-
+    // TODO: I am not sure this is right! We do not inc_ref a string when
+    // we make it.
+    inc_ref(result);
     return result;
 }
 
@@ -282,35 +110,20 @@ struct cons_pointer hashmap_get( struct cons_pointer mapp,
 struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
                                       struct cons_pointer frame_pointer,
                                       struct cons_pointer env ) {
+    // TODO: if current user has write access to this hashmap
+
     struct cons_pointer mapp = frame->arg[0];
     struct cons_pointer key = frame->arg[1];
     struct cons_pointer val = frame->arg[2];
 
-    return hashmap_put( mapp, key, val );
-}
+    struct cons_pointer result = hashmap_put( mapp, key, val );
+    struct cons_space_object *cell = &pointer2cell( result);
+    // if (cell->count <= 1) {
+    //     inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place! 
+    // }
+    return result;
 
-/**
- * Copy all key/value pairs in this association list `assoc` into this hashmap `mapp`. If
- * current user is authorised to write to this hashmap, modifies the hashmap and
- * returns it; if not, clones the hashmap, modifies the clone, and returns that.
- */
-struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
-                                     struct cons_pointer assoc ) {
-    // TODO: if current user has write access to this hashmap
-    if ( hashmapp( mapp ) && !nilp( assoc ) ) {
-        struct vector_space_object *map = pointer_to_vso( mapp );
-
-        if ( hashmapp( mapp ) && consp( assoc ) ) {
-            for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
-                  pair = c_car( assoc ) ) {
-                /* TODO: this is really hammering the memory management system, because
-                 * it will make a new lone for every key/value pair added. Fix. */
-                mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
-            }
-        }
-    }
-
-    return mapp;
+    // TODO: else clone and return clone.
 }
 
 /**
@@ -323,26 +136,6 @@ struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame,
     return hashmap_put_all( frame->arg[0], frame->arg[1] );
 }
 
-/**
- * return a flat list of all the keys in the hashmap indicated by `map`.
- */
-struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
-    struct cons_pointer result = NIL;
-    if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) ) {
-        struct vector_space_object *map = pointer_to_vso( mapp );
-
-        for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
-            for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
-                  !nilp( c ); c = c_cdr( c ) ) {
-                result = make_cons( c_car( c_car( c ) ), result );
-            }
-
-        }
-    }
-
-    return result;
-}
-
 struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env ) {
diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h
index b6c4a74..05823bb 100644
--- a/src/memory/hashmap.h
+++ b/src/memory/hashmap.h
@@ -17,25 +17,11 @@
 
 #define DFLT_HASHMAP_BUCKETS 32
 
-uint32_t get_hash( struct cons_pointer ptr );
-
-void free_hashmap( struct cons_pointer ptr );
-
-void dump_map( URL_FILE * output, struct cons_pointer pointer );
-
-struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
-
-struct cons_pointer hashmap_put( struct cons_pointer mapp,
-                                 struct cons_pointer key,
-                                 struct cons_pointer val );
 
 struct cons_pointer lisp_get_hash( struct stack_frame *frame,
                                    struct cons_pointer frame_pointer,
                                    struct cons_pointer env );
 
-struct cons_pointer hashmap_keys( struct cons_pointer map );
-
 struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
                                       struct cons_pointer frame_pointer,
                                       struct cons_pointer env );
@@ -48,8 +34,5 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env );
 
-struct cons_pointer make_hashmap( uint32_t n_buckets,
-                                  struct cons_pointer hash_fn,
-                                  struct cons_pointer write_acl );
 
 #endif
diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c
index 3616bf3..c46c798 100644
--- a/src/memory/vectorspace.c
+++ b/src/memory/vectorspace.c
@@ -25,6 +25,7 @@
 #include "memory/hashmap.h"
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
+#include "ops/intern.h"
 
 
 /**
diff --git a/src/ops/intern.c b/src/ops/intern.c
index cd80612..e908d56 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -18,12 +18,20 @@
  */
 
 #include 
+/*
+ * wide characters
+ */
+#include 
+#include 
 
+#include "authorise.h"
+#include "debug.h"
+#include "io/io.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "debug.h"
-#include "ops/equal.h"
 #include "memory/hashmap.h"
+#include "ops/equal.h"
+#include "ops/intern.h"
 #include "ops/lispops.h"
 // #include "print.h"
 
@@ -39,6 +47,219 @@
  */
 struct cons_pointer oblist = NIL;
 
+/**
+ * Return a hash value for the structure indicated by `ptr` such that if
+ * `x`,`y` are two separate structures whose print representation is the same
+ * then `(sxhash x)` and `(sxhash y)` will always be equal.
+ */
+uint32_t sxhash( struct cons_pointer ptr ) {
+    // TODO: Not Yet Implemented
+    /* TODO: should look at the implementation of Common Lisp sxhash?
+     * My current implementation of `print` only addresses URL_FILE
+     * streams. It would be better if it also addressed strings but
+     * currently it doesn't. Creating a print string of the structure
+     * and taking the hash of that would be one simple (but not necessarily
+     * cheap) solution.
+     */
+    /* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp
+     * and is EXTREMELY complex, and essentially has a different dispatch for
+     * every type of object. It's likely we need to do the same.
+     */
+    return 0;
+}
+
+/**
+ * Get the hash value for the cell indicated by this `ptr`; currently only
+ * implemented for string like things and integers.
+ */
+uint32_t get_hash( struct cons_pointer ptr ) {
+    struct cons_space_object *cell = &pointer2cell( ptr );
+    uint32_t result = 0;
+
+    switch ( cell->tag.value ) {
+        case INTEGERTV:
+            /* Note that we're only hashing on the least significant word of an
+             * integer. */
+            result = cell->payload.integer.value & 0xffffffff;
+            break;
+        case KEYTV:
+        case STRINGTV:
+        case SYMBOLTV:
+            result = cell->payload.string.hash;
+            break;
+        case TRUETV:
+            result = 1;         // arbitrarily
+            break;
+        default:
+            result = sxhash( ptr );
+            break;
+    }
+
+    return result;
+}
+
+/**
+ * Free the hashmap indicated by this `pointer`.
+ */
+void free_hashmap( struct cons_pointer pointer ) {
+    struct cons_space_object *cell = &pointer2cell( pointer );
+
+    if ( hashmapp( pointer ) ) {
+        struct vector_space_object *vso = cell->payload.vectorp.address;
+
+        dec_ref( vso->payload.hashmap.hash_fn );
+        dec_ref( vso->payload.hashmap.write_acl );
+
+        for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) {
+            if ( !nilp( vso->payload.hashmap.buckets[i] ) ) {
+                debug_printf( DEBUG_ALLOC,
+                              L"Decrementing bucket [%d] of hashmap at 0x%lx\n",
+                              i, cell->payload.vectorp.address );
+                dec_ref( vso->payload.hashmap.buckets[i] );
+            }
+        }
+    } else {
+        debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" );
+    }
+}
+
+
+/**
+ * Make a hashmap with this number of buckets, using this `hash_fn`. If 
+ * `hash_fn` is `NIL`, use the standard hash funtion.
+ */
+struct cons_pointer make_hashmap( uint32_t n_buckets,
+                                  struct cons_pointer hash_fn,
+                                  struct cons_pointer write_acl ) {
+    struct cons_pointer result = make_vso( HASHTV,
+                                           ( sizeof( struct cons_pointer ) *
+                                             ( n_buckets + 2 ) ) +
+                                           ( sizeof( uint32_t ) * 2 ) );
+
+    struct hashmap_payload *payload =
+        ( struct hashmap_payload * ) &pointer_to_vso( result )->payload;
+
+    payload->hash_fn = inc_ref( hash_fn );
+    payload->write_acl = inc_ref( write_acl );
+
+    payload->n_buckets = n_buckets;
+    for ( int i = 0; i < n_buckets; i++ ) {
+        payload->buckets[i] = NIL;
+    }
+
+    return result;
+}
+
+/**
+ * return a flat list of all the keys in the hashmap indicated by `map`.
+ */
+struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
+    struct cons_pointer result = NIL;
+    if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) ) {
+        struct vector_space_object *map = pointer_to_vso( mapp );
+
+        for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
+            for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
+                  !nilp( c ); c = c_cdr( c ) ) {
+                result = make_cons( c_car( c_car( c ) ), result );
+            }
+
+        }
+    }
+
+    return result;
+}
+
+/**
+ * Copy all key/value pairs in this association list `assoc` into this hashmap `mapp`. If
+ * current user is authorised to write to this hashmap, modifies the hashmap and
+ * returns it; if not, clones the hashmap, modifies the clone, and returns that.
+ */
+struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
+                                     struct cons_pointer assoc ) {
+    // TODO: if current user has write access to this hashmap
+    if ( hashmapp( mapp ) ) {
+        struct vector_space_object *map = pointer_to_vso( mapp );
+
+        if ( consp( assoc ) ) {
+            for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
+                  pair = c_car( assoc ) ) {
+                /* TODO: this is really hammering the memory management system, because
+                 * it will make a new lone for every key/value pair added. Fix. */
+                if (consp( pair)) {
+                    mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
+                } else if (hashmapp( pair)) {
+                    hashmap_put_all( mapp, pair);
+                } else {
+                    hashmap_put( mapp, pair, TRUE);
+                }
+                assoc = c_cdr( assoc);
+            }
+        } else if (hashmapp( assoc)) {
+            for (struct cons_pointer keys = hashmap_keys( mapp); !nilp( keys);
+                keys = c_cdr( keys)) {
+                struct cons_pointer key = c_car( keys);
+                hashmap_put( mapp, key, hashmap_get( assoc, key));
+            }
+        }
+    }
+
+    return mapp;
+}
+
+/** Get a value from a hashmap. 
+  *
+  * Note that this is here, rather than in memory/hashmap.c, because it is 
+  * closely tied in with c_assoc, q.v.
+  */
+struct cons_pointer hashmap_get( struct cons_pointer mapp,
+                                 struct cons_pointer key ) {
+    struct cons_pointer result = NIL;
+    if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) {
+        struct vector_space_object *map = pointer_to_vso( mapp );
+        uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
+
+        result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] );
+    }
+
+    return result;
+}
+
+/**
+ * If this `ptr` is a pointer to a hashmap, return a new identical 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 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 const *to = pointer_to_vso( result );
+                struct hashmap_payload to_pl = to->payload.hashmap;
+
+                for ( int i = 0; i < to_pl.n_buckets; i++ ) {
+                    to_pl.buckets[i] = from_pl.buckets[i];
+                    inc_ref( to_pl.buckets[i] );
+                }
+            }
+        }
+    } else {
+        result =
+                make_exception( c_string_to_lisp_string
+                                ( L"Arg to `clone_hashmap` must "
+                                  L"be a readable hashmap.`" ), NIL );
+    }
+
+    return result;
+}
+
 /**
  * Implementation of interned? in C. The final implementation if interned? will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -53,21 +274,26 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        for ( struct cons_pointer next = store;
-              nilp( result ) && consp( next );
-              next = pointer2cell( next ).payload.cons.cdr ) {
-            struct cons_space_object entry =
-                pointer2cell( pointer2cell( next ).payload.cons.car );
+        // TODO: I see what I was doing here and it would be the right thing to 
+        // do for stores which are old-fashioned assoc lists, but it will not work
+        // for my new hybrid stores.
+        // for ( struct cons_pointer next = store;
+        //       nilp( result ) && consp( next );
+        //       next = pointer2cell( next ).payload.cons.cdr ) {
+        //     struct cons_space_object entry =
+        //         pointer2cell( pointer2cell( next ).payload.cons.car );
 
-            debug_print( L"Internedp: checking whether `", DEBUG_BIND );
-            debug_print_object( key, DEBUG_BIND );
-            debug_print( L"` equals `", DEBUG_BIND );
-            debug_print_object( entry.payload.cons.car, DEBUG_BIND );
-            debug_print( L"`\n", DEBUG_BIND );
+        //     debug_print( L"Internedp: checking whether `", DEBUG_BIND );
+        //     debug_print_object( key, DEBUG_BIND );
+        //     debug_print( L"` equals `", DEBUG_BIND );
+        //     debug_print_object( entry.payload.cons.car, DEBUG_BIND );
+        //     debug_print( L"`\n", DEBUG_BIND );
 
-            if ( equal( key, entry.payload.cons.car ) ) {
-                result = entry.payload.cons.car;
-            }
+        //     if ( equal( key, entry.payload.cons.car ) ) {
+        //         result = entry.payload.cons.car;
+        //     }
+        if (!nilp( c_assoc( store, key))) {
+            result = key;
         }
     } else {
         debug_print( L"`", DEBUG_BIND );
@@ -135,6 +361,34 @@ struct cons_pointer c_assoc( struct cons_pointer key,
     return result;
 }
 
+/**
+ * Store this `val` as the value of this `key` in this hashmap `mapp`. If
+ * current user is authorised to write to this hashmap, modifies the hashmap and
+ * returns it; if not, clones the hashmap, modifies the clone, and returns that.
+ */
+struct cons_pointer hashmap_put( struct cons_pointer mapp,
+                                 struct cons_pointer key,
+                                 struct cons_pointer val ) {
+    if ( hashmapp( mapp ) && !nilp( key ) ) {
+        struct vector_space_object *map = pointer_to_vso( mapp );
+
+        if ( nilp( authorised( mapp, map->payload.hashmap.write_acl ) ) ) {
+            mapp = clone_hashmap( mapp );
+            map = pointer_to_vso( mapp );
+        }
+        uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
+
+        // TODO: if there are too many values in the bucket, rehash the whole 
+        // hashmap to a bigger number of buckets, and return that.
+
+        map->payload.hashmap.buckets[bucket_no] =
+            inc_ref( make_cons( make_cons( key, val ),
+                                map->payload.hashmap.buckets[bucket_no] ) );
+    }
+
+    return mapp;
+}
+
     /**
      * Return a new key/value store containing all the key/value pairs in this
      * store with this key/value pair added to the front.
@@ -151,9 +405,14 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     debug_dump_object( store, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    if ( nilp( store ) || consp( store ) ) {
+    debug_printf( DEBUG_BIND, L"set: store is %s\n`", lisp_string_to_c_string( c_type( store)) );
+    if (nilp( value)) {
+        result = store;
+    }
+    else if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
+        debug_print( L"set: storing in hashmap\n", DEBUG_BIND);
         result = hashmap_put( store, key, value );
     }
 
@@ -172,6 +431,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     debug_print( L"Entering deep_bind\n", DEBUG_BIND );
+
     struct cons_pointer old = oblist;
 
     debug_print( L"deep_bind: binding `", DEBUG_BIND );
diff --git a/src/ops/intern.h b/src/ops/intern.h
index fa17563..6be9cbc 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -22,12 +22,41 @@
 
 extern struct cons_pointer oblist;
 
+uint32_t get_hash( struct cons_pointer ptr );
+
+void free_hashmap( struct cons_pointer ptr );
+
+void dump_map( URL_FILE * output, struct cons_pointer pointer );
+
+struct cons_pointer hashmap_get( struct cons_pointer mapp,
+                                 struct cons_pointer key );
+
+struct cons_pointer hashmap_put( struct cons_pointer mapp,
+                                 struct cons_pointer key,
+                                 struct cons_pointer val );
+                
+struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
+                                     struct cons_pointer assoc );
+
+struct cons_pointer hashmap_keys( struct cons_pointer map );
+
+struct cons_pointer make_hashmap( uint32_t n_buckets,
+                                  struct cons_pointer hash_fn,
+                                  struct cons_pointer write_acl );
+
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
+struct cons_pointer hashmap_get( struct cons_pointer mapp,
+                                 struct cons_pointer key );
+
+struct cons_pointer hashmap_put( struct cons_pointer mapp,
+                                 struct cons_pointer key,
+                                 struct cons_pointer val );
+
 struct cons_pointer set( struct cons_pointer key,
                          struct cons_pointer value,
                          struct cons_pointer store );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 7d1a761..236a290 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -527,7 +527,8 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
             /*
              * \todo
              * the Clojure practice of having a map serve in the function place of
-             * an s-expression is a good one and I should adopt it;
+             * an s-expression is a good one and I should adopt it; 
+             * H'mmm... this is working, but it isn't here. Where is it?
              */
         default:
             result = frame->arg[0];
diff --git a/src/repl.c b/src/repl.c
index bef08b1..b68fa1c 100644
--- a/src/repl.c
+++ b/src/repl.c
@@ -10,6 +10,7 @@
 #include 
 #include 
 #include 
+#include 
 
 #include "memory/consspaceobject.h"
 #include "debug.h"
@@ -17,11 +18,20 @@
 #include "ops/lispops.h"
 #include "memory/stack.h"
 
+/**
+ * @brief Handle an interrupt signal.
+ * 
+ * @param dummy 
+ */
+void int_handler(int dummy) {
+    wprintf(L"TODO: handle ctrl-C in a more interesting way\n");
+}
 
 /**
  * The read/eval/print loop.
  */
 void repl(  ) {
+    signal(SIGINT, int_handler);
     debug_print( L"Entered repl\n", DEBUG_REPL );
 
     struct cons_pointer env =

From e489d02069d5e34484193a8e2edcdb563c07911a Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Tue, 3 Feb 2026 21:47:25 +0000
Subject: [PATCH 44/90] Mainly unit tests. 39/45 currently pass; the failures
 are all in bignum arithmetic and in deallocation.

---
 src/io/print.c                               |  2 +-
 src/ops/intern.c                             |  2 +-
 state-of-play.md                             | 53 ++++++++++++++++
 unit-tests/bignum-add.sh                     | 65 +++++++++++---------
 unit-tests/bignum-expt.sh                    | 25 ++++----
 unit-tests/bignum-print.sh                   | 24 ++++----
 unit-tests/bignum-subtract.sh                | 25 ++++----
 unit-tests/bignum.sh                         |  8 ++-
 unit-tests/cond.sh                           | 11 ++--
 unit-tests/{intepreter.sh => interpreter.sh} |  0
 unit-tests/let.sh                            |  9 ++-
 unit-tests/list-test,sh                      | 10 ++-
 unit-tests/many-args.sh                      |  8 ++-
 unit-tests/map.sh                            | 16 +++--
 unit-tests/multiply.sh                       |  9 ++-
 unit-tests/path-notation.sh                  |  7 ++-
 unit-tests/progn.sh                          |  9 ++-
 unit-tests/reverse.sh                        | 10 ++-
 unit-tests/slurp.sh                          |  2 +-
 unit-tests/string-allocation.sh              |  2 +-
 unit-tests/string-cons.sh                    |  9 ++-
 21 files changed, 206 insertions(+), 100 deletions(-)
 rename unit-tests/{intepreter.sh => interpreter.sh} (100%)

diff --git a/src/io/print.c b/src/io/print.c
index 5061b10..8f4b88e 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -102,7 +102,7 @@ void print_map( URL_FILE * output, struct cons_pointer map ) {
             print( output, hashmap_get( map, key ) );
 
             if ( !nilp( c_cdr( ks ) ) ) {
-                url_fputws( L" ", output );
+                url_fputws( L", ", output );
             }
         }
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index e908d56..1f6585b 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -196,7 +196,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
                 assoc = c_cdr( assoc);
             }
         } else if (hashmapp( assoc)) {
-            for (struct cons_pointer keys = hashmap_keys( mapp); !nilp( keys);
+            for (struct cons_pointer keys = hashmap_keys( assoc); !nilp( keys);
                 keys = c_cdr( keys)) {
                 struct cons_pointer key = c_car( keys);
                 hashmap_put( mapp, key, hashmap_get( assoc, key));
diff --git a/state-of-play.md b/state-of-play.md
index 498bf60..0855715 100644
--- a/state-of-play.md
+++ b/state-of-play.md
@@ -1,5 +1,58 @@
 # State of Play
 
+## 20260203
+
+I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
+
+### Hashmaps, assoc lists, and generalised key/value stores
+
+I now have the oblist working as a hashmap, and also hybrid assoc lists which incorporate hashmaps working. I don't 100% have consistent methods for reading stores which may be plain old assoc lists, new hybrid assoc lists, or hashmaps working but it isn't far off. This also takes me streets further towards doing hierarchies of hashmaps, allowing my namespace idea to work — and hybrid assoc lists provide a very sound basis for building environment structures.
+
+Currently all hashmaps are mutable, and my doctrine is that that is fixable when access control lists are actually implemented. 
+
+#### assoc
+
+The function `(assoc store key) => value` should be the standard way of getting a value out of a store.  
+
+#### put!
+
+The function `(put! store key value) => store` should become the standard way of setting a value in a store (of course, if the store is an assoc list or an immutable map, a new store will be returned which holds the additional key/value binding).
+
+### State of unit tests
+
+Currently:
+
+> Tested 45, passed 39, failed 6
+
+But the failures are as follows:
+```
+unit-tests/bignum-add.sh => checking a bignum was created: Fail
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 10000000000000000000 to 10000000000000000000: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1329227995784915872903807060280344576: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 3064991081731777716716694054300618367237478244367204352: Fail: expected 't', got 'nil'
+unit-tests/bignum-expt.sh => (expt 2 60): Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got '2'
+unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got '16'
+unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got '32'
+unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '1151321504605245376'
+unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '1'
+unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '0'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '-376293541461622793'
+unit-tests/memory.sh
+```
+
+In other words, all failures are in bignum arithmetic **except** that I still have a major memory leak due to not decrefing somewhere where I ought to.
+
+### Zig
+
 ## 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.
diff --git a/unit-tests/bignum-add.sh b/unit-tests/bignum-add.sh
index 778015a..293e1e5 100755
--- a/unit-tests/bignum-add.sh
+++ b/unit-tests/bignum-add.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+return=0
+
 #####################################################################
 # add two large numbers, not actally bignums to produce a smallnum
 # (right on the boundary)
@@ -12,13 +14,13 @@ output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
 actual=`echo $output |\
   tail -1`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 echo -n "checking no bignum was created: "
@@ -28,7 +30,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -44,23 +46,23 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
 grep 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 
@@ -77,28 +79,29 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
 grep 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 #####################################################################
 # add a smallnum and a bignum to produce a bignum
 # (just over the boundary)
+
 a=1
 b=1152921504606846977
 c=`echo "$a + $b" | bc`
@@ -109,13 +112,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 echo -n "checking a bignum was created: "
@@ -125,7 +128,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 
@@ -134,7 +137,7 @@ fi
 
 a=1152921504606846977
 c=`echo "$a + $a" | bc`
-echo -n "adding $a to $a: "
+echo -n "$0 => adding $a to $a: "
 expected='t'
 output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
 
@@ -147,7 +150,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -155,7 +158,7 @@ fi
 
 a=1152921504606846977
 c=`echo "$a * 5" | bc`
-echo -n "adding $a, $a $a, $a, $a: "
+echo -n "$0 => adding $a, $a $a, $a, $a: "
 expected='t'
 output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log`
 
@@ -168,7 +171,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -186,23 +189,23 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
 grep 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 
@@ -219,23 +222,23 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
 grep 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 
@@ -253,21 +256,23 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "adding $a to $b: "
+echo -n "$0 => adding $a to $b: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
 grep 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
+
+exit ${return}
\ No newline at end of file
diff --git a/unit-tests/bignum-expt.sh b/unit-tests/bignum-expt.sh
index ab9cb24..878acd3 100755
--- a/unit-tests/bignum-expt.sh
+++ b/unit-tests/bignum-expt.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+return=0
+
 #####################################################################
 # last 'smallnum' value:
 # sbcl calculates (expt 2 59) => 576460752303423488
@@ -18,13 +20,13 @@ EOF`
 
 actual=`echo "$output" | tail -1 | sed 's/\,//g'`
 
-echo -n "(expt 2 59): "
+echo -n "$0 => (expt 2 59): "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -45,13 +47,13 @@ EOF`
 
 actual=`echo "$output" | tail -1 | sed 's/\,//g'`
 
-echo -n "(expt 2 60): "
+echo -n "$0 => (expt 2 60): "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -72,13 +74,13 @@ EOF`
 
 actual=`echo "$output" | tail -1 | sed 's/\,//g'`
 
-echo -n "(expt 2 61): "
+echo -n "$0 => (expt 2 61): "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -99,13 +101,13 @@ EOF`
 
 actual=`echo "$output" | tail -1 | sed 's/\,//g'`
 
-echo -n "(expt 2 64): "
+echo -n "$0 => (expt 2 64): "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 # sbcl calculates (expt 2 65) => 36893488147419103232
@@ -124,12 +126,13 @@ EOF`
 
 actual=`echo "$output" | tail -1 | sed 's/\,//g'`
 
-echo -n "(expt 2 65): "
+echo -n "$0 => (expt 2 65): "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
-exit 0
+
+exit ${return}
\ No newline at end of file
diff --git a/unit-tests/bignum-print.sh b/unit-tests/bignum-print.sh
index d556e71..2be8032 100755
--- a/unit-tests/bignum-print.sh
+++ b/unit-tests/bignum-print.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+return=0
+
 #####################################################################
 # large number, not actally a bignum
 expected='576460752303423488'
@@ -9,13 +11,13 @@ actual=`echo $output |\
   sed 's/\,//g' |\
   sed 's/[^0-9]*\([0-9]*\).*/\1/'`
 
-echo -n "printing $expected: "
+echo -n "$0 => printing $expected: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -28,13 +30,13 @@ actual=`echo $output |\
   sed 's/\,//g' |\
   sed 's/[^0-9]*\([0-9]*\).*/\1/'`
 
-echo -n "printing $expected: "
+echo -n "$0 => printing $expected: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -47,13 +49,13 @@ actual=`echo $output |\
   sed 's/\,//g' |\
   sed 's/[^0-9]*\([0-9]*\).*/\1/'`
 
-echo -n "printing $expected: "
+echo -n "$0 => printing $expected: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -70,13 +72,13 @@ actual=`echo $output |\
   sed 's/\,//g' |\
   sed 's/[^0-9]*\([0-9]*\).*/\1/'`
 
-echo -n "printing $expected: "
+echo -n "$0 => printing $expected: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', \n           got '${actual}'"
-    exit 1
+    return=1
 fi
 
 exit 0
@@ -90,13 +92,13 @@ actual=`echo $output |\
   sed 's/\,//g' |\
   sed 's/[^0-9]*\([0-9]*\).*/\1/'`
 
-echo -n "printing $expected: "
+echo -n "$0 => printing $expected: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
-exit 0
+exit ${return}
diff --git a/unit-tests/bignum-subtract.sh b/unit-tests/bignum-subtract.sh
index 9342913..19c673f 100755
--- a/unit-tests/bignum-subtract.sh
+++ b/unit-tests/bignum-subtract.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+return=0
+
 #####################################################################
 # subtract a smallnum from a smallnum to produce a smallnum
 # (right on the boundary)
@@ -12,13 +14,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "subtracting $b from $a: "
+echo -n "$0 => subtracting $b from $a: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 echo -n "checking no bignum was created: "
@@ -28,7 +30,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -43,13 +45,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "subtracting $b from $a: "
+echo -n "$0 => subtracting $b from $a: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -63,13 +65,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "subtracting $b from $a: "
+echo -n "$0 => subtracting $b from $a: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 
@@ -85,13 +87,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "subtracting $b from $a: "
+echo -n "$0 => subtracting $b from $a: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
 #####################################################################
@@ -105,12 +107,13 @@ actual=`echo $output |\
   tail -1 |\
   sed 's/\,//g'`
 
-echo -n "subtracting $b from $a: "
+echo -n "$0 => subtracting $b from $a: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=1
 fi
 
+exit ${return}
\ No newline at end of file
diff --git a/unit-tests/bignum.sh b/unit-tests/bignum.sh
index aa29143..cec5453 100755
--- a/unit-tests/bignum.sh
+++ b/unit-tests/bignum.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+return=0
+
 expected='1,152,921,504,606,846,976'
 # 1,152,921,504,606,846,975 is the largest single cell positive integer;
 # consequently 1,152,921,504,606,846,976 is the first two cell positive integer.
@@ -9,6 +11,8 @@ if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
-    echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    echo "$0 => Fail: expected '${expected}', got '${actual}'"
+    return=1
 fi
+
+exit ${return}
\ No newline at end of file
diff --git a/unit-tests/cond.sh b/unit-tests/cond.sh
index ab2e2f0..69952c9 100755
--- a/unit-tests/cond.sh
+++ b/unit-tests/cond.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected='5'
 actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
   echo "OK"
 else
   echo "Fail: expected '${expected}', got '${actual}'"
-  exit 1
+  result=1
 fi
 
 expected='"should"'
@@ -17,8 +19,9 @@ actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse |
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
-else
+ else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/intepreter.sh b/unit-tests/interpreter.sh
similarity index 100%
rename from unit-tests/intepreter.sh
rename to unit-tests/interpreter.sh
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index 6454b1e..a4ab77f 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected='11'
 actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    exit 1
+    result=1
 fi
 
 expected='1'
@@ -17,8 +19,9 @@ actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '$expected', got '$actual'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/list-test,sh b/unit-tests/list-test,sh
index 32f4797..12fdd60 100644
--- a/unit-tests/list-test,sh
+++ b/unit-tests/list-test,sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
 
 actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1`
@@ -9,7 +11,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    exit 1
+    result=1
 fi
 
 expected="(0 1 2 3 4)"
@@ -21,7 +23,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    exit 1
+    result=1
 fi
 
 expected="(0 1 2 3 4 5 6 7)"
@@ -34,5 +36,7 @@ then
     exit 0
 else
     echo "Fail: expected '$expected', got '$actual'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/many-args.sh b/unit-tests/many-args.sh
index 0317f77..449f7d8 100755
--- a/unit-tests/many-args.sh
+++ b/unit-tests/many-args.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=1
+
 expected="120"
 actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 # check that all the args are actually being evaluated...
@@ -20,5 +22,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+return ${result}
diff --git a/unit-tests/map.sh b/unit-tests/map.sh
index 65dc182..90857ef 100755
--- a/unit-tests/map.sh
+++ b/unit-tests/map.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 #####################################################################
 # Create an empty map using map notation
 expected='{}'
@@ -11,7 +13,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 #####################################################################
@@ -25,7 +27,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 #####################################################################
@@ -41,7 +43,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 #####################################################################
@@ -57,7 +59,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 #####################################################################
@@ -71,7 +73,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 
@@ -86,5 +88,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/multiply.sh b/unit-tests/multiply.sh
index 94b19f6..aeac7e8 100755
--- a/unit-tests/multiply.sh
+++ b/unit-tests/multiply.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected='6'
 actual=`echo "(multiply 2 3)" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 expected='7.5'
@@ -17,8 +19,9 @@ actual=`echo "(multiply 2.5 3)" | target/psse | tail -1`
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/path-notation.sh b/unit-tests/path-notation.sh
index a6cb669..70610b0 100755
--- a/unit-tests/path-notation.sh
+++ b/unit-tests/path-notation.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 #####################################################################
 # Create a path from root using compact path notation
 expected='(-> oblist :users :simon :functions (quote assoc))'
@@ -11,7 +13,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 #####################################################################
@@ -25,7 +27,8 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
+exit ${result}
 
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
index 352c87a..b9b44eb 100755
--- a/unit-tests/progn.sh
+++ b/unit-tests/progn.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected='5'
 actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 expected='"foo"'
@@ -17,8 +19,9 @@ actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
diff --git a/unit-tests/reverse.sh b/unit-tests/reverse.sh
index 4c2f0ae..bbc3216 100755
--- a/unit-tests/reverse.sh
+++ b/unit-tests/reverse.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
 actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 expected='(1,024 512 256 128 64 32 16 8 4 2)'
@@ -19,7 +21,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 expected='esrever'
@@ -31,6 +33,8 @@ then
     exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
+echo ${result}
+
diff --git a/unit-tests/slurp.sh b/unit-tests/slurp.sh
index 0a9bc7c..700df15 100755
--- a/unit-tests/slurp.sh
+++ b/unit-tests/slurp.sh
@@ -11,6 +11,6 @@ then
     rm ${tmp}
     exit 0
 else
-    echo "Fail: expected '$expected', got '$actual'"
+    echo "$0 => Fail: expected '$expected', got '$actual'"
     exit 1
 fi
diff --git a/unit-tests/string-allocation.sh b/unit-tests/string-allocation.sh
index 6f55143..1790788 100755
--- a/unit-tests/string-allocation.sh
+++ b/unit-tests/string-allocation.sh
@@ -10,6 +10,6 @@ then
     echo "OK"
     exit 0
 else
-    echo "Fail: expected '${expected}', got '${actual}'"
+    echo "$0 => Fail: expected '${expected}', got '${actual}'"
     exit 1
 fi
diff --git a/unit-tests/string-cons.sh b/unit-tests/string-cons.sh
index 0ea0a71..ad6e3d2 100755
--- a/unit-tests/string-cons.sh
+++ b/unit-tests/string-cons.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 # We should be able to cons a single character string onto the front of a string
 expected='"Test"'
 actual=`echo '(cons "T" "est")' | target/psse | tail -1`
@@ -9,7 +11,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
 
 # But if the first argument has more than one character, we should get a dotted pair
@@ -21,5 +23,8 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=1
 fi
+
+exit ${result}
+

From 351ca5bd17e935db71c48bcf66fa7aec3ed56dbb Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 4 Feb 2026 22:57:10 +0000
Subject: [PATCH 45/90] Work on reducing allocation leaks in read_number().
 This is now improved, but not yet satisfactory.

---
 lisp/fact.lisp                                |   4 +-
 lisp/slurp.lisp                               |   2 +-
 src/arith/integer.c                           |   1 +
 src/init.c                                    |  15 +-
 src/io/read.c                                 |  33 ++--
 state-of-play.md                              | 159 ++++++++++++++++++
 .../allocation-tests/allocation-tester.sh     |  22 +++
 .../allocation-tests/allocation-tests.csv     |  28 +++
 unit-tests/allocation-tests/test-forms        |  28 +++
 9 files changed, 275 insertions(+), 17 deletions(-)
 create mode 100755 unit-tests/allocation-tests/allocation-tester.sh
 create mode 100644 unit-tests/allocation-tests/allocation-tests.csv
 create mode 100644 unit-tests/allocation-tests/test-forms

diff --git a/lisp/fact.lisp b/lisp/fact.lisp
index 17a7288..1ad4c19 100644
--- a/lisp/fact.lisp
+++ b/lisp/fact.lisp
@@ -4,4 +4,6 @@
       (cond ((= n 1) 1)
         (t (* n (fact (- n 1)))))))
 
-(fact 1000)
+; (fact 1000)
+
+
diff --git a/lisp/slurp.lisp b/lisp/slurp.lisp
index e927bcb..2223bbd 100644
--- a/lisp/slurp.lisp
+++ b/lisp/slurp.lisp
@@ -1 +1 @@
-(slurp (set! f (open "http://www.journeyman.cc/")))
+(slurp (open "http://www.journeyman.cc/"))
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 3bb58bd..41c46ef 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -86,6 +86,7 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
         struct cons_space_object *cell = &pointer2cell( result );
         cell->payload.integer.value = value;
         cell->payload.integer.more = more;
+        inc_ref(result);
     }
 
     debug_print( L"make_integer: returning\n", DEBUG_ALLOC );
diff --git a/src/init.c b/src/init.c
index 4443469..2d0d2d2 100644
--- a/src/init.c
+++ b/src/init.c
@@ -28,6 +28,7 @@
 #include "memory/hashmap.h"
 #include "ops/intern.h"
 #include "io/io.h"
+#include "io/fopen.h"
 #include "ops/lispops.h"
 #include "ops/meta.h"
 #include "arith/peano.h"
@@ -124,6 +125,7 @@ int main( int argc, char *argv[] ) {
     int option;
     bool dump_at_end = false;
     bool show_prompt = false;
+    char * infilename = NULL;
 
     setlocale( LC_ALL, "" );
     if ( io_init(  ) != 0 ) {
@@ -131,7 +133,7 @@ int main( int argc, char *argv[] ) {
         exit( 1 );
     }
 
-    while ( ( option = getopt( argc, argv, "phdv:" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "phdv:i:" ) ) != -1 ) {
         switch ( option ) {
             case 'd':
                 dump_at_end = true;
@@ -141,6 +143,9 @@ int main( int argc, char *argv[] ) {
                 print_options( stdout );
                 exit( 0 );
                 break;
+            case 'i' :
+                infilename = optarg;
+                break;
             case 'p':
                 show_prompt = true;
                 break;
@@ -191,8 +196,12 @@ int main( int argc, char *argv[] ) {
     fwide( stdout, 1 );
     fwide( stderr, 1 );
     fwide( sink->handle.file, 1 );
-    bind_value( L"*in*", make_read_stream( file_to_url_file( stdin ),
-                                           make_cons( make_cons
+
+    FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r");
+
+
+    bind_value( L"*in*", make_read_stream(  file_to_url_file(infile),
+                                            make_cons( make_cons
                                                       ( c_string_to_lisp_keyword
                                                         ( L"url" ),
                                                         c_string_to_lisp_string
diff --git a/src/io/read.c b/src/io/read.c
index 50f469e..13b0942 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -330,17 +330,20 @@ struct cons_pointer read_number( struct stack_frame *frame,
                     debug_print( L"read_number: ratio slash seen\n",
                                  DEBUG_IO );
                     dividend = result;
-
-                    result = make_integer( 0, NIL );
                 }
                 break;
             case LCOMMA:
                 // silently ignore comma.
                 break;
             default:
-                result = add_integers( multiply_integers( result, base ),
-                                       make_integer( ( int ) c - ( int ) '0',
-                                                     NIL ) );
+            {
+                struct cons_pointer digit = make_integer( ( int ) c - ( int ) '0',
+                                                     NIL );
+                struct cons_pointer new_result = add_integers( multiply_integers( result, base ),
+                                       digit );
+                dec_ref( result);
+                dec_ref( digit);
+                result = new_result;
 
                 debug_printf( DEBUG_IO,
                               L"read_number: added character %c, result now ",
@@ -351,6 +354,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 if ( seen_period ) {
                     places_of_decimals++;
                 }
+            }
         }
     }
 
@@ -360,13 +364,14 @@ struct cons_pointer read_number( struct stack_frame *frame,
     url_ungetwc( c, input );
 
     if ( seen_period ) {
-        debug_print( L"read_number: converting result to real\n", DEBUG_IO );
-        struct cons_pointer div = make_ratio( result,
-                                              make_integer( powl
-                                                            ( to_long_double
-                                                              ( base ),
+        struct cons_pointer divisor = make_integer( powl( to_long_double( base ),
                                                               places_of_decimals ),
-                                                            NIL ) );
+                                                            NIL );
+        debug_print( L"read_number: converting result to real\n", DEBUG_IO );
+
+        struct cons_pointer div = make_ratio( result,
+                                              divisor);
+        dec_ref( divisor);
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
@@ -378,15 +383,19 @@ struct cons_pointer read_number( struct stack_frame *frame,
     }
 
     if ( neg ) {
+        struct cons_pointer negt = negative( result );
         debug_print( L"read_number: converting result to negative\n",
                      DEBUG_IO );
 
-        result = negative( result );
+        dec_ref( result);
+        result = negt;
     }
 
     debug_print( L"read_number returning\n", DEBUG_IO );
     debug_dump_object( result, DEBUG_IO );
 
+    dec_ref( base);
+
     return result;
 }
 
diff --git a/state-of-play.md b/state-of-play.md
index 0855715..18fca93 100644
--- a/state-of-play.md
+++ b/state-of-play.md
@@ -1,5 +1,162 @@
 # State of Play
 
+## 20260204
+
+### Testing what is leaking memory
+
+#### Analysis
+
+If you just start up and immediately abort the current build of psse, you get:
+
+> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
+
+Allocation summaries from the current unit tests give the following ranges of values:
+
+|                 | Min   | Max   |      |
+| --------------- | ----- | ----- | ---- |
+| Allocated       | 19991 | 39009 |      |
+| Deallocated     |   238 |  1952 |      |
+| Not deallocated | 19741 | 37057 |      |
+
+The numbers go up broadly in sinc with one another — that is to say, broadly, as the number allocated rises, so do both the numbers deallocated and the numbers not deallocated. But not exactly.
+
+#### Strategy: what doesn't get cleaned up?
+
+Write a test wrapper which reads a file of forms, one per line, from standard input, and passes each in turn to a fresh invocation of psse, reporting the form and the allocation summary.
+
+```bash
+#1/bin/bash
+
+while IFS= read -r form; do
+    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation`
+    echo "* ${allocation}: ${form}"
+done
+```
+
+So, from this:
+
+* Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.: 
+* Allocation summary: allocated 19990; deallocated 249; not deallocated 19741.: ()
+* Allocation summary: allocated 20019; deallocated 253; not deallocated 19766.: nil
+
+Allocating an empty list allocates four additional cells, all of which are deallocated. Allocating 'nil' allocates a further **29** cells, 25 of which are not deallocated. WTF?
+
+Following further work I have this, showing the difference added to the base case of cells allocated, cells deallocated, and, most critically, cells not deallocated.
+
+From this we see that reading and printing `nil` allocates an additional 33 cells, of which eight are not cleaned up. That's startling, and worrying.
+
+But the next row shows us that reading and printing an empty list costs only four cells, each of which is cleaned up. Further down the table we see that an empty map is also correctly cleaned up. Where we're leaking memory is in reading (or printing, although I doubt this) symbols, either atoms, numbers, or keywords (I haven't yet tried strings, but I expect they're similar.)
+
+| **Case**                          | **Delta Allocated** | **Delta Deallocated** | **Delta Not Deallocated** |
+| --------------------------------- | ------------------- | --------------------- | ------------------------- |
+| **Basecase**                      | 0                   | 0                     | 0                         |
+| **nil**                           | 33                  | 8                     | 25                        |
+| **()**                            | 4                   | 4                     | 0                         |
+| **(quote ())**                    | 39                  | 2                     | 37                        |
+| **(list )**                       | 37                  | 12                    | 25                        |
+| **(list 1)**                      | 47                  | 14                    | 33                        |
+| **(list 1 1)**                    | 57                  | 16                    | 41                        |
+| **(list 1 1 1)**                  | 67                  | 18                    | 49                        |
+| **(list 1 2 3)**                  | 67                  | 18                    | 49                        |
+| **(+)**                           | 36                  | 10                    | 26                        |
+| **(+ 1)**                         | 44                  | 12                    | 32                        |
+| **(+ 1 1)**                       | 53                  | 14                    | 39                        |
+| **(+ 1 1 1)**                     | 62                  | 16                    | 46                        |
+| **(+ 1 2 3)**                     | 62                  | 16                    | 46                        |
+| **(list 'a 'a 'a)**               | 151                 | 33                    | 118                       |
+| **(list 'a 'b 'c)**               | 151                 | 33                    | 118                       |
+| **(list :a :b :c)**               | 121                 | 15                    | 106                       |
+| **(list :alpha :bravo :charlie)** | 485                 | 15                    | 470                       |
+| **{}**                            | 6                   | 6                     | 0                         |
+| **{:z 0}**                        | 43                  | 10                    | 33                        |
+| **{:zero 0}**                     | 121                 | 10                    | 111                       |
+| **{:z 0 :o 1}**                   | 80                  | 11                    | 69                        |
+| **{:zero 0 :one 1}**              | 210                 | 14                    | 196                       |
+| **{:z 0 :o 1 :t 2}**              | 117                 | 12                    | 105                       |
+
+Looking at the entries, we see that
+
+1. each number read costs ten allocations, of which only two are successfully deallocated;
+2. the symbol `list` costs 33 cells, of which 25 are not deallocated, whereas the symbol `+` costs only one cell fewer, and an additional cell is not deallocated. So it doesn't seem that cell allocation scales with the length of the symbol;
+3. Keyword allocation does scale with the length of the keyword, apparently, since `(list :a :b :c)` allocates 121 and deallocates 15, while `(list :alpha :bravo :charlie)` allocates 485 and deallocates the same 15;
+4. The fact that both those two deallocate 15, and a addition of three numbers `(+ 1 2 3)` or `(+ 1 1 1)` deallocates 16 suggest to me that the list structure is being fully reclaimed but atoms are not being. 
+5. The atom `'a` costs more to read than the keyword `:a` because the reader macro is expanding `'a` to `(quote a)` behind the scenes.
+
+### The integer allocation bug
+
+Looking at what happens when we read a single digit  number, we get the following:
+
+```
+2
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 507 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 507 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 508 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 508 count 0
+                Integer cell: value 10, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 509 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 509 count 0
+                Integer cell: value 2, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 510 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 510 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 506 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 506 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 505 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 505 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 504 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 0, count 0
+
+Allocated cell of type 'STRG' at 19, 503 
+Freeing cell    STRG (1196577875) at page 19, offset 503 count 0
+                String cell: character '2' (50) with hash 0; next at page 0 offset 0, count 0
+                 value: "2"
+Freeing cell    INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 2, count 0
+2
+Allocated cell of type 'SYMB' at 19, 504 
+Allocated cell of type 'SYMB' at 19, 503 
+Allocated cell of type 'SYMB' at 19, 502 
+Allocated cell of type 'SYMB' at 19, 501 
+Freeing cell    SYMB (1112365395) at page 19, offset 501 count 0
+                Symbol cell: character '*' (42) with hash 485100; next at page 19 offset 502, count 0
+                 value: *in*
+Freeing cell    SYMB (1112365395) at page 19, offset 502 count 0
+                Symbol cell: character 'i' (105) with hash 11550; next at page 19 offset 503, count 0
+                 value: in*
+Freeing cell    SYMB (1112365395) at page 19, offset 503 count 0
+                Symbol cell: character 'n' (110) with hash 110; next at page 19 offset 504, count 0
+                 value: n*
+Freeing cell    SYMB (1112365395) at page 19, offset 504 count 0
+                Symbol cell: character '*' (42) with hash 0; next at page 0 offset 0, count 0
+                 value: *
+```
+
+Many things are worrying here.
+
+1. The only thing being freed here is the symbol to which the read stream is bound — and I didn't see where that got allocated, but we shouldn't be allocating and tearing down a symbol for every read! This implies that when I create a string with `c_string_to_lisp_string`, I need to make damn sure that that string is deallocated as soon as I'm done with it — and wherever I'm dealing with symbols which will be referred to repeatedly in `C` code, I need either
+   1.  to bind a global on the C side of the world, which will become messy;
+   2. or else write a hash function which returns, for a `C` string, the same value that the standard hashing function will return for the lexically equivalent `Lisp` string, so that I can search hashmap structures from C without having to allocate and deallocate a fresh copy of the `Lisp` string;
+   3. In reading numbers, I'm generating a fresh instance of `Lisp zero` and `Lisp ten`, each time `read_integer` is called, and I'm not deallocating them.
+   4. I am correctly deallocating the number I did read, though!
+
 ## 20260203
 
 I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
@@ -53,6 +210,8 @@ In other words, all failures are in bignum arithmetic **except** that I still ha
 
 ### Zig
 
+I've also experimented with autotranslating my C into Zig, but this failed. Although I don't think C is the right language for implementing my base Lisp in, it's what I've got; and until I can get some form of autotranslate to bootstrap me into some more modern systems language, I think I need to stick with it.
+
 ## 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.
diff --git a/unit-tests/allocation-tests/allocation-tester.sh b/unit-tests/allocation-tests/allocation-tester.sh
new file mode 100755
index 0000000..5605075
--- /dev/null
+++ b/unit-tests/allocation-tests/allocation-tester.sh
@@ -0,0 +1,22 @@
+#1/bin/bash
+
+echo "Case, Summary, Allocated, Deallocated, Not deallocated, Delta Allocated, Delta Deallocated, Delta Not Deallocated"
+basecase=`echo '' | ../../target/psse 2>&1 | grep Allocation | tr -d  '[:punct:]'`
+bca=`echo ${basecase} | awk '{print $4}'`
+bcd=`echo ${basecase} | awk '{print $6}'`
+bcn=`echo ${basecase} | awk '{print $9}'`
+
+echo "\"Basecase\", \"${basecase}\", ${bca}, ${bcd}, ${bcn}"
+
+while IFS= read -r form; do
+    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation | tr -d  '[:punct:]'`
+    tca=`echo ${allocation} | awk '{print $4}'`
+    tcd=`echo ${allocation} | awk '{print $6}'`
+    tcn=`echo ${allocation} | awk '{print $9}'`
+
+    dca=`echo "${tca} - ${bca}" | bc`
+    dcd=`echo "${tcd} - ${bcd}" | bc`
+    dcn=`echo "${tcn} - ${bcn}" | bc`
+
+    echo "\"${form}\", \"${allocation}\", ${tca}, ${tcd}, ${tcn}, ${dca}, ${dcd}, ${dcn}" 
+done
diff --git a/unit-tests/allocation-tests/allocation-tests.csv b/unit-tests/allocation-tests/allocation-tests.csv
new file mode 100644
index 0000000..902577b
--- /dev/null
+++ b/unit-tests/allocation-tests/allocation-tests.csv
@@ -0,0 +1,28 @@
+Case, Summary, Allocated, Deallocated, Not deallocated, Delta Allocated, Delta Deallocated, Delta Not Deallocated
+"Basecase", "Allocation summary allocated 19986 deallocated 245 not deallocated 19741", 19986, 245, 19741
+"", "Allocation summary allocated 19986 deallocated 245 not deallocated 19741", 19986, 245, 19741, 0, 0, 0
+"nil", "Allocation summary allocated 20019 deallocated 253 not deallocated 19766", 20019, 253, 19766, 33, 8, 25
+"()", "Allocation summary allocated 19990 deallocated 249 not deallocated 19741", 19990, 249, 19741, 4, 4, 0
+"(quote ())", "Allocation summary allocated 20025 deallocated 247 not deallocated 19778", 20025, 247, 19778, 39, 2, 37
+"(list)", "Allocation summary allocated 20023 deallocated 257 not deallocated 19766", 20023, 257, 19766, 37, 12, 25
+"(list )", "Allocation summary allocated 20023 deallocated 257 not deallocated 19766", 20023, 257, 19766, 37, 12, 25
+"(list 1)", "Allocation summary allocated 20033 deallocated 259 not deallocated 19774", 20033, 259, 19774, 47, 14, 33
+"(list 1 1)", "Allocation summary allocated 20043 deallocated 261 not deallocated 19782", 20043, 261, 19782, 57, 16, 41
+"(list 1 1 1)", "Allocation summary allocated 20053 deallocated 263 not deallocated 19790", 20053, 263, 19790, 67, 18, 49
+"(list 1 2 3)", "Allocation summary allocated 20053 deallocated 263 not deallocated 19790", 20053, 263, 19790, 67, 18, 49
+"(+)", "Allocation summary allocated 20022 deallocated 255 not deallocated 19767", 20022, 255, 19767, 36, 10, 26
+"(+ 1)", "Allocation summary allocated 20030 deallocated 257 not deallocated 19773", 20030, 257, 19773, 44, 12, 32
+"(+ 1 1)", "Allocation summary allocated 20039 deallocated 259 not deallocated 19780", 20039, 259, 19780, 53, 14, 39
+"(+ 1 1 1)", "Allocation summary allocated 20048 deallocated 261 not deallocated 19787", 20048, 261, 19787, 62, 16, 46
+"(+ 1 2 3)", "Allocation summary allocated 20048 deallocated 261 not deallocated 19787", 20048, 261, 19787, 62, 16, 46
+"(list 'a 'a 'a)", "Allocation summary allocated 20137 deallocated 278 not deallocated 19859", 20137, 278, 19859, 151, 33, 118
+"(list 'a 'b 'c)", "Allocation summary allocated 20137 deallocated 278 not deallocated 19859", 20137, 278, 19859, 151, 33, 118
+"(list :a :b :c)", "Allocation summary allocated 20107 deallocated 260 not deallocated 19847", 20107, 260, 19847, 121, 15, 106
+"(list :alpha :bravo :charlie)", "Allocation summary allocated 20471 deallocated 260 not deallocated 20211", 20471, 260, 20211, 485, 15, 470
+"{}", "Allocation summary allocated 19992 deallocated 251 not deallocated 19741", 19992, 251, 19741, 6, 6, 0
+"{:z 0}", "Allocation summary allocated 20029 deallocated 255 not deallocated 19774", 20029, 255, 19774, 43, 10, 33
+"{:zero 0}", "Allocation summary allocated 20107 deallocated 255 not deallocated 19852", 20107, 255, 19852, 121, 10, 111
+"{:z 0 :o 1}", "Allocation summary allocated 20066 deallocated 256 not deallocated 19810", 20066, 256, 19810, 80, 11, 69
+"{:zero 0 :one 1}", "Allocation summary allocated 20196 deallocated 259 not deallocated 19937", 20196, 259, 19937, 210, 14, 196
+"{:z 0 :o 1 :t 2}", "Allocation summary allocated 20103 deallocated 257 not deallocated 19846", 20103, 257, 19846, 117, 12, 105
+"{:zero 0 :one 1 :two 2 :three 3 :four 4 :five five :six 6 :seven 7 :eight 8 :nine 9}", "Allocation summary allocated 21164 deallocated 286 not deallocated 20878", 21164, 286, 20878, 1178, 41, 1137
diff --git a/unit-tests/allocation-tests/test-forms b/unit-tests/allocation-tests/test-forms
new file mode 100644
index 0000000..6f63893
--- /dev/null
+++ b/unit-tests/allocation-tests/test-forms
@@ -0,0 +1,28 @@
+
+nil
+()
+(quote ())
+(list)
+(list )
+(list 1)
+(list 1 1)
+(list 1 1 1)
+(list 1 2 3)
+(+)
+(+ 1)
+(+ 1 1)
+(+ 1 1 1)
+(+ 1 2 3)
+(list 'a 'a 'a)
+(list 'a 'b 'c)
+(list :a :b :c)
+(list :aa :bb :cc)
+(list :aaa :bbb :ccc)
+(list :alpha :bravo :charlie)
+{}
+{:z 0}
+{:zero 0}
+{:z 0 :o 1}
+{:zero 0 :one 1}
+{:z 0 :o 1 :t 2}
+{:zero 0 :one 1 :two 2 :three 3 :four 4 :five five :six 6 :seven 7 :eight 8 :nine 9}

From 004ff6737c3def1f21cebb855b9f058379b6aa0f Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 12 Feb 2026 10:17:11 +0000
Subject: [PATCH 46/90] feature-2: allocating cells with count = 1; 7 unit
 tests (all bignums) fail.

---
 src/arith/integer.c   | 172 ++++++++++++++++++++++++++++++------------
 src/arith/integer.h   |   7 ++
 src/arith/peano.h     |   3 +-
 src/arith/ratio.c     |  38 +++++-----
 src/init.c            |  25 +++---
 src/io/io.c           |  19 ++++-
 src/io/io.h           |   8 +-
 src/io/read.c         |  38 ++++------
 src/memory/conspage.c |   4 +-
 src/ops/intern.c      |   9 +--
 10 files changed, 209 insertions(+), 114 deletions(-)

diff --git a/src/arith/integer.c b/src/arith/integer.c
index 41c46ef..e9d9b79 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -19,12 +19,13 @@
 #include 
 #include 
 
+#include "arith/integer.h"
+#include "arith/peano.h"
+#include "debug.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "debug.h"
 #include "ops/equal.h"
 #include "ops/lispops.h"
-#include "arith/peano.h"
 
 /**
  * hexadecimal digits for printing numbers.
@@ -34,19 +35,33 @@ const char *hex_digits = "0123456789ABCDEF";
 /*
  * Doctrine from here on in is that ALL integers are bignums, it's just
  * that integers less than 61 bits are bignums of one cell only.
+ * that integers less than 61 bits are bignums of one cell only. 
+ * TODO: why do I not have confidence to make this 64 bits?
  */
 
+ /*
+  * A small_int_cache array of pointers to the integers 0...23,
+  * used only by functions `acquire_integer(int64) => cons_pointer` and
+  * `release_integer(cons_pointer) => NULL` which, if the value desired is
+  * in the cache, supplies it from the cache, and, otherwise, calls 
+  * make_integer() and dec_ref() respectively. 
+  */
+
+#define SMALL_INT_LIMIT 24
+bool small_int_cache_initialised = false;
+struct cons_pointer small_int_cache[SMALL_INT_LIMIT];
+
  /**
- * Low level integer arithmetic, do not use elsewhere.
- *
- * @param c a pointer to a cell, assumed to be an integer cell;
- * @param op a character representing the operation: expectedto be either
- * '+' or '*'; behaviour with other values is undefined.
- * @param is_first_cell true if this is the first cell in a bignum
- * chain, else false.
- * \see multiply_integers
- * \see add_integers
- */
+  * Low level integer arithmetic, do not use elsewhere.
+  *
+  * @param c a pointer to a cell, assumed to be an integer cell;
+  * @param op a character representing the operation: expectedto be either
+  * '+' or '*'; behaviour with other values is undefined.
+  * @param is_first_cell true if this is the first cell in a bignum
+  * chain, else false.
+  * \see multiply_integers
+  * \see add_integers
+  */
 __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;
 
@@ -86,7 +101,6 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
         struct cons_space_object *cell = &pointer2cell( result );
         cell->payload.integer.value = value;
         cell->payload.integer.more = more;
-        inc_ref(result);
     }
 
     debug_print( L"make_integer: returning\n", DEBUG_ALLOC );
@@ -95,11 +109,74 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
 }
 
 /**
- * Overwrite the value field of the integer indicated by `new` with
+ * @brief Supply small valued integers from the small integer cache, if available.
+ *
+ * The pattern here is intended to be that, at least within this file, instead of
+ * calling make_integer when an integer is required and dec_ref when it's no longer 
+ * required, we call acquire_integer and release_integer respectively, in order to
+ * reduce allocation churn.
+ *
+ * In the initial implementation, acquire_integer supplies the integer from the 
+ * small integer cache if available, else calls make_integer. Later, more 
+ * sophisticated caching of integers which are currently in play may be enabled.
+ * 
+ * @param value the value of the integer desired.
+ * @param more if this value is a bignum, the rest (less significant bits) of the
+ * value.
+ * @return struct cons_pointer a pointer to the integer acquired.
+ */
+struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
+    struct cons_pointer result;
+
+    if ( !nilp( more) || value >= SMALL_INT_LIMIT) {
+        debug_print( L"acquire_integer passing to make_integer (too large)\n", DEBUG_ALLOC );
+        result = make_integer( value, more);
+    } else {
+        if ( !small_int_cache_initialised) {
+            for (int64_t i = 0; i < SMALL_INT_LIMIT; i++) {
+                small_int_cache[i] = make_integer( i, NIL);
+                pointer2cell(small_int_cache[i]).count = UINT32_MAX; // lock it in so it can't be GC'd
+            }
+           small_int_cache_initialised = true;
+            debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );
+        }
+
+        debug_printf( DEBUG_ALLOC, L"acquire_integer: returning %" PRId64 "\n", value);
+        result = small_int_cache[value];
+    }
+    return result;
+}
+
+/**
+ * @brief if the value of p is less than the size of the small integer cache
+ * (and thus it was presumably supplied from there), suppress dec_ref.
+ *
+ * **NOTE THAT** at this stage it's still safe to dec_ref an arbitrary integer,
+ * because those in the cache are locked and can't be dec_refed.
+ * 
+ * @param p a pointer, expected to be to an integer.
+ */
+void release_integer( struct cons_pointer p) {
+    struct cons_space_object o = pointer2cell( p);
+    if ( !integerp( p) ||                   // what I've been passed isn't an integer;
+        !nilp( o.payload.integer.more) ||   // or it's a bignum;
+        o.payload.integer.value >= SMALL_INT_LIMIT || // or it's bigger than the small int cache limit;
+        !eq( p, small_int_cache[ o.payload.integer.value]) // or it's simply not the copy in the cache...
+    ) { dec_ref( p); } else {
+        debug_printf( DEBUG_ALLOC, L"release_integer: releasing %" PRId64 "\n", 
+            o.payload.integer.value);
+    }
+}
+
+
+/**
+ * @brief Overwrite the value field of the integer indicated by `new` with
  * 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.
+ * more significant bits (if any) right-shifted by INTEGER_BITS places.
+ * 
+ * Destructive, primitive, DO NOT USE in any context except primitive 
+ * operations on integers. The value passed as `new` MUST be constructed
+ * with `make_integer`, NOT acquired with `acquire_integer`.
  *
  * @param val the value to represent;
  * @param less_significant the less significant words of this bignum, if any,
@@ -134,25 +211,6 @@ __int128_t int128_to_integer( __int128_t val,
     return carry;
 }
 
-struct cons_pointer make_integer_128( __int128_t val,
-                                      struct cons_pointer less_significant ) {
-    struct cons_pointer result = NIL;
-
-    do {
-        if ( MAX_INTEGER >= val ) {
-            result = make_integer( ( long int ) val, less_significant );
-        } else {
-            less_significant =
-                make_integer( ( long int ) val & MAX_INTEGER,
-                              less_significant );
-            val = val * INT_CELL_BASE;
-        }
-
-    } while ( nilp( result ) );
-
-    return result;
-}
-
 /**
  * Return a pointer to an integer representing the sum of the integers
  * pointed to by `a` and `b`. If either isn't an integer, will return nil.
@@ -218,28 +276,38 @@ struct cons_pointer base_partial( int depth ) {
     struct cons_pointer result = NIL;
 
     for ( int i = 0; i < depth; i++ ) {
-        result = make_integer( 0, result );
+        result = acquire_integer( 0, result );
     }
 
     return result;
 }
 
 /**
- * destructively modify this `partial` by appending this `digit`.
+ * @brief Return a copy of this `partial` with this `digit` appended.
+ *
+ * @param partial the more significant bits of a possible bignum.
+ * @param digit the less significant bits of that possible bignum. NOTE: the
+ * name `digit` is technically correct but possibly misleading, because the
+ * numbering system here is base INT_CELL_BASE, currently x0fffffffffffffffL
  */
-struct cons_pointer append_digit( struct cons_pointer partial,
+struct cons_pointer append_cell( struct cons_pointer partial,
                                   struct cons_pointer digit ) {
-    struct cons_pointer c = partial;
+    struct cons_space_object cell = pointer2cell( partial);
+    // TODO: I should recursively copy the whole bignum chain, because
+    // we're still destructively modifying the end of it.
+    struct cons_pointer c = make_integer( cell.payload.integer.value, 
+        cell.payload.integer.more);
     struct cons_pointer result = partial;
 
-    if ( nilp( partial ) ) {
+    if ( nilp( partial)) {
         result = digit;
     } else {
+        // find the last digit in the chain...
         while ( !nilp( pointer2cell( c ).payload.integer.more ) ) {
             c = pointer2cell( c ).payload.integer.more;
         }
 
-        ( &pointer2cell( c ) )->payload.integer.more = digit;
+        ( pointer2cell( c ) ).payload.integer.more = digit;
     }
     return result;
 }
@@ -259,7 +327,7 @@ struct cons_pointer append_digit( struct cons_pointer partial,
  */
 struct cons_pointer multiply_integers( struct cons_pointer a,
                                        struct cons_pointer b ) {
-    struct cons_pointer result = make_integer( 0, NIL );
+    struct cons_pointer result = acquire_integer( 0, NIL );
     bool neg = is_negative( a ) != is_negative( b );
     bool is_first_b = true;
     int i = 0;
@@ -300,16 +368,18 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
                 /* if xj exceeds one digit, break it into the digit dj and
                  * the carry */
                 carry = xj >> INTEGER_BIT_SHIFT;
-                struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL );
+                struct cons_pointer dj = acquire_integer( xj & MAX_INTEGER, NIL );
 
-                /* destructively modify ri by appending dj */
-                ri = append_digit( ri, dj );
+                replace_integer_p( ri,  append_cell( ri, dj ));
+                // struct cons_pointer new_ri = append_cell( ri, dj );
+                // release_integer( ri); 
+                // ri = new_ri;
             }                   /* end for bj */
 
-            /* if carry is not equal to zero, append it as a final digit
+            /* if carry is not equal to zero, append it as a final cell
              * to ri */
             if ( carry != 0 ) {
-                ri = append_digit( ri, make_integer( carry, NIL ) );
+                replace_integer_i( ri, carry)
             }
 
             /* add ri to result */
@@ -341,6 +411,9 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits,
 }
 
 /**
+ * @brief return a string representation of this integer, which may be a
+ * bignum.
+ *
  * The general principle of printing a bignum is that you print the least
  * significant digit in whatever base you're dealing with, divide through
  * by the base, print the next, and carry on until you've none left.
@@ -350,6 +423,9 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits,
  * object to the next. 64 bit integers don't align with decimal numbers, so
  * when we get to the last digit from one integer cell, we have potentially
  * to be looking to the next. H'mmmm.
+ *
+ * @param int_pointer cons_pointer to the integer to print,
+ * @param base the base to print it in.
  */
 struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                                        int base ) {
diff --git a/src/arith/integer.h b/src/arith/integer.h
index 09a7a83..d0b4b71 100644
--- a/src/arith/integer.h
+++ b/src/arith/integer.h
@@ -14,8 +14,15 @@
 #include 
 #include 
 
+#define replace_integer_i(p,i) {struct cons_pointer __p = acquire_integer(i,NIL); release_integer(p); p = __p;}
+#define replace_integer_p(p,q) {struct cons_pointer __p = p; release_integer( p);  p = q;}
+
 struct cons_pointer make_integer( int64_t value, struct cons_pointer more );
 
+struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more );
+
+void release_integer( struct cons_pointer p);
+
 struct cons_pointer add_integers( struct cons_pointer a,
                                   struct cons_pointer b );
 
diff --git a/src/arith/peano.h b/src/arith/peano.h
index 95c5013..5e83f0c 100644
--- a/src/arith/peano.h
+++ b/src/arith/peano.h
@@ -7,11 +7,12 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#include "consspaceobject.h"
 
 #ifndef PEANO_H
 #define PEANO_H
 
+#include "memory/consspaceobject.h"
+
 /**
  * The maximum value we will allow in an integer cell: one less than 2^60:
  * (let ((s (make-string-output-stream)))
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 5135d6b..f0095b1 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -61,11 +61,11 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
 
             if ( gcd > 1 ) {
                 if ( drrv / gcd == 1 ) {
-                    result = make_integer( ddrv / gcd, NIL );
+                    result = acquire_integer( ddrv / gcd, NIL );
                 } else {
                     result =
-                        make_ratio( make_integer( ddrv / gcd, NIL ),
-                                    make_integer( drrv / gcd, NIL ) );
+                        make_ratio( acquire_integer( ddrv / gcd, NIL ),
+                                    acquire_integer( drrv / gcd, NIL ) );
                 }
             }
         }
@@ -110,23 +110,24 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                       m1, m2 );
 
         if ( dr1v == dr2v ) {
-            r = make_ratio( make_integer( dd1v + dd2v, NIL ),
+            r = make_ratio( acquire_integer( dd1v + dd2v, NIL ),
                             cell1.payload.ratio.divisor );
         } else {
-            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 ),
+            struct cons_pointer dd1vm = acquire_integer( dd1v * m1, NIL ),
+                dr1vm = acquire_integer( dr1v * m1, NIL ),
+                dd2vm = acquire_integer( dd2v * m2, NIL ),
+                dr2vm = acquire_integer( dr2v * m2, NIL ),
                 r1 = make_ratio( dd1vm, dr1vm ),
                 r2 = make_ratio( dd2vm, dr2vm );
 
             r = add_ratio_ratio( r1, r2 );
 
+            if (!eq( r, r1)) { dec_ref( r1);}
+            if (!eq( r, r2)) { dec_ref( r2);}
+
             /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
              * never incremented except when making r1 and r2, decrementing
              * r1 and r2 should be enought to garbage collect them. */
-            dec_ref( r1 );
-            dec_ref( r2 );
         }
 
         result = simplify_ratio( r );
@@ -162,12 +163,12 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: not longer works
-        struct cons_pointer one = make_integer( 1, NIL ),
+        struct cons_pointer one = acquire_integer( 1, NIL ),
             ratio = make_ratio( intarg, one );
 
         result = add_ratio_ratio( ratio, ratarg );
 
-        dec_ref( one );
+        release_integer( one );
         dec_ref( ratio );
     } else {
         result =
@@ -231,11 +232,15 @@ struct cons_pointer multiply_ratio_ratio( struct
             pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
             ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
 
+        struct cons_pointer dividend = acquire_integer( ddrv, NIL );
+        struct cons_pointer divisor = acquire_integer( drrv, NIL );
         struct cons_pointer unsimplified =
-            make_ratio( make_integer( ddrv, NIL ),
-                        make_integer( drrv, NIL ) );
+            make_ratio( dividend, divisor);
         result = simplify_ratio( unsimplified );
 
+        release_integer( dividend);
+        release_integer( divisor);
+
         if ( !eq( unsimplified, result ) ) {
             dec_ref( unsimplified );
         }
@@ -261,12 +266,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: no longer works; fix
-        struct cons_pointer one = make_integer( 1, NIL ),
+        struct cons_pointer one = acquire_integer( 1, NIL ),
             ratio = make_ratio( intarg, one );
         result = multiply_ratio_ratio( ratio, ratarg );
 
-        dec_ref( one );
-        dec_ref( ratio );
+        release_integer( one );
     } else {
         result =
             throw_exception( c_string_to_lisp_string
diff --git a/src/init.c b/src/init.c
index 2d0d2d2..45b534f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -78,13 +78,8 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable )
 /**
  * Bind this `value` to this `name` in the `oblist`.
  */
-void bind_value( wchar_t *name, struct cons_pointer value ) {
-    struct cons_pointer n = c_string_to_lisp_symbol( name );
-    inc_ref( n );
-
-    deep_bind( n, value );
-
-    dec_ref( n );
+struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
+    return deep_bind( c_string_to_lisp_symbol( name ), value );
 }
 
 void print_banner(  ) {
@@ -200,14 +195,14 @@ int main( int argc, char *argv[] ) {
     FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r");
 
 
-    bind_value( L"*in*", make_read_stream(  file_to_url_file(infile),
-                                            make_cons( make_cons
-                                                      ( c_string_to_lisp_keyword
-                                                        ( L"url" ),
-                                                        c_string_to_lisp_string
-                                                        ( L"system:standard input" ) ),
-                                                      NIL ) ) );
-    bind_value( L"*out*",
+    lisp_io_in = bind_value( C_IO_IN, make_read_stream(  file_to_url_file(infile),
+                                    make_cons( make_cons
+                                                ( c_string_to_lisp_keyword
+                                                ( L"url" ),
+                                                c_string_to_lisp_string
+                                                ( L"system:standard input" ) ),
+                                                NIL ) ) );
+    lisp_io_out = bind_value( C_IO_OUT,
                 make_write_stream( file_to_url_file( stdout ),
                                    make_cons( make_cons
                                               ( c_string_to_lisp_keyword
diff --git a/src/io/io.c b/src/io/io.c
index d01f788..2db9492 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -28,11 +28,12 @@
 
 #include 
 
-#include "memory/conspage.h"
-#include "memory/consspaceobject.h"
+#include "arith/integer.h"
 #include "debug.h"
 #include "io/fopen.h"
-#include "arith/integer.h"
+#include "io/io.h"
+#include "memory/conspage.h"
+#include "memory/consspaceobject.h"
 #include "ops/intern.h"
 #include "ops/lispops.h"
 #include "utils.h"
@@ -44,6 +45,16 @@
  */
 CURLSH *io_share;
 
+/**
+ * @brief bound to the Lisp string representing C_IO_IN in initialisation.
+ */
+struct cons_pointer lisp_io_in = NIL;
+/**
+ * @brief bound to the Lisp string representing C_IO_OUT in initialisation.
+ */
+struct cons_pointer lisp_io_out = NIL;
+
+
 /**
  * Allow a one-character unget facility. This may not be enough - we may need
  * to allocate a buffer.
@@ -400,7 +411,7 @@ void collect_meta( struct cons_pointer stream, char *url ) {
 struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     struct cons_pointer stream_name =
-        c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" );
+         inputp ? lisp_io_in : lisp_io_out;
 
     inc_ref( stream_name );
 
diff --git a/src/io/io.h b/src/io/io.h
index dc9e8de..0f971a3 100644
--- a/src/io/io.h
+++ b/src/io/io.h
@@ -11,12 +11,18 @@
 #ifndef __psse_io_h
 #define __psse_io_h
 #include 
-#include "consspaceobject.h"
+#include "memory/consspaceobject.h"
 
 extern CURLSH *io_share;
 
 int io_init(  );
 
+#define C_IO_IN L"*in*"
+#define C_IO_OUT L"*out*"
+
+extern struct cons_pointer lisp_io_in;
+extern struct cons_pointer lisp_io_out;
+
 URL_FILE *file_to_url_file( FILE * f );
 wint_t url_fgetwc( URL_FILE * input );
 wint_t url_ungetwc( wint_t wc, URL_FILE * input );
diff --git a/src/io/read.c b/src/io/read.c
index 13b0942..bf0b389 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -291,10 +291,10 @@ struct cons_pointer read_number( struct stack_frame *frame,
                                  wint_t initial, bool seen_period ) {
     debug_print( L"entering read_number\n", DEBUG_IO );
 
-    struct cons_pointer result = make_integer( 0, NIL );
+    struct cons_pointer result = acquire_integer( 0, NIL );
     /* \todo we really need to be getting `base` from a privileged Lisp name -
      * and it should be the same privileged name we use when writing numbers */
-    struct cons_pointer base = make_integer( 10, NIL );
+    struct cons_pointer base = acquire_integer( 10, NIL );
     struct cons_pointer dividend = NIL;
     int places_of_decimals = 0;
     wint_t c;
@@ -330,20 +330,20 @@ struct cons_pointer read_number( struct stack_frame *frame,
                     debug_print( L"read_number: ratio slash seen\n",
                                  DEBUG_IO );
                     dividend = result;
+
+                    result = acquire_integer( 0, NIL );
+                    // If I do replace_integer_p here instead of acquire_integer, 
+                    // and thus reclaim the garbage, I get a regression. Dom't yet
+                    // know why.    
                 }
                 break;
             case LCOMMA:
                 // silently ignore comma.
                 break;
             default:
-            {
-                struct cons_pointer digit = make_integer( ( int ) c - ( int ) '0',
-                                                     NIL );
-                struct cons_pointer new_result = add_integers( multiply_integers( result, base ),
-                                       digit );
-                dec_ref( result);
-                dec_ref( digit);
-                result = new_result;
+                result = add_integers( multiply_integers( result, base ),
+                                       acquire_integer( ( int ) c - ( int ) '0',
+                                                     NIL ) );
 
                 debug_printf( DEBUG_IO,
                               L"read_number: added character %c, result now ",
@@ -354,7 +354,6 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 if ( seen_period ) {
                     places_of_decimals++;
                 }
-            }
         }
     }
 
@@ -364,14 +363,13 @@ struct cons_pointer read_number( struct stack_frame *frame,
     url_ungetwc( c, input );
 
     if ( seen_period ) {
-        struct cons_pointer divisor = make_integer( powl( to_long_double( base ),
-                                                              places_of_decimals ),
-                                                            NIL );
         debug_print( L"read_number: converting result to real\n", DEBUG_IO );
-
         struct cons_pointer div = make_ratio( result,
-                                              divisor);
-        dec_ref( divisor);
+                                              acquire_integer( powl
+                                                            ( to_long_double
+                                                              ( base ),
+                                                              places_of_decimals ),
+                                                            NIL ) );
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
@@ -383,19 +381,15 @@ struct cons_pointer read_number( struct stack_frame *frame,
     }
 
     if ( neg ) {
-        struct cons_pointer negt = negative( result );
         debug_print( L"read_number: converting result to negative\n",
                      DEBUG_IO );
 
-        dec_ref( result);
-        result = negt;
+        result = negative( result );
     }
 
     debug_print( L"read_number returning\n", DEBUG_IO );
     debug_dump_object( result, DEBUG_IO );
 
-    dec_ref( base);
-
     return result;
 }
 
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index b30ee53..42c0ad1 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -187,6 +187,8 @@ void free_cell( struct cons_pointer pointer ) {
                 case VECTORPOINTTV:
                     free_vso( pointer );
                     break;
+                default:
+                    fprintf( stderr, "WARNING: Freeing object of type %s!", (char *) &(cell->tag.bytes));
             }
 
             strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH );
@@ -231,7 +233,7 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
 
             cell->tag.value = tag;
 
-            cell->count = 0;
+            cell->count = 1;
             cell->payload.cons.car = NIL;
             cell->payload.cons.cdr = NIL;
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 1f6585b..cafc294 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -424,9 +424,8 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
 }
 
 /**
- * Binds this key to this value in the global oblist, but doesn't affect the
- * current environment. May not be useful except in bootstrapping (and even
- * there it may not be especially useful).
+ * @brief Binds this key to this value in the global oblist.
+
  */
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
@@ -448,10 +447,10 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     }
 
     debug_print( L"deep_bind returning ", DEBUG_BIND );
-    debug_print_object( oblist, DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    return oblist;
+    return key;
 }
 
 /**

From f6d7fcea1ea83689700b77cc891dfbf025e6ddfe Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 13 Feb 2026 12:50:02 +0000
Subject: [PATCH 47/90] Woohoo! Huge decrease in cells not cleaned up, with
 fixing one stupid bug.

---
 post-scarcity.cbp              | 157 ---------------------------------
 post-scarcity.cscope_file_list |  58 ------------
 post-scarcity.layout           |  15 ----
 src/arith/integer.c            |   3 +
 src/init.c                     |  40 ++++++++-
 src/io/print.c                 |   8 +-
 src/memory/consspaceobject.c   |   8 --
 src/memory/hashmap.c           |   4 +-
 src/ops/intern.c               |  17 ++--
 src/ops/lispops.c              |  72 ++++++++-------
 src/ops/lispops.h              |   2 +
 src/repl.c                     |   2 -
 12 files changed, 93 insertions(+), 293 deletions(-)
 delete mode 100644 post-scarcity.cbp
 delete mode 100644 post-scarcity.cscope_file_list
 delete mode 100644 post-scarcity.layout

diff --git a/post-scarcity.cbp b/post-scarcity.cbp
deleted file mode 100644
index a1f42e0..0000000
--- a/post-scarcity.cbp
+++ /dev/null
@@ -1,157 +0,0 @@
-
-
-	
-	
-		
-
diff --git a/post-scarcity.cscope_file_list b/post-scarcity.cscope_file_list
deleted file mode 100644
index 6fbf5ec..0000000
--- a/post-scarcity.cscope_file_list
+++ /dev/null
@@ -1,58 +0,0 @@
-"/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"
diff --git a/post-scarcity.layout b/post-scarcity.layout
deleted file mode 100644
index 98bd2b3..0000000
--- a/post-scarcity.layout
+++ /dev/null
@@ -1,15 +0,0 @@
-
-
-	
-	
-	
-		
-			
-		
-	
-	
-		
-			
-		
-	
-
diff --git a/src/arith/integer.c b/src/arith/integer.c
index e9d9b79..821b476 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -272,9 +272,12 @@ struct cons_pointer add_integers( struct cons_pointer a,
     return result;
 }
 
+// TODO: I have really no idea what I was trying to do here, or why it could possibly be a good idea.
 struct cons_pointer base_partial( int depth ) {
     struct cons_pointer result = NIL;
 
+    debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth);
+
     for ( int i = 0; i < depth; i++ ) {
         result = acquire_integer( 0, result );
     }
diff --git a/src/init.c b/src/init.c
index 45b534f..17f8d36 100644
--- a/src/init.c
+++ b/src/init.c
@@ -37,6 +37,34 @@
 #include "io/fopen.h"
 #include "time/psse_time.h"
 
+/**
+ * @brief If `pointer` is an exception, display that exception to stderr, 
+ * decrement that exception, and return NIL; else return the pointer.
+ * 
+ * @param pointer a cons pointer.
+ * @param location_descriptor a description of where the pointer was caught.
+ * @return struct cons_pointer 
+ */
+struct cons_pointer check_exception( struct cons_pointer pointer, char * location_descriptor) {
+    struct cons_pointer result = NIL;
+
+    struct cons_space_object * object = &pointer2cell( pointer);
+
+    if ( exceptionp( pointer)) {
+        fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor);
+        URL_FILE *ustderr = file_to_url_file( stderr );
+        fwide( stderr, 1 );
+        print( ustderr, object->payload.exception.payload );
+        free( ustderr );
+
+        dec_ref( pointer);
+    } else {
+        result = pointer;
+    }
+
+    return result;
+}
+
 
 /**
  * Bind this compiled `executable` function, as a Lisp function, to
@@ -55,7 +83,8 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable )
                                          n ),
                               NIL ) );
 
-    deep_bind( n, make_function( meta, executable ) );
+    check_exception( deep_bind( n, make_function( meta, executable ) ),
+                    "bind_function");
 }
 
 /**
@@ -72,14 +101,17 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable )
                                          n ),
                               NIL ) );
 
-    deep_bind( n, make_special( meta, executable ) );
+    check_exception(deep_bind( n, make_special( meta, executable ) ),
+                    "bind_special");
 }
 
 /**
  * Bind this `value` to this `name` in the `oblist`.
  */
 struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
-    return deep_bind( c_string_to_lisp_symbol( name ), value );
+    return check_exception( 
+        deep_bind( c_string_to_lisp_symbol( name ), value ),
+            "bind_value");
 }
 
 void print_banner(  ) {
@@ -227,7 +259,7 @@ int main( int argc, char *argv[] ) {
     /*
      * the default prompt
      */
-    bind_value( L"*prompt*",
+    prompt_name = bind_value( L"*prompt*",
                 show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
     /*
      * primitive function operations
diff --git a/src/io/print.c b/src/io/print.c
index 8f4b88e..f4aab9f 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -169,9 +169,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
             print( output, cell.payload.function.meta );
             url_fputwc( L'>', output );
             break;
-        case INTEGERTV:{
+        case INTEGERTV:
+            if ( nilp( cell.payload.integer.more)) {
+                url_fwprintf( output, L"%ld", cell.payload.integer.value);
+            } else {
                 struct cons_pointer s = integer_to_string( pointer, 10 );
-                inc_ref( s );
                 print_string_contents( output, s );
                 dec_ref( s );
             }
@@ -186,7 +188,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
                     make_cons( c_string_to_lisp_symbol( L"\u03bb" ),
                                make_cons( cell.payload.lambda.args,
                                           cell.payload.lambda.body ) );
-                inc_ref( to_print );
 
                 print( output, to_print );
 
@@ -203,7 +204,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
                     make_cons( c_string_to_lisp_symbol( L"n\u03bb" ),
                                make_cons( cell.payload.lambda.args,
                                           cell.payload.lambda.body ) );
-                inc_ref( to_print );
 
                 print( output, to_print );
 
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8f9e2a8..81836f8 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -201,7 +201,6 @@ struct cons_pointer make_exception( struct cons_pointer message,
   struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
   struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( message );
   inc_ref( frame_pointer );
   cell->payload.exception.payload = message;
   cell->payload.exception.frame = frame_pointer;
@@ -237,9 +236,6 @@ struct cons_pointer make_lambda( struct cons_pointer args,
   struct cons_pointer pointer = allocate_cell( LAMBDATV );
   struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
-                         this, but if I don't the cell gets freed */
-
   inc_ref( args );
   inc_ref( body );
   cell->payload.lambda.args = args;
@@ -256,9 +252,6 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
                                   struct cons_pointer body ) {
   struct cons_pointer pointer = allocate_cell( NLAMBDATV );
 
-  inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
-                         this, but if I don't the cell gets freed */
-
   struct cons_space_object *cell = &pointer2cell( pointer );
   inc_ref( args );
   inc_ref( body );
@@ -312,7 +305,6 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
     pointer = allocate_cell( tag );
     struct cons_space_object *cell = &pointer2cell( pointer );
 
-    inc_ref( tail );
     cell->payload.string.character = c;
     cell->payload.string.cdr.page = tail.page;
     /* \todo There's a problem here. Sometimes the offsets on
diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c
index f2911e5..15b5550 100644
--- a/src/memory/hashmap.c
+++ b/src/memory/hashmap.c
@@ -87,9 +87,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
                                         &( map->payload ) )->n_buckets;
 
                 map->payload.hashmap.buckets[bucket_no] =
-                    inc_ref( make_cons( make_cons( key, val ),
+                    make_cons( make_cons( key, val ),
                                         map->payload.hashmap.
-                                        buckets[bucket_no] ) );
+                                        buckets[bucket_no] );
             }
         }
     }
diff --git a/src/ops/intern.c b/src/ops/intern.c
index cafc294..3fb38d3 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -292,7 +292,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         //     if ( equal( key, entry.payload.cons.car ) ) {
         //         result = entry.payload.cons.car;
         //     }
-        if (!nilp( c_assoc( store, key))) {
+        if (!nilp( c_assoc( key, store))) {
             result = key;
         }
     } else {
@@ -340,18 +340,23 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                         result = hashmap_get( entry_ptr, key );
                         break;
                     default:
-                        throw_exception( c_string_to_lisp_string
-                                         ( L"Store entry is of unknown type" ),
-                                         NIL );
+                        throw_exception( c_append(
+                            c_string_to_lisp_string( L"Store entry is of unknown type: " ),
+                            c_type( entry_ptr)), NIL);
                 }
             }
         }
     } else if ( hashmapp( store ) ) {
         result = hashmap_get( store, key );
     } else if ( !nilp( store ) ) {
+        debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
+        debug_print_object( c_type( store), DEBUG_BIND );
+        debug_print( L"`\n", DEBUG_BIND );
         result =
-            throw_exception( c_string_to_lisp_string
-                             ( L"Store is of unknown type" ), NIL );
+            throw_exception( 
+                c_append( 
+                    c_string_to_lisp_string( L"Store is of unknown type: " ),
+                    c_type( store)), NIL );
     }
 
     debug_print( L"c_assoc returning ", DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 236a290..2f549e4 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -38,6 +38,13 @@
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
 
+/**
+ * @brief the name of the symbol to which the prompt is bound;
+ * 
+ * Set in init to `*prompt*`
+ */
+struct cons_pointer prompt_name;
+
 /*
  * also to create in this section:
  * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
@@ -46,7 +53,6 @@
  * and others I haven't thought of yet.
  */
 
-
 /**
  * Useful building block; evaluate this single form in the context of this
  * parent stack frame and this environment.
@@ -1263,7 +1269,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
-    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
+//    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
     
@@ -1558,43 +1564,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 
 }
 
-// /**
-//  * Function; print the internal representation of the object indicated by `frame->arg[0]` to the
-//  * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
-//  *
-//  * * (inspect expression)
-//  * * (inspect expression )
-//  *
-//  * @param frame my stack frame.
-//  * @param frame_pointer a pointer to my stack_frame.
-//  * @param env the environment.
-//  * @return the value of the first argument - `expression`.
-//  */
-// struct cons_pointer lisp_inspect( struct stack_frame *frame,
-//                                   struct cons_pointer frame_pointer,
-//                                   struct cons_pointer env ) {
-//     debug_print( L"Entering print\n", DEBUG_IO );
-//     URL_FILE *output;
-//     struct cons_pointer out_stream = writep( frame->arg[1] ) ?
-//         frame->arg[1] : get_default_stream( false, env );
+// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
+//     struct cons_pointer result = b;
 
-//     if ( writep( out_stream ) ) {
-//         debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
-//         debug_dump_object( out_stream, DEBUG_IO );
-//         output = pointer2cell( out_stream ).payload.stream.stream;
-//         inc_ref( out_stream );
+//     if ( nilp( b.tag.value)) {
+//         result = make_cons( a, b);
 //     } else {
-//         output = file_to_url_file( stdout );
+//         if ( ! nilp( a)) {
+//             if (a.tag.value == b.tag.value) {
+
+//                 struct cons_pointer tail = c_concat( c_cdr( a), b);
+
+//                 switch ( a.tag.value) {
+//                     case CONSTV:
+//                         result = make_cons( c_car( a), tail);
+//                         break;
+//                     case KEYTV:
+//                     case STRINGTV:
+//                     case SYMBOLTV:
+//                         result = make_string_like_thing()
+
+//                 }
+
+//             } else {
+//                 // throw an exception
+//             }
+//         }
 //     }
+    
 
-//     dump_object( output, frame->arg[0] );
-//     url_fputws( L"\n", output );
 
-//     if ( writep( out_stream ) ) {
-//         dec_ref( out_stream );
-//     } else {
-//         free( output );
-//     }
-
-//     return frame->arg[0];
-// }
+//     return result;
+// }
\ No newline at end of file
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index da1f27e..ec84d61 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -22,6 +22,8 @@
 #ifndef __psse_lispops_h
 #define __psse_lispops_h
 
+extern struct cons_pointer prompt_name;
+
 /*
  * utilities
  */
diff --git a/src/repl.c b/src/repl.c
index b68fa1c..5295465 100644
--- a/src/repl.c
+++ b/src/repl.c
@@ -41,8 +41,6 @@ void repl(  ) {
     struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
 
     if ( !nilp( frame_pointer ) ) {
-        inc_ref( frame_pointer );
-
         lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
 
         dec_ref( frame_pointer );

From 3659103dd7d6ee5e9f44c7a134fd01b825db99e0 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 13 Feb 2026 13:07:43 +0000
Subject: [PATCH 48/90] Another small fix. Previous fix resulted in 4 more
 tests failing (now 11); this fix does not change that, and the regressions
 must be resolved.

---
 src/memory/consspaceobject.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 81836f8..8a8ed2a 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -306,11 +306,11 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
     struct cons_space_object *cell = &pointer2cell( pointer );
 
     cell->payload.string.character = c;
-    cell->payload.string.cdr.page = tail.page;
+    cell->payload.string.cdr = tail;
     /* \todo There's a problem here. Sometimes the offsets on
      * strings are quite massively off. Fix is probably
      * cell->payload.string.cdr = tail */
-    cell->payload.string.cdr.offset = tail.offset;
+    //cell->payload.string.cdr.offset = tail.offset;
 
     cell->payload.string.hash = calculate_hash( c, tail );
   } else {

From 5e6363e6aeb8840cb64b555c98005ac330755e77 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Feb 2026 11:40:52 +0000
Subject: [PATCH 49/90] Fixed the horrendous 'unbound symbol nil' bug. Also
 work on documentation and unit tests.

---
 src/arith/integer.c          |  31 ++++++----
 src/arith/ratio.c            |  37 +++++++----
 src/debug.c                  |  39 ++++++++----
 src/debug.h                  |  55 +++++++++++++++-
 src/init.c                   | 117 ++++++++++++++++++++++++-----------
 src/io/io.c                  |   8 +--
 src/memory/consspaceobject.c |   6 +-
 src/memory/hashmap.c         |   6 --
 src/ops/intern.c             |  13 +++-
 src/ops/intern.h             |   2 +
 src/ops/lispops.c            |   5 +-
 unit-tests/add.sh            |  45 +++++++++-----
 unit-tests/append.sh         |  28 +++++++--
 unit-tests/apply.sh          |  23 ++++++-
 unit-tests/bignum-add.sh     |  32 +++++-----
 unit-tests/cond.sh           |   8 ++-
 unit-tests/try.sh            |  16 +++--
 17 files changed, 328 insertions(+), 143 deletions(-)

diff --git a/src/arith/integer.c b/src/arith/integer.c
index 821b476..0247d0f 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -55,7 +55,7 @@ struct cons_pointer small_int_cache[SMALL_INT_LIMIT];
   * Low level integer arithmetic, do not use elsewhere.
   *
   * @param c a pointer to a cell, assumed to be an integer cell;
-  * @param op a character representing the operation: expectedto be either
+  * @param op a character representing the operation: expected to be either
   * '+' or '*'; behaviour with other values is undefined.
   * @param is_first_cell true if this is the first cell in a bignum
   * chain, else false.
@@ -128,8 +128,8 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
 struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
     struct cons_pointer result;
 
-    if ( !nilp( more) || value >= SMALL_INT_LIMIT) {
-        debug_print( L"acquire_integer passing to make_integer (too large)\n", DEBUG_ALLOC );
+    if ( !nilp( more) || value < 0 || value >= SMALL_INT_LIMIT) {
+        debug_print( L"acquire_integer passing to make_integer (outside small int range)\n", DEBUG_ALLOC );
         result = make_integer( value, more);
     } else {
         if ( !small_int_cache_initialised) {
@@ -239,7 +239,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
         while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
             __int128_t av = cell_value( a, '+', is_first_cell );
             __int128_t bv = cell_value( b, '+', is_first_cell );
-            __int128_t rv = av + bv + carry;
+            __int128_t rv = (av + bv) + carry;
 
             debug_print( L"add_integers: av = ", DEBUG_ARITH );
             debug_print_128bit( av, DEBUG_ARITH );
@@ -251,17 +251,22 @@ struct cons_pointer add_integers( struct cons_pointer a,
             debug_print_128bit( rv, DEBUG_ARITH );
             debug_print( L"\n", DEBUG_ARITH );
 
-            struct cons_pointer new = make_integer( 0, NIL );
-            carry = int128_to_integer( rv, cursor, new );
-            cursor = new;
+            if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT)) {
+                result = acquire_integer( (int64_t)(rv & 0xffffffff), NIL);
+                break;
+            } else {
+                struct cons_pointer new = make_integer( 0, NIL );
+                carry = int128_to_integer( rv, cursor, new );
+                cursor = new;
 
-            if ( nilp( result ) ) {
-                result = cursor;
+                if ( nilp( result ) ) {
+                    result = cursor;
+                }
+
+                a = pointer2cell( a ).payload.integer.more;
+                b = pointer2cell( b ).payload.integer.more;
+                is_first_cell = false;
             }
-
-            a = pointer2cell( a ).payload.integer.more;
-            b = pointer2cell( b ).payload.integer.more;
-            is_first_cell = false;
         }
     }
 
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index f0095b1..aa8e69f 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -45,16 +45,17 @@ int64_t least_common_multiple( int64_t m, int64_t n ) {
 
 struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
     struct cons_pointer result = pointer;
-    struct cons_space_object cell = pointer2cell( pointer );
-    struct cons_space_object dividend =
-        pointer2cell( cell.payload.ratio.dividend );
-    struct cons_space_object divisor =
-        pointer2cell( cell.payload.ratio.divisor );
 
-    if ( divisor.payload.integer.value == 1 ) {
-        result = pointer2cell( pointer ).payload.ratio.dividend;
-    } else {
-        if ( ratiop( pointer ) ) {
+    if ( ratiop( pointer ) ) {
+        struct cons_space_object cell = pointer2cell( pointer );
+        struct cons_space_object dividend =
+            pointer2cell( cell.payload.ratio.dividend );
+        struct cons_space_object divisor =
+            pointer2cell( cell.payload.ratio.divisor );
+
+        if ( divisor.payload.integer.value == 1 ) {
+            result = pointer2cell( pointer ).payload.ratio.dividend;
+        } else {
             int64_t ddrv = dividend.payload.integer.value,
                 drrv = divisor.payload.integer.value,
                 gcd = greatest_common_divisor( ddrv, drrv );
@@ -63,13 +64,16 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
                 if ( drrv / gcd == 1 ) {
                     result = acquire_integer( ddrv / gcd, NIL );
                 } else {
+                    debug_printf( DEBUG_ARITH, 
+                        L"simplify_ratio: %ld/%ld => %ld/%ld\n", ddrv, drrv, ddrv/gcd, drrv/gcd);
                     result =
                         make_ratio( acquire_integer( ddrv / gcd, NIL ),
                                     acquire_integer( drrv / gcd, NIL ) );
                 }
             }
         }
-    }
+    } 
+    // TODO: else throw exception?
 
     return result;
 
@@ -311,23 +315,30 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
     if ( integerp( dividend ) && integerp( divisor ) ) {
         inc_ref( dividend );
         inc_ref( divisor );
-        result = allocate_cell( RATIOTV );
-        struct cons_space_object *cell = &pointer2cell( result );
+        struct cons_pointer unsimplified = allocate_cell( RATIOTV );
+        struct cons_space_object *cell = &pointer2cell( unsimplified );
         cell->payload.ratio.dividend = dividend;
         cell->payload.ratio.divisor = divisor;
+
+        result = simplify_ratio( unsimplified);
+        if ( !eq( result, unsimplified)) { dec_ref( unsimplified); }
     } else {
         result =
             throw_exception( c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
+    // debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
     debug_dump_object( result, DEBUG_ARITH );
 
     return result;
 }
 
 /**
- * True if a and be are identical ratios, else false.
+ * True if a and be are identical rationals, else false.
+ *
+ * TODO: we need ways of checking whether rationals are equal
+ * to floats and to integers.
  */
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
     bool result = false;
diff --git a/src/debug.c b/src/debug.c
index 233e154..d139f8c 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -1,4 +1,4 @@
-/**
+/*
  * debug.c
  *
  * Better debug log messages.
@@ -25,13 +25,17 @@
 #include "io/print.h"
 
 /**
- * the controlling flags for `debug_print`; set in `init.c`, q.v.
+ * @brief the controlling flags for `debug_print`; set in `init.c`, q.v.
+ *
+ * Interpreted as a set o binary flags. The values are controlled by macros 
+ * with names 'DEBUG_[A_Z]*' in `debug.h`, q.v.
  */
 int verbosity = 0;
 
 /**
- * print this debug `message` to stderr, if `verbosity` matches `level`.
- * `verbosity is a set of flags, see debug_print.h; so you can
+ * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_print( wchar_t *message, int level ) {
@@ -44,6 +48,11 @@ void debug_print( wchar_t *message, int level ) {
 }
 
 /**
+ * @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
+ *
  * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
  */
 void debug_print_128bit( __int128_t n, int level ) {
@@ -68,8 +77,9 @@ void debug_print_128bit( __int128_t n, int level ) {
 }
 
 /**
- * print a line feed to stderr, if `verbosity` matches `level`.
- * `verbosity is a set of flags, see debug_print.h; so you can
+ * @brief print a line feed to stderr, if `verbosity` matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_println( int level ) {
@@ -83,8 +93,10 @@ void debug_println( int level ) {
 
 
 /**
- * `wprintf` adapted for the debug logging system. Print to stderr only
- * `verbosity` matches `level`. All other arguments as for `wprintf`.
+ * @brief `wprintf` adapted for the debug logging system. 
+ *
+ * Print to stderr only if `verbosity` matches `level`. All other arguments
+ * as for `wprintf`.
  */
 void debug_printf( int level, wchar_t *format, ... ) {
 #ifdef DEBUG
@@ -98,8 +110,10 @@ void debug_printf( int level, wchar_t *format, ... ) {
 }
 
 /**
- * print the object indicated by this `pointer` to stderr, if `verbosity`
- * matches `level`.`verbosity is a set of flags, see debug_print.h; so you can
+ * @brief print the object indicated by this `pointer` to stderr, if `verbosity`
+ * matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_print_object( struct cons_pointer pointer, int level ) {
@@ -114,7 +128,10 @@ void debug_print_object( struct cons_pointer pointer, int level ) {
 }
 
 /**
- * Like `dump_object`, q.v., but protected by the verbosity mechanism.
+ * @brief Like `dump_object`, q.v., but protected by the verbosity mechanism.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
  */
 void debug_dump_object( struct cons_pointer pointer, int level ) {
 #ifdef DEBUG
diff --git a/src/debug.h b/src/debug.h
index babbaea..41c1618 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -1,4 +1,4 @@
-/**
+/*
  * debug.h
  *
  * Better debug log messages.
@@ -13,14 +13,67 @@
 #ifndef __debug_print_h
 #define __debug_print_h
 
+/**
+ * @brief Print messages debugging memory allocation. 
+ *
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_ALLOC 1
+
+/**
+ * @brief Print messages debugging arithmetic operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_ARITH 2
+
+/**
+ * @brief Print messages debugging symbol binding.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_BIND 4
+
+/**
+ * @brief Print messages debugging bootstrapping and teardown.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_BOOTSTRAP 8
+
+/**
+ * @brief Print messages debugging evaluation.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_EVAL 16
+
+/**
+ * @brief Print messages debugging input/output operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_IO 32
+
+/**
+ * @brief Print messages debugging lambda functions (interpretation).
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_LAMBDA 64
+
+/**
+ * @brief Print messages debugging the read eval print loop.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_REPL 128
+
+/**
+ * @brief Print messages debugging stack operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_STACK 256
 
 extern int verbosity;
diff --git a/src/init.c b/src/init.c
index 17f8d36..7c4bdc3 100644
--- a/src/init.c
+++ b/src/init.c
@@ -65,6 +65,25 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
     return result;
 }
 
+struct cons_pointer init_name_symbol = NIL;
+struct cons_pointer init_primitive_symbol = NIL;
+
+void maybe_bind_init_symbols() {
+    if ( nilp( init_name_symbol)) {
+        init_name_symbol = c_string_to_lisp_keyword( L"name" );
+    }
+    if ( nilp( init_primitive_symbol)) {
+        init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
+    }
+    if ( nilp( privileged_symbol_nil)) {
+        privileged_symbol_nil = c_string_to_lisp_symbol( L"nil");
+    }
+}
+
+void free_init_symbols() {
+    dec_ref( init_name_symbol);
+    dec_ref( init_primitive_symbol);
+}
 
 /**
  * Bind this compiled `executable` function, as a Lisp function, to
@@ -73,45 +92,75 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
  * the name on the source pointer. Would make stack frames potentially
  * more readable and aid debugging generally.
  */
-void bind_function( wchar_t *name, struct cons_pointer ( *executable )
+struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executable )
                      ( struct stack_frame *,
                        struct cons_pointer, struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
     struct cons_pointer meta =
-        make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
-                   make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
-                                         n ),
+        make_cons( make_cons( init_primitive_symbol, TRUE ),
+                   make_cons( make_cons( init_name_symbol, n ),
                               NIL ) );
 
-    check_exception( deep_bind( n, make_function( meta, executable ) ),
+    struct cons_pointer r = check_exception( 
+        deep_bind( n, make_function( meta, executable ) ),
                     "bind_function");
+    
+    dec_ref( n);
+
+    return r;
 }
 
 /**
  * Bind this compiled `executable` function, as a Lisp special form, to
  * this `name` in the `oblist`.
  */
-void bind_special( wchar_t *name, struct cons_pointer ( *executable )
+struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executable )
                     ( struct stack_frame *,
                       struct cons_pointer, struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
-    struct cons_pointer meta =
-        make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
-                   make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
-                                         n ),
-                              NIL ) );
 
-    check_exception(deep_bind( n, make_special( meta, executable ) ),
+    struct cons_pointer meta =
+        make_cons( make_cons( init_primitive_symbol, TRUE ),
+                   make_cons( make_cons( init_name_symbol, n), NIL ) );
+
+    struct cons_pointer r = 
+        check_exception(deep_bind( n, make_special( meta, executable ) ),
                     "bind_special");
+    
+    dec_ref( n);
+
+    return r;
+}
+
+/**
+ * Bind this `value` to this `symbol` in the `oblist`.
+ */
+struct cons_pointer 
+bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool lock) {
+    struct cons_pointer r = check_exception( 
+        deep_bind( symbol, value ),
+            "bind_symbol_value");
+
+    if ( lock && !exceptionp( r)){
+        struct cons_space_object * cell = & pointer2cell( r);
+
+        cell->count = UINT32_MAX;
+    }
+
+    return r;
 }
 
 /**
  * Bind this `value` to this `name` in the `oblist`.
  */
-struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
-    return check_exception( 
-        deep_bind( c_string_to_lisp_symbol( name ), value ),
-            "bind_value");
+struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value, bool lock ) {
+    struct cons_pointer p = c_string_to_lisp_symbol( name );
+
+    struct cons_pointer r = bind_symbol_value( p, value, lock);
+
+    dec_ref( p);
+
+    return r;
 }
 
 void print_banner(  ) {
@@ -187,21 +236,15 @@ int main( int argc, char *argv[] ) {
         }
     }
 
+    initialise_cons_pages();
+
+    maybe_bind_init_symbols();
+
+
     if ( show_prompt ) {
         print_banner(  );
     }
 
-    initialise_cons_pages(  );
-
-//     TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
-//     What actually goes wrong is: 
-//     1. the hashmap is created; 
-//     2. everything bound in init seems to get initialised properly;
-//     3. the REPL starts up;
-//     4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
-//     5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
-//     Hypothesis: binding stuff into a hashmap oblist either isn't happening or 
-//      is wrking ok, but retrieving from a hashmap oblist is failing.
     debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
 
     oblist = make_hashmap( 32, NIL, TRUE );
@@ -211,8 +254,8 @@ int main( int argc, char *argv[] ) {
     /*
      * privileged variables (keywords)
      */
-    bind_value( L"nil", NIL );
-    bind_value( L"t", TRUE );
+    bind_symbol_value( privileged_symbol_nil, NIL, true);
+    bind_value( L"t", TRUE, true );
 
     /*
      * standard input, output, error and sink streams
@@ -233,7 +276,7 @@ int main( int argc, char *argv[] ) {
                                                 ( L"url" ),
                                                 c_string_to_lisp_string
                                                 ( L"system:standard input" ) ),
-                                                NIL ) ) );
+                                                NIL ) ), false );
     lisp_io_out = bind_value( C_IO_OUT,
                 make_write_stream( file_to_url_file( stdout ),
                                    make_cons( make_cons
@@ -241,26 +284,26 @@ int main( int argc, char *argv[] ) {
                                                 ( L"url" ),
                                                 c_string_to_lisp_string
                                                 ( L"system:standard output]" ) ),
-                                              NIL ) ) );
+                                              NIL ) ), false);
     bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
                                              make_cons( make_cons
                                                         ( c_string_to_lisp_keyword
                                                           ( L"url" ),
                                                           c_string_to_lisp_string
                                                           ( L"system:standard log" ) ),
-                                                        NIL ) ) );
+                                                        NIL ) ), false );
     bind_value( L"*sink*", make_write_stream( sink,
                                               make_cons( make_cons
                                                          ( c_string_to_lisp_keyword
                                                            ( L"url" ),
                                                            c_string_to_lisp_string
                                                            ( L"system:standard sink" ) ),
-                                                         NIL ) ) );
+                                                         NIL ) ), false );
     /*
      * the default prompt
      */
     prompt_name = bind_value( L"*prompt*",
-                show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
+                show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
     /*
      * primitive function operations
      */
@@ -327,13 +370,15 @@ int main( int argc, char *argv[] ) {
 
     repl( show_prompt );
 
-    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
-    dec_ref( oblist );
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
     if ( dump_at_end ) {
         dump_pages( file_to_url_file( stdout ) );
     }
 
+    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
+    dec_ref( oblist );
+    free_init_symbols();
+
     summarise_allocation(  );
     curl_global_cleanup(  );
     return ( 0 );
diff --git a/src/io/io.c b/src/io/io.c
index 2db9492..66c51c2 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -413,12 +413,8 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
     struct cons_pointer stream_name =
          inputp ? lisp_io_in : lisp_io_out;
 
-    inc_ref( stream_name );
-
     result = c_assoc( stream_name, env );
 
-    dec_ref( stream_name );
-
     return result;
 }
 
@@ -430,7 +426,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
  * to append, or error if the URL is faulty or indicates an unavailable
  * resource.
  *
- * * (read-char stream)
+ * * (open url)
  *
  * @param frame my stack_frame.
  * @param frame_pointer a pointer to my stack_frame.
@@ -524,6 +520,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * Function: return a string representing all characters from the stream
  * indicated by arg 0; further arguments are ignored.
  *
+ * TODO: it should be possible to optionally pass a string URL to this function,
+ *
  * * (slurp stream)
  *
  * @param frame my stack_frame.
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8a8ed2a..5a234da 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -80,7 +80,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
 struct cons_pointer dec_ref( struct cons_pointer pointer ) {
   struct cons_space_object *cell = &pointer2cell( pointer );
 
-  if ( cell->count > 0 ) {
+  if ( cell->count > 0 && cell->count != UINT32_MAX) {
     cell->count--;
 
     if ( cell->count == 0 ) {
@@ -307,10 +307,6 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
 
     cell->payload.string.character = c;
     cell->payload.string.cdr = tail;
-    /* \todo There's a problem here. Sometimes the offsets on
-     * strings are quite massively off. Fix is probably
-     * cell->payload.string.cdr = tail */
-    //cell->payload.string.cdr.offset = tail.offset;
 
     cell->payload.string.hash = calculate_hash( c, tail );
   } else {
diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c
index 15b5550..d268bd9 100644
--- a/src/memory/hashmap.c
+++ b/src/memory/hashmap.c
@@ -94,9 +94,6 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
         }
     }
 
-    // TODO: I am not sure this is right! We do not inc_ref a string when
-    // we make it.
-    inc_ref(result);
     return result;
 }
 
@@ -118,9 +115,6 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
 
     struct cons_pointer result = hashmap_put( mapp, key, val );
     struct cons_space_object *cell = &pointer2cell( result);
-    // if (cell->count <= 1) {
-    //     inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place! 
-    // }
     return result;
 
     // TODO: else clone and return clone.
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 3fb38d3..d2be616 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -36,7 +36,7 @@
 // #include "print.h"
 
 /**
- * The global object list/or, to put it differently, the root namespace.
+ * @brief The global object list/or, to put it differently, the root namespace.
  * What is added to this during system setup is 'global', that is,
  * visible to all sessions/threads. What is added during a session/thread is local to
  * that session/thread (because shallow binding). There must be some way for a user to
@@ -47,6 +47,12 @@
  */
 struct cons_pointer oblist = NIL;
 
+/**
+ * @brief the symbol `NIL`, which is special!
+ * 
+ */
+struct cons_pointer privileged_symbol_nil = NIL;
+
 /**
  * Return a hash value for the structure indicated by `ptr` such that if
  * `x`,`y` are two separate structures whose print representation is the same
@@ -163,7 +169,6 @@ struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
                   !nilp( c ); c = c_cdr( c ) ) {
                 result = make_cons( c_car( c_car( c ) ), result );
             }
-
         }
     }
 
@@ -260,6 +265,8 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
     return result;
 }
 
+// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
+
 /**
  * Implementation of interned? in C. The final implementation if interned? will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -294,6 +301,8 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         //     }
         if (!nilp( c_assoc( key, store))) {
             result = key;
+        } else if ( equal( key, privileged_symbol_nil)) {
+            result = privileged_symbol_nil;
         }
     } else {
         debug_print( L"`", DEBUG_BIND );
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 6be9cbc..abc6f91 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -20,6 +20,8 @@
 #ifndef __intern_h
 #define __intern_h
 
+extern struct cons_pointer privileged_symbol_nil;
+
 extern struct cons_pointer oblist;
 
 uint32_t get_hash( struct cons_pointer ptr );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 2f549e4..c0765cd 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1273,8 +1273,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
     
-    inc_ref( env );
-
     if (truep(frame->arg[0])) {
         new_env = set( prompt_name, frame->arg[0], new_env);
     }
@@ -1338,7 +1336,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 
         expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
                           new_env );
-        inc_ref( expr );
 
         if ( exceptionp( expr )
              && url_feof( pointer2cell( input ).payload.stream.stream ) ) {
@@ -1356,7 +1353,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
-    dec_ref( env );
+    dec_ref( new_env);
 
     debug_printf(DEBUG_REPL, L"Leaving inner repl\n");
     
diff --git a/unit-tests/add.sh b/unit-tests/add.sh
index 2802c3a..ca6f2a8 100755
--- a/unit-tests/add.sh
+++ b/unit-tests/add.sh
@@ -1,79 +1,92 @@
 #!/bin/bash
 
+result=0;
+
+echo -n "$0: Add two small integers... "
+
 expected='5'
-actual=`echo "(add 2 3)" | target/psse | tail -1`
+actual=`echo "(add 2 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add float to integer... "
+
 expected='5.5'
-actual=`echo "(add 2.5 3)" | target/psse | tail -1`
+actual=`echo "(add 2.5 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add two rationals... "
+
 expected='1/4'
-actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
+actual=`echo "(+ 3/14 1/28)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add an integer to a rational... "
+
 # (+ integer ratio) should be ratio
 expected='25/4'
-actual=`echo "(+ 6 1/4)" | target/psse | tail -1`
+actual=`echo "(+ 6 1/4)" | target/psse  2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add a rational to an integer... "
+
 # (+ ratio integer) should be ratio
 expected='25/4'
-actual=`echo "(+ 1/4 6)" | target/psse | tail -1`
+actual=`echo "(+ 1/4 6)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add a real to a rational... "
+
 # (+ real ratio) should be real
 # for this test, trailing zeros can be ignored
 expected='6.25'
 actual=`echo "(+ 6.000000001 1/4)" |\
   target/psse 2> /dev/null |\
-  sed 's/0*$//' |\
-  head -2 |\
-  tail -1`
+  sed -r '/^\s*$/d' |\
+  sed 's/0*$//' 
 
 outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
 
-if [ "${outcome}" = "1" ]
+if [ "${outcome}" -eq "1" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc `
 fi
 
+exit ${result}
diff --git a/unit-tests/append.sh b/unit-tests/append.sh
index 0f6fb30..972aa04 100755
--- a/unit-tests/append.sh
+++ b/unit-tests/append.sh
@@ -1,24 +1,44 @@
 #!/bin/bash
 
+return=0;
+
+echo -n "$0: Append two lists... "
+
 expected='(a b c d e f)'
-actual=`echo "(append '(a b c) '(d e f))" | target/psse | tail -1`
+actual=`echo "(append '(a b c) '(d e f))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: Append two strings... "
+
 expected='"hellodere"'
-actual=`echo '(append "hello" "dere")' | target/psse | tail -1`
+actual=`echo '(append "hello" "dere")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: Append keyword to string should error... "
+
+expected='Exception:'
+actual=`echo '(append "hello" :dere)' | target/psse 2>/dev/null | sed -r '/^\s*$/d' | awk '{print $1}'`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    return=`echo "${return} + 1" | bc`
+fi
+
+exit ${return}
\ No newline at end of file
diff --git a/unit-tests/apply.sh b/unit-tests/apply.sh
index 811fdae..63b76a3 100755
--- a/unit-tests/apply.sh
+++ b/unit-tests/apply.sh
@@ -1,13 +1,30 @@
 #!/bin/bash
 
+result=1
+
+echo -n "$0: Apply function to one argument... "
 expected='1'
-actual=`echo "(apply 'add '(1))"| target/psse | tail -1`
+actual=`echo "(apply 'add '(1))"| target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
+
+echo -n "$0: Apply function to multiple arguments... "
+expected='3'
+actual=`echo "(apply 'add '(1 2))"| target/psse 2>/dev/null | tail -1`
+
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}
diff --git a/unit-tests/bignum-add.sh b/unit-tests/bignum-add.sh
index 293e1e5..c82dee6 100755
--- a/unit-tests/bignum-add.sh
+++ b/unit-tests/bignum-add.sh
@@ -20,7 +20,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "checking no bignum was created: "
@@ -30,7 +30,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -52,7 +52,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
@@ -62,7 +62,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -85,7 +85,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
@@ -95,7 +95,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -118,7 +118,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "checking a bignum was created: "
@@ -128,7 +128,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -150,7 +150,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -171,7 +171,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -195,7 +195,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
@@ -205,7 +205,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -228,7 +228,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
@@ -238,7 +238,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -262,7 +262,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
@@ -272,7 +272,7 @@ then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 exit ${return}
\ No newline at end of file
diff --git a/unit-tests/cond.sh b/unit-tests/cond.sh
index 69952c9..4c4a66c 100755
--- a/unit-tests/cond.sh
+++ b/unit-tests/cond.sh
@@ -2,8 +2,10 @@
 
 result=0
 
+echo -n "$0: cond with one clause... "
+
 expected='5'
-actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1`
+actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -13,8 +15,10 @@ else
   result=1
 fi
 
+echo -n "$0: cond with two clauses... "
+
 expected='"should"'
-actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1`
+actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/try.sh b/unit-tests/try.sh
index a6d529c..c70c4d8 100755
--- a/unit-tests/try.sh
+++ b/unit-tests/try.sh
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+result=0
+
 expected=':foo'
 actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1`
 
@@ -8,7 +10,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
 expected='4'
@@ -19,7 +21,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
 expected='8'
@@ -30,16 +32,18 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
-expected=''
-actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1`
+expected='Exception: "Cannot divide: not a number"'
+actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | grep Exception`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
+
+exit ${result}

From 222368bf640a0b79d57322878dee42ed58b47bd6 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Feb 2026 14:04:41 +0000
Subject: [PATCH 50/90] Stage one clean up of test files. Some unit tests are
 still creating temporary files in the project root directory, which is still
 to be fixed; and *I think* known-failing tests which I don't intend to fix
 immediately should be marked in some way.

---
 Makefile                         |  4 ++-
 src/arith/integer.c              |  8 +++++-
 src/io/print.c                   | 10 ++-----
 unit-tests/apply.sh              |  1 -
 unit-tests/bignum-add.sh         | 36 ++++++++++++------------
 unit-tests/bignum-subtract.sh    | 18 ++++++------
 unit-tests/complex-list.sh       |  2 +-
 unit-tests/cond.sh               |  4 +--
 unit-tests/let.sh                | 10 ++++---
 unit-tests/list-test,sh          | 42 ----------------------------
 unit-tests/list-test.sh          | 47 ++++++++++++++++++++++++++++++++
 unit-tests/many-args.sh          | 16 ++++++-----
 unit-tests/map.sh                | 23 ++++++++--------
 unit-tests/multiply.sh           | 12 +++++---
 unit-tests/nil.sh                |  2 +-
 unit-tests/path-notation.sh      | 11 ++++----
 unit-tests/progn.sh              | 10 ++++---
 unit-tests/quote.sh              |  2 +-
 unit-tests/quoted-list.sh        |  2 +-
 unit-tests/ratio-addition.sh     |  2 +-
 unit-tests/reverse.sh            | 17 +++++++-----
 unit-tests/simple-list.sh        |  2 +-
 unit-tests/slurp.sh              |  4 +--
 unit-tests/string-cons.sh        | 12 ++++----
 unit-tests/string-with-spaces.sh |  2 +-
 unit-tests/try.sh                | 13 ++++++---
 unit-tests/varargs.sh            |  2 +-
 unit-tests/wide-character.sh     |  2 +-
 28 files changed, 172 insertions(+), 144 deletions(-)
 delete mode 100644 unit-tests/list-test,sh
 create mode 100644 unit-tests/list-test.sh

diff --git a/Makefile b/Makefile
index b4f9d3c..85c8b8f 100644
--- a/Makefile
+++ b/Makefile
@@ -11,6 +11,8 @@ TESTS := $(shell find unit-tests -name *.sh)
 INC_DIRS := $(shell find $(SRC_DIRS) -type d)
 INC_FLAGS := $(addprefix -I,$(INC_DIRS))
 
+TMP_DIR ?= ./tmp
+
 INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
 -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
 -npsl -nsc -nsob -nss -nut -prs -l79 -ts2
@@ -41,7 +43,7 @@ test: $(TESTS) Makefile $(TARGET)
 
 .PHONY: clean
 clean:
-	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core
+	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
 
 repl:
 	$(TARGET) -p 2> psse.log
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 0247d0f..0e7cd6f 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -412,10 +412,16 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
 struct cons_pointer integer_to_string_add_digit( int digit, int digits,
                                                  struct cons_pointer tail ) {
     wint_t character = btowc( hex_digits[digit] );
-    return ( digits % 3 == 0 ) ?
+    debug_printf( DEBUG_IO, L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ", digit, digits);
+    struct cons_pointer r = ( digits % 3 == 0 ) ?
         make_string( L',', make_string( character,
                                         tail ) ) :
         make_string( character, tail );
+
+    debug_print_object( r, DEBUG_IO);
+    debug_println( DEBUG_IO);
+
+    return r;
 }
 
 /**
diff --git a/src/io/print.c b/src/io/print.c
index f4aab9f..deea087 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -170,13 +170,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
             url_fputwc( L'>', output );
             break;
         case INTEGERTV:
-            if ( nilp( cell.payload.integer.more)) {
-                url_fwprintf( output, L"%ld", cell.payload.integer.value);
-            } else {
-                struct cons_pointer s = integer_to_string( pointer, 10 );
-                print_string_contents( output, s );
-                dec_ref( s );
-            }
+            struct cons_pointer s = integer_to_string( pointer, 10 );
+            print_string_contents( output, s );
+            dec_ref( s );
             break;
         case KEYTV:
             url_fputws( L":", output );
diff --git a/unit-tests/apply.sh b/unit-tests/apply.sh
index 63b76a3..aa8171a 100755
--- a/unit-tests/apply.sh
+++ b/unit-tests/apply.sh
@@ -18,7 +18,6 @@ echo -n "$0: Apply function to multiple arguments... "
 expected='3'
 actual=`echo "(apply 'add '(1 2))"| target/psse 2>/dev/null | tail -1`
 
-
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
diff --git a/unit-tests/bignum-add.sh b/unit-tests/bignum-add.sh
index c82dee6..aa0aef4 100755
--- a/unit-tests/bignum-add.sh
+++ b/unit-tests/bignum-add.sh
@@ -9,7 +9,7 @@ a=1152921504606846975
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1`
@@ -23,8 +23,8 @@ else
     return=`echo "${return} + 1" | bc`
 fi
 
-echo -n "checking no bignum was created: "
-grep -v 'BIGNUM!' psse.log > /dev/null
+echo -n "$0: checking no bignum was created: "
+grep -v 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -40,7 +40,7 @@ a='1152921504606846976'
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -56,7 +56,7 @@ else
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -73,7 +73,7 @@ a='1152921504606846977'
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -89,7 +89,7 @@ else
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -106,7 +106,7 @@ a=1
 b=1152921504606846977
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -121,8 +121,8 @@ else
     return=`echo "${return} + 1" | bc`
 fi
 
-echo -n "checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+echo -n "$0 => checking a bignum was created: "
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -139,7 +139,7 @@ a=1152921504606846977
 c=`echo "$a + $a" | bc`
 echo -n "$0 => adding $a to $a: "
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -160,7 +160,7 @@ a=1152921504606846977
 c=`echo "$a * 5" | bc`
 echo -n "$0 => adding $a, $a $a, $a, $a: "
 expected='t'
-output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -183,7 +183,7 @@ a=10000000000000000000
 b=10000000000000000000
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -199,7 +199,7 @@ else
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -216,7 +216,7 @@ a=1
 b=1329227995784915872903807060280344576
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -232,7 +232,7 @@ else
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
@@ -250,7 +250,7 @@ a=1
 b=3064991081731777716716694054300618367237478244367204352
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -266,7 +266,7 @@ else
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
diff --git a/unit-tests/bignum-subtract.sh b/unit-tests/bignum-subtract.sh
index 19c673f..814d901 100755
--- a/unit-tests/bignum-subtract.sh
+++ b/unit-tests/bignum-subtract.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-return=0
+result=0
 
 #####################################################################
 # subtract a smallnum from a smallnum to produce a smallnum
@@ -20,17 +20,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-echo -n "checking no bignum was created: "
+echo -n "$0 => checking no bignum was created: "
 grep -v 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -51,7 +51,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -71,7 +71,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 
@@ -93,7 +93,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -113,7 +113,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-exit ${return}
\ No newline at end of file
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/complex-list.sh b/unit-tests/complex-list.sh
index 3e84d79..6a6307b 100755
--- a/unit-tests/complex-list.sh
+++ b/unit-tests/complex-list.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(1 2 3 ("Fred") nil 77,354)'
-actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1`
+actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/cond.sh b/unit-tests/cond.sh
index 4c4a66c..86f0e9f 100755
--- a/unit-tests/cond.sh
+++ b/unit-tests/cond.sh
@@ -12,7 +12,7 @@ then
   echo "OK"
 else
   echo "Fail: expected '${expected}', got '${actual}'"
-  result=1
+  result=`echo "${result} + 1" | bc`
 fi
 
 echo -n "$0: cond with two clauses... "
@@ -25,7 +25,7 @@ then
     echo "OK"
  else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
\ No newline at end of file
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index a4ab77f..037a96a 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -2,26 +2,28 @@
 
 result=0
 
+echo -n "$0: let with two bindings, one form in body..."
 expected='11'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: let with two bindings, two forms in body..."
 expected='1'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
\ No newline at end of file
diff --git a/unit-tests/list-test,sh b/unit-tests/list-test,sh
deleted file mode 100644
index 12fdd60..0000000
--- a/unit-tests/list-test,sh
+++ /dev/null
@@ -1,42 +0,0 @@
-#!/bin/bash
-
-result=0
-
-expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
-
-actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-expected="(0 1 2 3 4)"
-
-actual=`echo "(list 0 1 2 3 4)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-expected="(0 1 2 3 4 5 6 7)"
-
-actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-    exit 0
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-exit ${result}
\ No newline at end of file
diff --git a/unit-tests/list-test.sh b/unit-tests/list-test.sh
new file mode 100644
index 0000000..ef94631
--- /dev/null
+++ b/unit-tests/list-test.sh
@@ -0,0 +1,47 @@
+#!/bin/bash
+
+result=0
+
+echo -n "$0: flat list with 16 elements... "
+expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
+
+actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" |\
+    target/psse 2>/dev/null |\
+    tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: flat list with 5 elements... "
+expected="(0 1 2 3 4)"
+
+actual=`echo "(list 0 1 2 3 4)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: flat list with 8 elements... "
+expected="(0 1 2 3 4 5 6 7)"
+
+actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}
\ No newline at end of file
diff --git a/unit-tests/many-args.sh b/unit-tests/many-args.sh
index 449f7d8..bbbb6e8 100755
--- a/unit-tests/many-args.sh
+++ b/unit-tests/many-args.sh
@@ -1,28 +1,30 @@
 #!/bin/bash
 
-result=1
+result=0
+
+echo -n "$0: plus with fifteen arguments... "
 
 expected="120"
-actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
+actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-# check that all the args are actually being evaluated...
+echo -n "$0: check that all the args are actually being evaluated... "
 expected="120"
-actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse | tail -1`
+actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-return ${result}
+exit ${result}
diff --git a/unit-tests/map.sh b/unit-tests/map.sh
index 90857ef..0e698f0 100755
--- a/unit-tests/map.sh
+++ b/unit-tests/map.sh
@@ -5,9 +5,9 @@ result=0
 #####################################################################
 # Create an empty map using map notation
 expected='{}'
-actual=`echo "$expected" | target/psse | tail -1`
+actual=`echo "$expected" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Empty map using compact map notation: "
+echo -n "$0: Empty map using compact map notation... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -19,7 +19,7 @@ fi
 #####################################################################
 # Create an empty map using make-map
 expected='{}'
-actual=`echo "(hashmap)" | target/psse | tail -1`
+actual=`echo "(hashmap)" | target/psse 2>/dev/null | tail -1`
 
 echo -n "Empty map using (make-map): "
 if [ "${expected}" = "${actual}" ]
@@ -35,9 +35,9 @@ fi
 # significant at this stage, but in the long term should be sorted
 # alphanumerically
 expected='{:one 1, :two 2, :three 3}'
-actual=`echo "{:one 1 :two 2 :three 3}" | target/psse | tail -1`
+actual=`echo "{:one 1 :two 2 :three 3}" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Map using map notation: "
+echo -n "$0: Map using map notation... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -51,9 +51,10 @@ fi
 # significant at this stage, but in the long term should be sorted
 # alphanumerically
 expected='{:one 1, :two 2, :three 3}'
-actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1`
+actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" |\
+    target/psse 2>/dev/null | tail -1`
 
-echo -n "Map using (hashmap): "
+echo -n "$0: Map using (hashmap) with arguments... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -65,9 +66,9 @@ fi
 #####################################################################
 # Keyword in function position
 expected='2'
-actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse | tail -1`
+actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Keyword in function position: "
+echo -n "$0: Keyword in function position... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -80,9 +81,9 @@ fi
 #####################################################################
 # Map in function position
 expected='2'
-actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse | tail -1`
+actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Map in function position: "
+echo -n "$0: Map in function position... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
diff --git a/unit-tests/multiply.sh b/unit-tests/multiply.sh
index aeac7e8..1e2da1f 100755
--- a/unit-tests/multiply.sh
+++ b/unit-tests/multiply.sh
@@ -2,26 +2,30 @@
 
 result=0
 
+echo -n "$0: multiply two integers... "
+
 expected='6'
-actual=`echo "(multiply 2 3)" | target/psse | tail -1`
+actual=`echo "(multiply 2 3)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: multiply a real by an integer... "
+
 expected='7.5'
-actual=`echo "(multiply 2.5 3)" | target/psse | tail -1`
+actual=`echo "(multiply 2.5 3)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
\ No newline at end of file
diff --git a/unit-tests/nil.sh b/unit-tests/nil.sh
index fcbf530..c15f0b1 100755
--- a/unit-tests/nil.sh
+++ b/unit-tests/nil.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected=nil
-actual=`echo 'nil' | target/psse | tail -1`
+actual=`echo 'nil' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/path-notation.sh b/unit-tests/path-notation.sh
index 70610b0..cbb9dea 100755
--- a/unit-tests/path-notation.sh
+++ b/unit-tests/path-notation.sh
@@ -4,8 +4,9 @@ result=0
 
 #####################################################################
 # Create a path from root using compact path notation
+echo -n "$0: Create a path from root using compact path notation... "
 expected='(-> oblist :users :simon :functions (quote assoc))'
-actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1`
+actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
 
 echo -n "Path from root (oblist) using compact notation: "
 if [ "${expected}" = "${actual}" ]
@@ -13,21 +14,21 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
 # Create a path from the current session using compact path notation
+echo -n "$0: Create a path from the current session using compact path notation... "
 expected='(-> session :input-stream)'
-actual=`echo "'$:input-stream" | target/psse | tail -1`
+actual=`echo "'$:input-stream" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Path from current session using compact notation: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
index b9b44eb..ea6cf7b 100755
--- a/unit-tests/progn.sh
+++ b/unit-tests/progn.sh
@@ -2,26 +2,28 @@
 
 result=0
 
+echo -n "$0: progn with one form... "
 expected='5'
-actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
+actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: progn with two forms... "
 expected='"foo"'
-actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
+actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
diff --git a/unit-tests/quote.sh b/unit-tests/quote.sh
index 78d4ce5..d98e215 100755
--- a/unit-tests/quote.sh
+++ b/unit-tests/quote.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='Fred'
-actual=`echo "'Fred" | target/psse | tail -1`
+actual=`echo "'Fred" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/quoted-list.sh b/unit-tests/quoted-list.sh
index f69cd75..ade7b2a 100755
--- a/unit-tests/quoted-list.sh
+++ b/unit-tests/quoted-list.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(123 (4 (5 nil)) Fred)'
-actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1`
+actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/ratio-addition.sh b/unit-tests/ratio-addition.sh
index ba93c5d..5e5bc7e 100755
--- a/unit-tests/ratio-addition.sh
+++ b/unit-tests/ratio-addition.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='1/4'
-actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
+actual=`echo "(+ 3/14 1/28)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/reverse.sh b/unit-tests/reverse.sh
index bbc3216..a0eb01c 100755
--- a/unit-tests/reverse.sh
+++ b/unit-tests/reverse.sh
@@ -2,30 +2,33 @@
 
 result=0
 
+echo -n "$0: reverse a string... "
 expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
-actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1`
+actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: reverse a list... "
 expected='(1,024 512 256 128 64 32 16 8 4 2)'
-actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse | tail -1`
+actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: reverse a symbol... "
 expected='esrever'
-actual=`echo "(reverse 'reverse)" | target/psse | tail -1`
+actual=`echo "(reverse 'reverse)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -33,8 +36,8 @@ then
     exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-echo ${result}
+exit ${result}
 
diff --git a/unit-tests/simple-list.sh b/unit-tests/simple-list.sh
index daf3db2..6fb7e5d 100755
--- a/unit-tests/simple-list.sh
+++ b/unit-tests/simple-list.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="(1 2 3)"
-actual=`echo "'(1 2 3)" | target/psse | tail -1`
+actual=`echo "'(1 2 3)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/slurp.sh b/unit-tests/slurp.sh
index 700df15..1b0b888 100755
--- a/unit-tests/slurp.sh
+++ b/unit-tests/slurp.sh
@@ -1,9 +1,9 @@
 #!/bin/bash
 
-tmp=hi.$$
+tmp=tmp/hi.$$
 echo "Hello, there." > ${tmp}
 expected='"Hello, there.'
-actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`
+actual=`echo "(slurp (open \"${tmp}\"))" | target/psse 2>&1 | tail -2 | head -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/string-cons.sh b/unit-tests/string-cons.sh
index ad6e3d2..918dbc6 100755
--- a/unit-tests/string-cons.sh
+++ b/unit-tests/string-cons.sh
@@ -2,28 +2,28 @@
 
 result=0
 
-# We should be able to cons a single character string onto the front of a string
+echo -n "$0: We should be able to cons a single character string onto the front of a string... "
 expected='"Test"'
-actual=`echo '(cons "T" "est")' | target/psse | tail -1`
+actual=`echo '(cons "T" "est")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-# But if the first argument has more than one character, we should get a dotted pair
+echo -n "$0: But if the first argument has more than one character, we should get a dotted pair... "
 expected='("Test" . "pass")'
-actual=`echo '(cons "Test" "pass")' | target/psse | tail -1`
+actual=`echo '(cons "Test" "pass")' | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}
diff --git a/unit-tests/string-with-spaces.sh b/unit-tests/string-with-spaces.sh
index 0f0f6d0..6a424fb 100755
--- a/unit-tests/string-with-spaces.sh
+++ b/unit-tests/string-with-spaces.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"Strings should be able to include spaces (and other stuff)!"'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/try.sh b/unit-tests/try.sh
index c70c4d8..43e35ad 100755
--- a/unit-tests/try.sh
+++ b/unit-tests/try.sh
@@ -2,8 +2,9 @@
 
 result=0
 
+echo -n "$0: if the body of a try errors, the last form in the catch block is returned... "
 expected=':foo'
-actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1`
+actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -13,8 +14,10 @@ else
     return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: if the body of a try errors, the last form in the catch block is evaluated... "
+
 expected='4'
-actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse | tail -1`
+actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -24,8 +27,9 @@ else
     return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: body and catch block can optionally be marked with keywords... "
 expected='8'
-actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse | tail -1`
+actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -35,8 +39,9 @@ else
     return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: the exception is bound to the symbol \`*exception*\` in the catch environment... "
 expected='Exception: "Cannot divide: not a number"'
-actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | grep Exception`
+actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse 2>&1 | grep Exception`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/varargs.sh b/unit-tests/varargs.sh
index 27bac3e..45ff627 100755
--- a/unit-tests/varargs.sh
+++ b/unit-tests/varargs.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(1 2 3 4 5 6 7 8 9 10)'
-actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" |target/psse | tail -1`
+actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/wide-character.sh b/unit-tests/wide-character.sh
index d56544e..57dced6 100755
--- a/unit-tests/wide-character.sh
+++ b/unit-tests/wide-character.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"λάμ(β)δα"'
-actual=`echo $expected | target/psse | tail -1`
+actual=`echo $expected | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

From 08a7c4153cf54d4054fa1ea8a4e970a131c684c4 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Feb 2026 15:32:59 +0000
Subject: [PATCH 51/90] Reformatted code; made paths in generated documentation
 relative.

---
 Doxyfile                     |   2 +-
 docs/Home.md                 |   4 +
 src/arith/integer.c          |  97 +++++----
 src/arith/integer.h          |   2 +-
 src/arith/ratio.c            |  28 ++-
 src/init.c                   | 159 ++++++++-------
 src/io/fopen.c               |  14 +-
 src/io/history.c             |   2 +-
 src/io/history.h             |   2 +-
 src/io/io.c                  |  15 +-
 src/io/print.c               |  18 +-
 src/io/read.c                |  33 +--
 src/memory/conspage.c        |  12 +-
 src/memory/consspaceobject.c | 384 ++++++++++++++++++-----------------
 src/memory/dump.c            |  12 +-
 src/memory/hashmap.c         |  15 +-
 src/memory/lookup3.c         |  12 +-
 src/memory/stack.c           |   4 +-
 src/memory/vectorspace.c     |   2 +-
 src/ops/intern.c             |  60 +++---
 src/ops/intern.h             |   2 +-
 src/ops/lispops.c            |  53 ++---
 src/repl.c                   |   6 +-
 state-of-play.md             | 274 -------------------------
 24 files changed, 496 insertions(+), 716 deletions(-)
 delete mode 100644 state-of-play.md

diff --git a/Doxyfile b/Doxyfile
index 1a06dca..c608536 100644
--- a/Doxyfile
+++ b/Doxyfile
@@ -162,7 +162,7 @@ FULL_PATH_NAMES        = YES
 # will be relative from the directory where doxygen is started.
 # This tag requires that the tag FULL_PATH_NAMES is set to YES.
 
-STRIP_FROM_PATH        = src/
+STRIP_FROM_PATH      = ../../
 
 # The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the
 # path mentioned in the documentation of a class, which tells the reader which
diff --git a/docs/Home.md b/docs/Home.md
index e045ef1..b0ffb0b 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -6,6 +6,10 @@ Work towards the implementation of a software system like that described in [Pos
 
 *Originally most of this documentation was on a wiki attached to the [GitHub project](https://github.com/simon-brooke/post-scarcity); when that was transferred to [my own foregejo instance](https://git.journeyman.cc/simon/post-scarcity) the wiki was copied. However, it's more convenient to keep documentation in the project with the source files, and version controlled in the same Git repository. So while both wikis still exist, they should no longer be considered canonical. The canonical version is in `/docs`, and is incorporated by [Doxygen](https://www.doxygen.nl/) into the generated documentation — which is generated into `/doc` using the command `make doc`.*
 
+## State of Play
+
+You can read about the current [state of play](md_home_2simon_2workspace_2post-scarcity_2docs_2state-of-play.html).
+
 ## AWFUL WARNING 1
 
 This does not work. It isn't likely to work any time soon. If you want to learn Lisp, don't start here; try Clojure, Scheme or Common Lisp (in which case I recommend Steel Bank Common Lisp). If you want to learn how Lisp works, still don't start here. This isn't ever going to be anything like a conventional Lisp environment.
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 0e7cd6f..5452107 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -90,10 +90,11 @@ 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 )
+         && ( 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 ) ) {
@@ -128,20 +129,23 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
 struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
     struct cons_pointer result;
 
-    if ( !nilp( more) || value < 0 || value >= SMALL_INT_LIMIT) {
-        debug_print( L"acquire_integer passing to make_integer (outside small int range)\n", DEBUG_ALLOC );
-        result = make_integer( value, more);
+    if ( !nilp( more ) || value < 0 || value >= SMALL_INT_LIMIT ) {
+        debug_print
+            ( L"acquire_integer passing to make_integer (outside small int range)\n",
+              DEBUG_ALLOC );
+        result = make_integer( value, more );
     } else {
-        if ( !small_int_cache_initialised) {
-            for (int64_t i = 0; i < SMALL_INT_LIMIT; i++) {
-                small_int_cache[i] = make_integer( i, NIL);
-                pointer2cell(small_int_cache[i]).count = UINT32_MAX; // lock it in so it can't be GC'd
+        if ( !small_int_cache_initialised ) {
+            for ( int64_t i = 0; i < SMALL_INT_LIMIT; i++ ) {
+                small_int_cache[i] = make_integer( i, NIL );
+                pointer2cell( small_int_cache[i] ).count = UINT32_MAX;  // lock it in so it can't be GC'd
             }
-           small_int_cache_initialised = true;
+            small_int_cache_initialised = true;
             debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );
         }
 
-        debug_printf( DEBUG_ALLOC, L"acquire_integer: returning %" PRId64 "\n", value);
+        debug_printf( DEBUG_ALLOC, L"acquire_integer: returning %" PRId64 "\n",
+                      value );
         result = small_int_cache[value];
     }
     return result;
@@ -156,15 +160,17 @@ struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
  * 
  * @param p a pointer, expected to be to an integer.
  */
-void release_integer( struct cons_pointer p) {
-    struct cons_space_object o = pointer2cell( p);
-    if ( !integerp( p) ||                   // what I've been passed isn't an integer;
-        !nilp( o.payload.integer.more) ||   // or it's a bignum;
-        o.payload.integer.value >= SMALL_INT_LIMIT || // or it's bigger than the small int cache limit;
-        !eq( p, small_int_cache[ o.payload.integer.value]) // or it's simply not the copy in the cache...
-    ) { dec_ref( p); } else {
-        debug_printf( DEBUG_ALLOC, L"release_integer: releasing %" PRId64 "\n", 
-            o.payload.integer.value);
+void release_integer( struct cons_pointer p ) {
+    struct cons_space_object o = pointer2cell( p );
+    if ( !integerp( p ) ||      // what I've been passed isn't an integer;
+         !nilp( o.payload.integer.more ) || // or it's a bignum;
+         o.payload.integer.value >= SMALL_INT_LIMIT ||  // or it's bigger than the small int cache limit;
+         !eq( p, small_int_cache[o.payload.integer.value] ) // or it's simply not the copy in the cache...
+         ) {
+        dec_ref( p );
+    } else {
+        debug_printf( DEBUG_ALLOC, L"release_integer: releasing %" PRId64 "\n",
+                      o.payload.integer.value );
     }
 }
 
@@ -192,7 +198,7 @@ __int128_t int128_to_integer( __int128_t val,
     if ( MAX_INTEGER >= val ) {
         carry = 0;
     } else {
-        carry = val % INT_CELL_BASE; 
+        carry = val % INT_CELL_BASE;
         debug_printf( DEBUG_ARITH,
                       L"int128_to_integer: 64 bit overflow; setting carry to %ld\n",
                       ( int64_t ) carry );
@@ -200,7 +206,7 @@ __int128_t int128_to_integer( __int128_t val,
     }
 
     struct cons_space_object *newc = &pointer2cell( new );
-    newc->payload.integer.value = (int64_t)val;
+    newc->payload.integer.value = ( int64_t ) val;
 
     if ( integerp( less_significant ) ) {
         struct cons_space_object *lsc = &pointer2cell( less_significant );
@@ -239,7 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
         while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
             __int128_t av = cell_value( a, '+', is_first_cell );
             __int128_t bv = cell_value( b, '+', is_first_cell );
-            __int128_t rv = (av + bv) + carry;
+            __int128_t rv = ( av + bv ) + carry;
 
             debug_print( L"add_integers: av = ", DEBUG_ARITH );
             debug_print_128bit( av, DEBUG_ARITH );
@@ -251,8 +257,9 @@ struct cons_pointer add_integers( struct cons_pointer a,
             debug_print_128bit( rv, DEBUG_ARITH );
             debug_print( L"\n", DEBUG_ARITH );
 
-            if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT)) {
-                result = acquire_integer( (int64_t)(rv & 0xffffffff), NIL);
+            if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT ) ) {
+                result =
+                    acquire_integer( ( int64_t ) ( rv & 0xffffffff ), NIL );
                 break;
             } else {
                 struct cons_pointer new = make_integer( 0, NIL );
@@ -281,7 +288,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
 struct cons_pointer base_partial( int depth ) {
     struct cons_pointer result = NIL;
 
-    debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth);
+    debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth );
 
     for ( int i = 0; i < depth; i++ ) {
         result = acquire_integer( 0, result );
@@ -299,15 +306,15 @@ struct cons_pointer base_partial( int depth ) {
  * numbering system here is base INT_CELL_BASE, currently x0fffffffffffffffL
  */
 struct cons_pointer append_cell( struct cons_pointer partial,
-                                  struct cons_pointer digit ) {
-    struct cons_space_object cell = pointer2cell( partial);
+                                 struct cons_pointer digit ) {
+    struct cons_space_object cell = pointer2cell( partial );
     // TODO: I should recursively copy the whole bignum chain, because
     // we're still destructively modifying the end of it.
-    struct cons_pointer c = make_integer( cell.payload.integer.value, 
-        cell.payload.integer.more);
+    struct cons_pointer c = make_integer( cell.payload.integer.value,
+                                          cell.payload.integer.more );
     struct cons_pointer result = partial;
 
-    if ( nilp( partial)) {
+    if ( nilp( partial ) ) {
         result = digit;
     } else {
         // find the last digit in the chain...
@@ -376,9 +383,10 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
                 /* if xj exceeds one digit, break it into the digit dj and
                  * the carry */
                 carry = xj >> INTEGER_BIT_SHIFT;
-                struct cons_pointer dj = acquire_integer( xj & MAX_INTEGER, NIL );
+                struct cons_pointer dj =
+                    acquire_integer( xj & MAX_INTEGER, NIL );
 
-                replace_integer_p( ri,  append_cell( ri, dj ));
+                replace_integer_p( ri, append_cell( ri, dj ) );
                 // struct cons_pointer new_ri = append_cell( ri, dj );
                 // release_integer( ri); 
                 // ri = new_ri;
@@ -387,7 +395,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
             /* if carry is not equal to zero, append it as a final cell
              * to ri */
             if ( carry != 0 ) {
-                replace_integer_i( ri, carry)
+                replace_integer_i( ri, carry )
             }
 
             /* add ri to result */
@@ -412,14 +420,16 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
 struct cons_pointer integer_to_string_add_digit( int digit, int digits,
                                                  struct cons_pointer tail ) {
     wint_t character = btowc( hex_digits[digit] );
-    debug_printf( DEBUG_IO, L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ", digit, digits);
-    struct cons_pointer r = ( digits % 3 == 0 ) ?
-        make_string( L',', make_string( character,
-                                        tail ) ) :
+    debug_printf( DEBUG_IO,
+                  L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ",
+                  digit, digits );
+    struct cons_pointer r =
+        ( digits % 3 == 0 ) ? make_string( L',', make_string( character,
+                                                              tail ) ) :
         make_string( character, tail );
 
-    debug_print_object( r, DEBUG_IO);
-    debug_println( DEBUG_IO);
+    debug_print_object( r, DEBUG_IO );
+    debug_println( DEBUG_IO );
 
     return r;
 }
@@ -460,7 +470,8 @@ 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 % INT_CELL_BASE );
+                        ( pointer2cell( next ).payload.integer.value %
+                          INT_CELL_BASE );
                     next = pointer2cell( next ).payload.integer.more;
                 }
                 int offset = ( int ) ( accumulator % base );
diff --git a/src/arith/integer.h b/src/arith/integer.h
index d0b4b71..49f700c 100644
--- a/src/arith/integer.h
+++ b/src/arith/integer.h
@@ -21,7 +21,7 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more );
 
 struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more );
 
-void release_integer( struct cons_pointer p);
+void release_integer( struct cons_pointer p );
 
 struct cons_pointer add_integers( struct cons_pointer a,
                                   struct cons_pointer b );
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index aa8e69f..5608717 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -64,15 +64,16 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
                 if ( drrv / gcd == 1 ) {
                     result = acquire_integer( ddrv / gcd, NIL );
                 } else {
-                    debug_printf( DEBUG_ARITH, 
-                        L"simplify_ratio: %ld/%ld => %ld/%ld\n", ddrv, drrv, ddrv/gcd, drrv/gcd);
+                    debug_printf( DEBUG_ARITH,
+                                  L"simplify_ratio: %ld/%ld => %ld/%ld\n",
+                                  ddrv, drrv, ddrv / gcd, drrv / gcd );
                     result =
                         make_ratio( acquire_integer( ddrv / gcd, NIL ),
                                     acquire_integer( drrv / gcd, NIL ) );
                 }
             }
         }
-    } 
+    }
     // TODO: else throw exception?
 
     return result;
@@ -126,8 +127,12 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
 
             r = add_ratio_ratio( r1, r2 );
 
-            if (!eq( r, r1)) { dec_ref( r1);}
-            if (!eq( r, r2)) { dec_ref( r2);}
+            if ( !eq( r, r1 ) ) {
+                dec_ref( r1 );
+            }
+            if ( !eq( r, r2 ) ) {
+                dec_ref( r2 );
+            }
 
             /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
              * never incremented except when making r1 and r2, decrementing
@@ -238,12 +243,11 @@ struct cons_pointer multiply_ratio_ratio( struct
 
         struct cons_pointer dividend = acquire_integer( ddrv, NIL );
         struct cons_pointer divisor = acquire_integer( drrv, NIL );
-        struct cons_pointer unsimplified =
-            make_ratio( dividend, divisor);
+        struct cons_pointer unsimplified = make_ratio( dividend, divisor );
         result = simplify_ratio( unsimplified );
 
-        release_integer( dividend);
-        release_integer( divisor);
+        release_integer( dividend );
+        release_integer( divisor );
 
         if ( !eq( unsimplified, result ) ) {
             dec_ref( unsimplified );
@@ -320,8 +324,10 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         cell->payload.ratio.dividend = dividend;
         cell->payload.ratio.divisor = divisor;
 
-        result = simplify_ratio( unsimplified);
-        if ( !eq( result, unsimplified)) { dec_ref( unsimplified); }
+        result = simplify_ratio( unsimplified );
+        if ( !eq( result, unsimplified ) ) {
+            dec_ref( unsimplified );
+        }
     } else {
         result =
             throw_exception( c_string_to_lisp_string
diff --git a/src/init.c b/src/init.c
index 7c4bdc3..912ba45 100644
--- a/src/init.c
+++ b/src/init.c
@@ -45,19 +45,20 @@
  * @param location_descriptor a description of where the pointer was caught.
  * @return struct cons_pointer 
  */
-struct cons_pointer check_exception( struct cons_pointer pointer, char * location_descriptor) {
+struct cons_pointer check_exception( struct cons_pointer pointer,
+                                     char *location_descriptor ) {
     struct cons_pointer result = NIL;
 
-    struct cons_space_object * object = &pointer2cell( pointer);
+    struct cons_space_object *object = &pointer2cell( pointer );
 
-    if ( exceptionp( pointer)) {
-        fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor);
+    if ( exceptionp( pointer ) ) {
+        fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
         URL_FILE *ustderr = file_to_url_file( stderr );
         fwide( stderr, 1 );
         print( ustderr, object->payload.exception.payload );
         free( ustderr );
 
-        dec_ref( pointer);
+        dec_ref( pointer );
     } else {
         result = pointer;
     }
@@ -68,21 +69,21 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
 struct cons_pointer init_name_symbol = NIL;
 struct cons_pointer init_primitive_symbol = NIL;
 
-void maybe_bind_init_symbols() {
-    if ( nilp( init_name_symbol)) {
+void maybe_bind_init_symbols(  ) {
+    if ( nilp( init_name_symbol ) ) {
         init_name_symbol = c_string_to_lisp_keyword( L"name" );
     }
-    if ( nilp( init_primitive_symbol)) {
+    if ( nilp( init_primitive_symbol ) ) {
         init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
     }
-    if ( nilp( privileged_symbol_nil)) {
-        privileged_symbol_nil = c_string_to_lisp_symbol( L"nil");
+    if ( nilp( privileged_symbol_nil ) ) {
+        privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
 }
 
-void free_init_symbols() {
-    dec_ref( init_name_symbol);
-    dec_ref( init_primitive_symbol);
+void free_init_symbols(  ) {
+    dec_ref( init_name_symbol );
+    dec_ref( init_primitive_symbol );
 }
 
 /**
@@ -92,20 +93,22 @@ void free_init_symbols() {
  * the name on the source pointer. Would make stack frames potentially
  * more readable and aid debugging generally.
  */
-struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executable )
-                     ( struct stack_frame *,
-                       struct cons_pointer, struct cons_pointer ) ) {
+struct cons_pointer bind_function( wchar_t *name,
+                                   struct cons_pointer ( *executable )
+                                    ( struct stack_frame *,
+                                      struct cons_pointer,
+                                      struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
     struct cons_pointer meta =
         make_cons( make_cons( init_primitive_symbol, TRUE ),
                    make_cons( make_cons( init_name_symbol, n ),
                               NIL ) );
 
-    struct cons_pointer r = check_exception( 
-        deep_bind( n, make_function( meta, executable ) ),
-                    "bind_function");
-    
-    dec_ref( n);
+    struct cons_pointer r =
+        check_exception( deep_bind( n, make_function( meta, executable ) ),
+                         "bind_function" );
+
+    dec_ref( n );
 
     return r;
 }
@@ -114,20 +117,21 @@ struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executa
  * Bind this compiled `executable` function, as a Lisp special form, to
  * this `name` in the `oblist`.
  */
-struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executable )
-                    ( struct stack_frame *,
-                      struct cons_pointer, struct cons_pointer ) ) {
+struct cons_pointer bind_special( wchar_t *name,
+                                  struct cons_pointer ( *executable )
+                                   ( struct stack_frame *, struct cons_pointer,
+                                     struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
 
     struct cons_pointer meta =
         make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n), NIL ) );
+                   make_cons( make_cons( init_name_symbol, n ), NIL ) );
 
-    struct cons_pointer r = 
-        check_exception(deep_bind( n, make_special( meta, executable ) ),
-                    "bind_special");
-    
-    dec_ref( n);
+    struct cons_pointer r =
+        check_exception( deep_bind( n, make_special( meta, executable ) ),
+                         "bind_special" );
+
+    dec_ref( n );
 
     return r;
 }
@@ -135,14 +139,14 @@ struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executab
 /**
  * Bind this `value` to this `symbol` in the `oblist`.
  */
-struct cons_pointer 
-bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool lock) {
-    struct cons_pointer r = check_exception( 
-        deep_bind( symbol, value ),
-            "bind_symbol_value");
+struct cons_pointer
+bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value,
+                   bool lock ) {
+    struct cons_pointer r = check_exception( deep_bind( symbol, value ),
+                                             "bind_symbol_value" );
 
-    if ( lock && !exceptionp( r)){
-        struct cons_space_object * cell = & pointer2cell( r);
+    if ( lock && !exceptionp( r ) ) {
+        struct cons_space_object *cell = &pointer2cell( r );
 
         cell->count = UINT32_MAX;
     }
@@ -153,12 +157,13 @@ bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool l
 /**
  * Bind this `value` to this `name` in the `oblist`.
  */
-struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value, bool lock ) {
+struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value,
+                                bool lock ) {
     struct cons_pointer p = c_string_to_lisp_symbol( name );
 
-    struct cons_pointer r = bind_symbol_value( p, value, lock);
+    struct cons_pointer r = bind_symbol_value( p, value, lock );
 
-    dec_ref( p);
+    dec_ref( p );
 
     return r;
 }
@@ -173,7 +178,7 @@ void print_banner(  ) {
  * 
  * @stream the stream to print to.
  */
-void print_options( FILE * stream ) {
+void print_options( FILE *stream ) {
     fwprintf( stream, L"Expected options are:\n" );
     fwprintf( stream,
               L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
@@ -201,7 +206,7 @@ int main( int argc, char *argv[] ) {
     int option;
     bool dump_at_end = false;
     bool show_prompt = false;
-    char * infilename = NULL;
+    char *infilename = NULL;
 
     setlocale( LC_ALL, "" );
     if ( io_init(  ) != 0 ) {
@@ -219,7 +224,7 @@ int main( int argc, char *argv[] ) {
                 print_options( stdout );
                 exit( 0 );
                 break;
-            case 'i' :
+            case 'i':
                 infilename = optarg;
                 break;
             case 'p':
@@ -236,9 +241,9 @@ int main( int argc, char *argv[] ) {
         }
     }
 
-    initialise_cons_pages();
+    initialise_cons_pages(  );
 
-    maybe_bind_init_symbols();
+    maybe_bind_init_symbols(  );
 
 
     if ( show_prompt ) {
@@ -254,7 +259,7 @@ int main( int argc, char *argv[] ) {
     /*
      * privileged variables (keywords)
      */
-    bind_symbol_value( privileged_symbol_nil, NIL, true);
+    bind_symbol_value( privileged_symbol_nil, NIL, true );
     bind_value( L"t", TRUE, true );
 
     /*
@@ -267,43 +272,49 @@ int main( int argc, char *argv[] ) {
     fwide( stderr, 1 );
     fwide( sink->handle.file, 1 );
 
-    FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r");
+    FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r" );
 
 
-    lisp_io_in = bind_value( C_IO_IN, make_read_stream(  file_to_url_file(infile),
-                                    make_cons( make_cons
-                                                ( c_string_to_lisp_keyword
-                                                ( L"url" ),
-                                                c_string_to_lisp_string
-                                                ( L"system:standard input" ) ),
-                                                NIL ) ), false );
-    lisp_io_out = bind_value( C_IO_OUT,
-                make_write_stream( file_to_url_file( stdout ),
+    lisp_io_in =
+        bind_value( C_IO_IN,
+                    make_read_stream( file_to_url_file( infile ),
+                                      make_cons( make_cons
+                                                 ( c_string_to_lisp_keyword
+                                                   ( L"url" ),
+                                                   c_string_to_lisp_string
+                                                   ( L"system:standard input" ) ),
+                                                 NIL ) ), false );
+    lisp_io_out =
+        bind_value( C_IO_OUT,
+                    make_write_stream( file_to_url_file( stdout ),
+                                       make_cons( make_cons
+                                                  ( c_string_to_lisp_keyword
+                                                    ( L"url" ),
+                                                    c_string_to_lisp_string
+                                                    ( L"system:standard output]" ) ),
+                                                  NIL ) ), false );
+    bind_value( L"*log*",
+                make_write_stream( file_to_url_file( stderr ),
                                    make_cons( make_cons
                                               ( c_string_to_lisp_keyword
                                                 ( L"url" ),
                                                 c_string_to_lisp_string
-                                                ( L"system:standard output]" ) ),
-                                              NIL ) ), false);
-    bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
-                                             make_cons( make_cons
-                                                        ( c_string_to_lisp_keyword
-                                                          ( L"url" ),
-                                                          c_string_to_lisp_string
-                                                          ( L"system:standard log" ) ),
-                                                        NIL ) ), false );
-    bind_value( L"*sink*", make_write_stream( sink,
-                                              make_cons( make_cons
-                                                         ( c_string_to_lisp_keyword
-                                                           ( L"url" ),
-                                                           c_string_to_lisp_string
-                                                           ( L"system:standard sink" ) ),
-                                                         NIL ) ), false );
+                                                ( L"system:standard log" ) ),
+                                              NIL ) ), false );
+    bind_value( L"*sink*",
+                make_write_stream( sink,
+                                   make_cons( make_cons
+                                              ( c_string_to_lisp_keyword
+                                                ( L"url" ),
+                                                c_string_to_lisp_string
+                                                ( L"system:standard sink" ) ),
+                                              NIL ) ), false );
     /*
      * the default prompt
      */
     prompt_name = bind_value( L"*prompt*",
-                show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
+                              show_prompt ? c_string_to_lisp_symbol( L":: " ) :
+                              NIL, false );
     /*
      * primitive function operations
      */
@@ -377,7 +388,7 @@ int main( int argc, char *argv[] ) {
 
     debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
     dec_ref( oblist );
-    free_init_symbols();
+    free_init_symbols(  );
 
     summarise_allocation(  );
     curl_global_cleanup(  );
diff --git a/src/io/fopen.c b/src/io/fopen.c
index e4fafdd..bf918ec 100644
--- a/src/io/fopen.c
+++ b/src/io/fopen.c
@@ -99,7 +99,7 @@ static size_t write_callback( char *buffer,
 }
 
 /* use to attempt to fill the read buffer up to requested number of bytes */
-static int fill_buffer( URL_FILE * file, size_t want ) {
+static int fill_buffer( URL_FILE *file, size_t want ) {
     fd_set fdread;
     fd_set fdwrite;
     fd_set fdexcep;
@@ -181,7 +181,7 @@ static int fill_buffer( URL_FILE * file, size_t want ) {
 }
 
 /* use to remove want bytes from the front of a files buffer */
-static int use_buffer( URL_FILE * file, size_t want ) {
+static int use_buffer( URL_FILE *file, size_t want ) {
     /* sort out buffer */
     if ( ( file->buffer_pos - want ) <= 0 ) {
         /* ditch buffer - write will recreate */
@@ -255,7 +255,7 @@ URL_FILE *url_fopen( const char *url, const char *operation ) {
     return file;
 }
 
-int url_fclose( URL_FILE * file ) {
+int url_fclose( URL_FILE *file ) {
     int ret = 0;                /* default is good return */
 
     switch ( file->type ) {
@@ -283,7 +283,7 @@ int url_fclose( URL_FILE * file ) {
     return ret;
 }
 
-int url_feof( URL_FILE * file ) {
+int url_feof( URL_FILE *file ) {
     int ret = 0;
 
     switch ( file->type ) {
@@ -304,7 +304,7 @@ int url_feof( URL_FILE * file ) {
     return ret;
 }
 
-size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ) {
+size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE *file ) {
     size_t want;
 
     switch ( file->type ) {
@@ -343,7 +343,7 @@ size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ) {
     return want;
 }
 
-char *url_fgets( char *ptr, size_t size, URL_FILE * file ) {
+char *url_fgets( char *ptr, size_t size, URL_FILE *file ) {
     size_t want = size - 1;     /* always need to leave room for zero termination */
     size_t loop;
 
@@ -390,7 +390,7 @@ char *url_fgets( char *ptr, size_t size, URL_FILE * file ) {
     return ptr;                 /*success */
 }
 
-void url_rewind( URL_FILE * file ) {
+void url_rewind( URL_FILE *file ) {
     switch ( file->type ) {
         case CFTYPE_FILE:
             rewind( file->handle.file );  /* passthrough */
diff --git a/src/io/history.c b/src/io/history.c
index 3f22821..417a6b1 100644
--- a/src/io/history.c
+++ b/src/io/history.c
@@ -11,4 +11,4 @@
  *
  * (c) 2025 Simon Brooke 
  * Licensed under GPL version 2.0, or, at your option, any later version.
- */
\ No newline at end of file
+ */
diff --git a/src/io/history.h b/src/io/history.h
index 74355b5..ffdd262 100644
--- a/src/io/history.h
+++ b/src/io/history.h
@@ -11,4 +11,4 @@
  *
  * (c) 2025 Simon Brooke 
  * Licensed under GPL version 2.0, or, at your option, any later version.
- */
\ No newline at end of file
+ */
diff --git a/src/io/io.c b/src/io/io.c
index 66c51c2..b7dc11c 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -131,7 +131,7 @@ char *lisp_string_to_c_string( struct cons_pointer s ) {
  * @param f the file to be wrapped;
  * @return the new handle, or null if no such handle could be allocated.
  */
-URL_FILE *file_to_url_file( FILE * f ) {
+URL_FILE *file_to_url_file( FILE *f ) {
     URL_FILE *result = ( URL_FILE * ) malloc( sizeof( URL_FILE ) );
 
     if ( result != NULL ) {
@@ -148,7 +148,7 @@ URL_FILE *file_to_url_file( FILE * f ) {
  * @param file the stream to read from;
  * @return the next wide character on the stream, or zero if no more.
  */
-wint_t url_fgetwc( URL_FILE * input ) {
+wint_t url_fgetwc( URL_FILE *input ) {
     wint_t result = -1;
 
     if ( ungotten != 0 ) {
@@ -217,7 +217,7 @@ wint_t url_fgetwc( URL_FILE * input ) {
     return result;
 }
 
-wint_t url_ungetwc( wint_t wc, URL_FILE * input ) {
+wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
     wint_t result = -1;
 
     switch ( input->type ) {
@@ -284,7 +284,7 @@ struct cons_pointer add_meta_string( struct cons_pointer meta, wchar_t *key,
 }
 
 struct cons_pointer add_meta_time( struct cons_pointer meta, wchar_t *key,
-                                   time_t * value ) {
+                                   time_t *value ) {
     /* I don't yet have a concept of a date-time object, which is a
      * bit of an oversight! */
     char datestring[256];
@@ -410,8 +410,7 @@ void collect_meta( struct cons_pointer stream, char *url ) {
  */
 struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_pointer stream_name =
-         inputp ? lisp_io_in : lisp_io_out;
+    struct cons_pointer stream_name = inputp ? lisp_io_in : lisp_io_out;
 
     result = c_assoc( stream_name, env );
 
@@ -509,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/io/print.c b/src/io/print.c
index deea087..18ed0af 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -32,7 +32,7 @@
  * onto this `output`; if `pointer` does not indicate a string or symbol,
  * don't print anything but just return.
  */
-void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
+void print_string_contents( URL_FILE *output, struct cons_pointer pointer ) {
     while ( stringp( pointer ) || symbolp( pointer ) || keywordp( pointer ) ) {
         struct cons_space_object *cell = &pointer2cell( pointer );
         wchar_t c = cell->payload.string.character;
@@ -49,7 +49,7 @@ void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
  * the stream at this `output`, prepending and appending double quote
  * characters.
  */
-void print_string( URL_FILE * output, struct cons_pointer pointer ) {
+void print_string( URL_FILE *output, struct cons_pointer pointer ) {
     url_fputwc( btowc( '"' ), output );
     print_string_contents( output, pointer );
     url_fputwc( btowc( '"' ), output );
@@ -61,7 +61,7 @@ void print_string( URL_FILE * output, struct cons_pointer pointer ) {
  * a space character.
  */
 void
-print_list_contents( URL_FILE * output, struct cons_pointer pointer,
+print_list_contents( URL_FILE *output, struct cons_pointer pointer,
                      bool initial_space ) {
     struct cons_space_object *cell = &pointer2cell( pointer );
 
@@ -82,13 +82,13 @@ print_list_contents( URL_FILE * output, struct cons_pointer pointer,
     }
 }
 
-void print_list( URL_FILE * output, struct cons_pointer pointer ) {
+void print_list( URL_FILE *output, struct cons_pointer pointer ) {
     url_fputws( L"(", output );
     print_list_contents( output, pointer, false );
     url_fputws( L")", output );
 }
 
-void print_map( URL_FILE * output, struct cons_pointer map ) {
+void print_map( URL_FILE *output, struct cons_pointer map ) {
     if ( hashmapp( map ) ) {
         struct vector_space_object *vso = pointer_to_vso( map );
 
@@ -110,7 +110,7 @@ void print_map( URL_FILE * output, struct cons_pointer map ) {
     }
 }
 
-void print_vso( URL_FILE * output, struct cons_pointer pointer ) {
+void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
     struct vector_space_object *vso = pointer_to_vso( pointer );
     switch ( vso->header.tag.value ) {
         case HASHTV:
@@ -126,7 +126,7 @@ void print_vso( URL_FILE * output, struct cons_pointer pointer ) {
 /**
  * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
  */
-void print_128bit( URL_FILE * output, __int128_t n ) {
+void print_128bit( URL_FILE *output, __int128_t n ) {
     if ( n == 0 ) {
         fwprintf( stderr, L"0" );
     } else {
@@ -148,7 +148,7 @@ void print_128bit( URL_FILE * output, __int128_t n ) {
  * Print the cons-space object indicated by `pointer` to the stream indicated
  * by `output`.
  */
-struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
+struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     char *buffer;
 
@@ -272,6 +272,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
     return pointer;
 }
 
-void println( URL_FILE * output ) {
+void println( URL_FILE *output ) {
     url_fputws( L"\n", output );
 }
diff --git a/src/io/read.c b/src/io/read.c
index bf0b389..24a47fb 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -83,14 +83,14 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
  * 3. one or more symbols separated by slashes; or
  * 4. keywords (with leading colons) interspersed with symbols (prefixed by slashes).
  */
-struct cons_pointer read_path( URL_FILE * input, wint_t initial,
+struct cons_pointer read_path( URL_FILE *input, wint_t initial,
                                struct cons_pointer q ) {
     bool done = false;
     struct cons_pointer prefix = NIL;
 
     switch ( initial ) {
         case '/':
-            prefix = c_string_to_lisp_symbol( L"oblist" );
+            prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL);
             break;
         case '$':
         case LSESSION:
@@ -155,7 +155,7 @@ struct cons_pointer read_path( URL_FILE * input, wint_t initial,
 struct cons_pointer read_continuation( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env,
-                                       URL_FILE * input, wint_t initial ) {
+                                       URL_FILE *input, wint_t initial ) {
     debug_print( L"entering read_continuation\n", DEBUG_IO );
     struct cons_pointer result = NIL;
 
@@ -287,7 +287,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
  */
 struct cons_pointer read_number( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
-                                 URL_FILE * input,
+                                 URL_FILE *input,
                                  wint_t initial, bool seen_period ) {
     debug_print( L"entering read_number\n", DEBUG_IO );
 
@@ -308,7 +308,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                   initial );
 
     for ( c = initial; iswdigit( c )
-          || c == LPERIOD || c == LSLASH || c == LCOMMA; c = url_fgetwc( input ) ) {
+          || c == LPERIOD || c == LSLASH || c == LCOMMA;
+          c = url_fgetwc( input ) ) {
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
@@ -342,8 +343,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             default:
                 result = add_integers( multiply_integers( result, base ),
-                                       acquire_integer( ( int ) c - ( int ) '0',
-                                                     NIL ) );
+                                       acquire_integer( ( int ) c -
+                                                        ( int ) '0', NIL ) );
 
                 debug_printf( DEBUG_IO,
                               L"read_number: added character %c, result now ",
@@ -366,10 +367,10 @@ struct cons_pointer read_number( struct stack_frame *frame,
         debug_print( L"read_number: converting result to real\n", DEBUG_IO );
         struct cons_pointer div = make_ratio( result,
                                               acquire_integer( powl
-                                                            ( to_long_double
-                                                              ( base ),
-                                                              places_of_decimals ),
-                                                            NIL ) );
+                                                               ( to_long_double
+                                                                 ( base ),
+                                                                 places_of_decimals ),
+                                                               NIL ) );
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
@@ -400,7 +401,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
 struct cons_pointer read_list( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env,
-                               URL_FILE * input, wint_t initial ) {
+                               URL_FILE *input, wint_t initial ) {
     struct cons_pointer result = NIL;
     wint_t c;
 
@@ -440,7 +441,7 @@ struct cons_pointer read_list( struct stack_frame *frame,
 struct cons_pointer read_map( struct stack_frame *frame,
                               struct cons_pointer frame_pointer,
                               struct cons_pointer env,
-                              URL_FILE * input, wint_t initial ) {
+                              URL_FILE *input, wint_t initial ) {
     // set write ACL to true whilst creating to prevent GC churn
     struct cons_pointer result =
         make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE );
@@ -480,7 +481,7 @@ struct cons_pointer read_map( struct stack_frame *frame,
  * so delimited in which case it may not contain whitespace (unless escaped)
  * but may contain a double quote character (probably not a good idea!)
  */
-struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
+struct cons_pointer read_string( URL_FILE *input, wint_t initial ) {
     struct cons_pointer cdr = NIL;
     struct cons_pointer result;
     switch ( initial ) {
@@ -503,7 +504,7 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
     return result;
 }
 
-struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
+struct cons_pointer read_symbol_or_key( URL_FILE *input, uint32_t tag,
                                         wint_t initial ) {
     struct cons_pointer cdr = NIL;
     struct cons_pointer result;
@@ -558,7 +559,7 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
 struct cons_pointer read( struct
                           stack_frame
                           *frame, struct cons_pointer frame_pointer,
-                          struct cons_pointer env, URL_FILE * input ) {
+                          struct cons_pointer env, URL_FILE *input ) {
     return read_continuation( frame, frame_pointer, env, input,
                               url_fgetwc( input ) );
 }
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 42c0ad1..3a5b48e 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -121,7 +121,7 @@ void make_cons_page(  ) {
 /**
  * dump the allocated pages to this `output` stream.
  */
-void dump_pages( URL_FILE * output ) {
+void dump_pages( URL_FILE *output ) {
     for ( int i = 0; i < initialised_cons_pages; i++ ) {
         url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
 
@@ -188,7 +188,8 @@ void free_cell( struct cons_pointer pointer ) {
                     free_vso( pointer );
                     break;
                 default:
-                    fprintf( stderr, "WARNING: Freeing object of type %s!", (char *) &(cell->tag.bytes));
+                    fprintf( stderr, "WARNING: Freeing object of type %s!",
+                             ( char * ) &( cell->tag.bytes ) );
             }
 
             strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH );
@@ -240,8 +241,8 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
             total_cells_allocated++;
 
             debug_printf( DEBUG_ALLOC,
-                          L"Allocated cell of type '%4.4s' at %d, %d \n", cell->tag.bytes,
-                          result.page, result.offset );
+                          L"Allocated cell of type '%4.4s' at %d, %d \n",
+                          cell->tag.bytes, result.page, result.offset );
         } else {
             debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
         }
@@ -270,5 +271,6 @@ void initialise_cons_pages(  ) {
 void summarise_allocation(  ) {
     fwprintf( stderr,
               L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n",
-              total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed );
+              total_cells_allocated, total_cells_freed,
+              total_cells_allocated - total_cells_freed );
 }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 5a234da..083e638 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -33,22 +33,22 @@
  * vectorspace object indicated by the cell is this `value`, else false.
  */
 bool check_tag( struct cons_pointer pointer, uint32_t value ) {
-  bool result = false;
+    bool result = false;
 
-  struct cons_space_object cell = pointer2cell( pointer );
-  result = cell.tag.value == value;
+    struct cons_space_object cell = pointer2cell( pointer );
+    result = cell.tag.value == value;
 
-  if ( result == false ) {
-    if ( cell.tag.value == VECTORPOINTTV ) {
-      struct vector_space_object *vec = pointer_to_vso( pointer );
+    if ( result == false ) {
+        if ( cell.tag.value == VECTORPOINTTV ) {
+            struct vector_space_object *vec = pointer_to_vso( pointer );
 
-      if ( vec != NULL ) {
-        result = vec->header.tag.value == value;
-      }
+            if ( vec != NULL ) {
+                result = vec->header.tag.value == value;
+            }
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -60,13 +60,13 @@ bool check_tag( struct cons_pointer pointer, uint32_t value ) {
  * Returns the `pointer`.
  */
 struct cons_pointer inc_ref( struct cons_pointer pointer ) {
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  if ( cell->count < MAXREFERENCE ) {
-    cell->count++;
-  }
+    if ( cell->count < MAXREFERENCE ) {
+        cell->count++;
+    }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -78,18 +78,18 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
  * Returns the `pointer`, or, if the cell has been freed, NIL.
  */
 struct cons_pointer dec_ref( struct cons_pointer pointer ) {
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  if ( cell->count > 0 && cell->count != UINT32_MAX) {
-    cell->count--;
+    if ( cell->count > 0 && cell->count != UINT32_MAX ) {
+        cell->count--;
 
-    if ( cell->count == 0 ) {
-      free_cell( pointer );
-      pointer = NIL;
+        if ( cell->count == 0 ) {
+            free_cell( pointer );
+            pointer = NIL;
+        }
     }
-  }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -98,22 +98,24 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
 struct cons_pointer c_type( struct cons_pointer pointer ) {
-  struct cons_pointer result = NIL;
-  struct cons_space_object cell = pointer2cell( pointer );
+    struct cons_pointer result = NIL;
+    struct cons_space_object cell = pointer2cell( pointer );
 
-  if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
-    struct vector_space_object *vec = pointer_to_vso( pointer );
+    if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) ==
+         0 ) {
+        struct vector_space_object *vec = pointer_to_vso( pointer );
 
-    for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-      result = make_string( (wchar_t)vec->header.tag.bytes[i], result );
+        for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
+            result =
+                make_string( ( wchar_t ) vec->header.tag.bytes[i], result );
+        }
+    } else {
+        for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
+            result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
+        }
     }
-  } else {
-    for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-      result = make_string( (wchar_t)cell.tag.bytes[i], result );
-    }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -121,13 +123,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
  * authorised to read it, does not error but returns nil.
  */
 struct cons_pointer c_car( struct cons_pointer arg ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
-    result = pointer2cell( arg ).payload.cons.car;
-  }
+    if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
+        result = pointer2cell( arg ).payload.cons.car;
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -135,24 +137,24 @@ struct cons_pointer c_car( struct cons_pointer arg ) {
  * not authorised to read it,does not error but returns nil.
  */
 struct cons_pointer c_cdr( struct cons_pointer arg ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  if ( truep( authorised( arg, NIL ) ) ) {
-    struct cons_space_object *cell = &pointer2cell( arg );
+    if ( truep( authorised( arg, NIL ) ) ) {
+        struct cons_space_object *cell = &pointer2cell( arg );
 
-    switch ( cell->tag.value ) {
-      case CONSTV:
-        result = cell->payload.cons.cdr;
-        break;
-      case KEYTV:
-      case STRINGTV:
-      case SYMBOLTV:
-        result = cell->payload.string.cdr;
-        break;
+        switch ( cell->tag.value ) {
+            case CONSTV:
+                result = cell->payload.cons.cdr;
+                break;
+            case KEYTV:
+            case STRINGTV:
+            case SYMBOLTV:
+                result = cell->payload.string.cdr;
+                break;
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -160,13 +162,13 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
  * returns 0.
  */
 int c_length( struct cons_pointer arg ) {
-  int result = 0;
+    int result = 0;
 
-  for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
-    result++;
-  }
+    for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
+        result++;
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -174,18 +176,18 @@ int c_length( struct cons_pointer arg ) {
  */
 struct cons_pointer make_cons( struct cons_pointer car,
                                struct cons_pointer cdr ) {
-  struct cons_pointer pointer = NIL;
+    struct cons_pointer pointer = NIL;
 
-  pointer = allocate_cell( CONSTV );
+    pointer = allocate_cell( CONSTV );
 
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( car );
-  inc_ref( cdr );
-  cell->payload.cons.car = car;
-  cell->payload.cons.cdr = cdr;
+    inc_ref( car );
+    inc_ref( cdr );
+    cell->payload.cons.car = car;
+    cell->payload.cons.cdr = cdr;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -197,35 +199,39 @@ struct cons_pointer make_cons( struct cons_pointer car,
  */
 struct cons_pointer make_exception( struct cons_pointer message,
                                     struct cons_pointer frame_pointer ) {
-  struct cons_pointer result = NIL;
-  struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_pointer result = NIL;
+    struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( frame_pointer );
-  cell->payload.exception.payload = message;
-  cell->payload.exception.frame = frame_pointer;
+    inc_ref( frame_pointer );
+    cell->payload.exception.payload = message;
+    cell->payload.exception.frame = frame_pointer;
 
-  result = pointer;
+    result = pointer;
 
-  return result;
+    return result;
 }
 
 /**
  * Construct a cell which points to an executable Lisp function.
  */
-struct cons_pointer make_function(
-    struct cons_pointer meta,
-    struct cons_pointer ( *executable )( struct stack_frame *,
-                                         struct cons_pointer,
-                                         struct cons_pointer ) ) {
-  struct cons_pointer pointer = allocate_cell( FUNCTIONTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
-  inc_ref( meta );
+struct cons_pointer make_function( struct cons_pointer meta,
+                                   struct cons_pointer ( *executable ) ( struct
+                                                                         stack_frame
+                                                                         *,
+                                                                         struct
+                                                                         cons_pointer,
+                                                                         struct
+                                                                         cons_pointer ) ) 
+{
+    struct cons_pointer pointer = allocate_cell( FUNCTIONTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( meta );
 
-  cell->payload.function.meta = meta;
-  cell->payload.function.executable = executable;
+    cell->payload.function.meta = meta;
+    cell->payload.function.executable = executable;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -233,15 +239,15 @@ struct cons_pointer make_function(
  */
 struct cons_pointer make_lambda( struct cons_pointer args,
                                  struct cons_pointer body ) {
-  struct cons_pointer pointer = allocate_cell( LAMBDATV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_pointer pointer = allocate_cell( LAMBDATV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( args );
-  inc_ref( body );
-  cell->payload.lambda.args = args;
-  cell->payload.lambda.body = body;
+    inc_ref( args );
+    inc_ref( body );
+    cell->payload.lambda.args = args;
+    cell->payload.lambda.body = body;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -250,15 +256,15 @@ struct cons_pointer make_lambda( struct cons_pointer args,
  */
 struct cons_pointer make_nlambda( struct cons_pointer args,
                                   struct cons_pointer body ) {
-  struct cons_pointer pointer = allocate_cell( NLAMBDATV );
+    struct cons_pointer pointer = allocate_cell( NLAMBDATV );
 
-  struct cons_space_object *cell = &pointer2cell( pointer );
-  inc_ref( args );
-  inc_ref( body );
-  cell->payload.lambda.args = args;
-  cell->payload.lambda.body = body;
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( args );
+    inc_ref( body );
+    cell->payload.lambda.args = args;
+    cell->payload.lambda.body = body;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -273,22 +279,24 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
  * returns 0 for things which are not string like.
  */
 uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
-  struct cons_space_object *cell = &pointer2cell( ptr );
-  uint32_t result = 0;
+    struct cons_space_object *cell = &pointer2cell( ptr );
+    uint32_t result = 0;
 
-  switch ( cell->tag.value ) {
-    case KEYTV:
-    case STRINGTV:
-    case SYMBOLTV:
-      if ( nilp( cell->payload.string.cdr ) ) {
-        result = (uint32_t)c;
-      } else {
-        result = ( (uint32_t)c * cell->payload.string.hash ) & 0xffffffff;
-      }
-      break;
-  }
+    switch ( cell->tag.value ) {
+        case KEYTV:
+        case STRINGTV:
+        case SYMBOLTV:
+            if ( nilp( cell->payload.string.cdr ) ) {
+                result = ( uint32_t ) c;
+            } else {
+                result =
+                    ( ( uint32_t ) c *
+                      cell->payload.string.hash ) & 0xffffffff;
+            }
+            break;
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -299,24 +307,24 @@ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
  */
 struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
                                             uint32_t tag ) {
-  struct cons_pointer pointer = NIL;
+    struct cons_pointer pointer = NIL;
 
-  if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
-    pointer = allocate_cell( tag );
-    struct cons_space_object *cell = &pointer2cell( pointer );
+    if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
+        pointer = allocate_cell( tag );
+        struct cons_space_object *cell = &pointer2cell( pointer );
 
-    cell->payload.string.character = c;
-    cell->payload.string.cdr = tail;
+        cell->payload.string.character = c;
+        cell->payload.string.cdr = tail;
 
-    cell->payload.string.hash = calculate_hash( c, tail );
-  } else {
-    // \todo should throw an exception!
-    debug_printf( DEBUG_ALLOC,
-                  L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
-                  tag, tag );
-  }
+        cell->payload.string.hash = calculate_hash( c, tail );
+    } else {
+        // \todo should throw an exception!
+        debug_printf( DEBUG_ALLOC,
+                      L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
+                      tag, tag );
+    }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -328,7 +336,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
  * @param tail the string which is being built.
  */
 struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
-  return make_string_like_thing( c, tail, STRINGTV );
+    return make_string_like_thing( c, tail, STRINGTV );
 }
 
 /**
@@ -341,45 +349,51 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
  */
 struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
                                         uint32_t tag ) {
-  struct cons_pointer result;
+    struct cons_pointer result;
 
-  if ( tag == SYMBOLTV || tag == KEYTV ) {
-    result = make_string_like_thing( c, tail, tag );
+    if ( tag == SYMBOLTV || tag == KEYTV ) {
+        result = make_string_like_thing( c, tail, tag );
 
-    if ( tag == KEYTV ) {
-      struct cons_pointer r = internedp( result, oblist );
+        if ( tag == KEYTV ) {
+            struct cons_pointer r = internedp( result, oblist );
 
-      if ( nilp( r ) ) {
-        intern( result, oblist );
-      } else {
-        result = r;
-      }
+            if ( nilp( r ) ) {
+                intern( result, oblist );
+            } else {
+                result = r;
+            }
+        }
+    } else {
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( L"Unexpected tag when making symbol or key." ),
+                            NIL );
     }
-  } else {
-    result = make_exception(
-        c_string_to_lisp_string( L"Unexpected tag when making symbol or key." ), 
-        NIL);
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Construct a cell which points to an executable Lisp special form.
  */
-struct cons_pointer make_special(
-    struct cons_pointer meta,
-    struct cons_pointer ( *executable )( struct stack_frame *frame,
-                                         struct cons_pointer,
-                                         struct cons_pointer env ) ) {
-  struct cons_pointer pointer = allocate_cell( SPECIALTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
-  inc_ref( meta );
+struct cons_pointer make_special( struct cons_pointer meta,
+                                  struct cons_pointer ( *executable ) ( struct
+                                                                        stack_frame
+                                                                        *frame,
+                                                                        struct
+                                                                        cons_pointer,
+                                                                        struct
+                                                                        cons_pointer
+                                                                        env ) ) 
+{
+    struct cons_pointer pointer = allocate_cell( SPECIALTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( meta );
 
-  cell->payload.special.meta = meta;
-  cell->payload.special.executable = executable;
+    cell->payload.special.meta = meta;
+    cell->payload.special.executable = executable;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -390,13 +404,13 @@ struct cons_pointer make_special(
  */
 struct cons_pointer make_read_stream( URL_FILE *input,
                                       struct cons_pointer metadata ) {
-  struct cons_pointer pointer = allocate_cell( READTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_pointer pointer = allocate_cell( READTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  cell->payload.stream.stream = input;
-  cell->payload.stream.meta = metadata;
+    cell->payload.stream.stream = input;
+    cell->payload.stream.meta = metadata;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -407,13 +421,13 @@ struct cons_pointer make_read_stream( URL_FILE *input,
  */
 struct cons_pointer make_write_stream( URL_FILE *output,
                                        struct cons_pointer metadata ) {
-  struct cons_pointer pointer = allocate_cell( WRITETV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_pointer pointer = allocate_cell( WRITETV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  cell->payload.stream.stream = output;
-  cell->payload.stream.meta = metadata;
+    cell->payload.stream.stream = output;
+    cell->payload.stream.meta = metadata;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -421,43 +435,43 @@ struct cons_pointer make_write_stream( URL_FILE *output,
  * keywords, I am accepting only lower case characters and numbers.
  */
 struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
-    wchar_t c = towlower( symbol[i] );
+    for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
+        wchar_t c = towlower( symbol[i] );
 
-    if ( iswalnum( c ) || c == L'-' ) {
-      result = make_keyword( c, result );
+        if ( iswalnum( c ) || c == L'-' ) {
+            result = make_keyword( c, result );
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Return a lisp string representation of this wide character string.
  */
 struct cons_pointer c_string_to_lisp_string( wchar_t *string ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
-    if ( iswprint( string[i] ) && string[i] != '"' ) {
-      result = make_string( string[i], result );
+    for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
+        if ( iswprint( string[i] ) && string[i] != '"' ) {
+            result = make_string( string[i], result );
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Return a lisp symbol representation of this wide character string.
  */
 struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( symbol ); i > 0; i-- ) {
-    result = make_symbol( symbol[i - 1], result );
-  }
+    for ( int i = wcslen( symbol ); i > 0; i-- ) {
+        result = make_symbol( symbol[i - 1], result );
+    }
 
-  return result;
+    return result;
 }
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 2bc5bb0..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -29,7 +29,7 @@
 #include "memory/vectorspace.h"
 
 
-void dump_string_cell( URL_FILE * output, wchar_t *prefix,
+void dump_string_cell( URL_FILE *output, wchar_t *prefix,
                        struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     if ( cell.payload.string.character == 0 ) {
@@ -56,7 +56,7 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix,
 /**
  * dump the object at this cons_pointer to this output stream.
  */
-void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
+void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n",
                   cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset,
@@ -114,10 +114,10 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c
index d268bd9..eaabca4 100644
--- a/src/memory/hashmap.c
+++ b/src/memory/hashmap.c
@@ -54,12 +54,12 @@ 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])){
+        if ( functionp( frame->arg[1] ) ) {
+            hash_fn = frame->arg[1];
+        } else if ( nilp( frame->arg[1] ) ) {
             /* that's allowed */
         } else {
-           result =
+            result =
                 make_exception( c_string_to_lisp_string
                                 ( L"Second arg to `hashmap`, if passed, must "
                                   L"be a function or `nil`.`" ), NIL );
@@ -88,8 +88,7 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
 
                 map->payload.hashmap.buckets[bucket_no] =
                     make_cons( make_cons( key, val ),
-                                        map->payload.hashmap.
-                                        buckets[bucket_no] );
+                               map->payload.hashmap.buckets[bucket_no] );
             }
         }
     }
@@ -114,7 +113,7 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
     struct cons_pointer val = frame->arg[2];
 
     struct cons_pointer result = hashmap_put( mapp, key, val );
-    struct cons_space_object *cell = &pointer2cell( result);
+    struct cons_space_object *cell = &pointer2cell( result );
     return result;
 
     // TODO: else clone and return clone.
@@ -136,7 +135,7 @@ struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame,
     return hashmap_keys( frame->arg[0] );
 }
 
-void dump_map( URL_FILE * output, struct cons_pointer pointer ) {
+void dump_map( URL_FILE *output, struct cons_pointer pointer ) {
     struct hashmap_payload *payload =
         &pointer_to_vso( pointer )->payload.hashmap;
     url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets );
diff --git a/src/memory/lookup3.c b/src/memory/lookup3.c
index 359cff2..043d703 100644
--- a/src/memory/lookup3.c
+++ b/src/memory/lookup3.c
@@ -170,7 +170,7 @@ and these came close:
  hashlittle() has to dance around fitting the key bytes into registers.
 --------------------------------------------------------------------
 */
-uint32_t hashword( const uint32_t * k,  /* the key, an array of uint32_t values */
+uint32_t hashword( const uint32_t *k, /* the key, an array of uint32_t values */
                    size_t length, /* the length of the key, in uint32_ts */
                    uint32_t initval ) { /* the previous hash, or an arbitrary value */
     uint32_t a, b, c;
@@ -213,10 +213,10 @@ both be initialized with seeds.  If you pass in (*pb)==0, the output
 (*pc) will be the same as the return value from hashword().
 --------------------------------------------------------------------
 */
-void hashword2( const uint32_t * k, /* the key, an array of uint32_t values */
+void hashword2( const uint32_t *k,  /* the key, an array of uint32_t values */
                 size_t length,  /* the length of the key, in uint32_ts */
-                uint32_t * pc,  /* IN: seed OUT: primary hash value */
-                uint32_t * pb ) { /* IN: more seed OUT: secondary hash value */
+                uint32_t *pc,   /* IN: seed OUT: primary hash value */
+                uint32_t *pb ) {  /* IN: more seed OUT: secondary hash value */
     uint32_t a, b, c;
 
     /* Set up the internal state */
@@ -538,8 +538,8 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval ) {
  */
 void hashlittle2( const void *key,  /* the key to hash */
                   size_t length,  /* length of the key */
-                  uint32_t * pc,  /* IN: primary initval, OUT: primary hash */
-                  uint32_t * pb ) { /* IN: secondary initval, OUT: secondary hash */
+                  uint32_t *pc, /* IN: primary initval, OUT: primary hash */
+                  uint32_t *pb ) {  /* IN: secondary initval, OUT: secondary hash */
     uint32_t a, b, c;           /* internal state */
     union {
         const void *ptr;
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 4b70ed1..bca9fa0 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -241,7 +241,7 @@ void free_stack_frame( struct stack_frame *frame ) {
  * @param output the stream
  * @param frame_pointer the pointer to the frame
  */
-void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) {
+void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
 
     if ( frame != NULL ) {
@@ -265,7 +265,7 @@ void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) {
     }
 }
 
-void dump_stack_trace( URL_FILE * output, struct cons_pointer pointer ) {
+void dump_stack_trace( URL_FILE *output, struct cons_pointer pointer ) {
     if ( exceptionp( pointer ) ) {
         print( output, pointer2cell( pointer ).payload.exception.payload );
         url_fputws( L"\n", output );
diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c
index c46c798..b8f0935 100644
--- a/src/memory/vectorspace.c
+++ b/src/memory/vectorspace.c
@@ -85,7 +85,7 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
 
     if ( vso != NULL ) {
         memset( vso, 0, padded );
-                vso->header.tag.value = tag;
+        vso->header.tag.value = tag;
 
         debug_printf( DEBUG_ALLOC,
                       L"make_vso: written tag '%4.4s' into vso at %p\n",
diff --git a/src/ops/intern.c b/src/ops/intern.c
index d2be616..b104e7e 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -191,20 +191,20 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
                   pair = c_car( assoc ) ) {
                 /* TODO: this is really hammering the memory management system, because
                  * it will make a new lone for every key/value pair added. Fix. */
-                if (consp( pair)) {
+                if ( consp( pair ) ) {
                     mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
-                } else if (hashmapp( pair)) {
-                    hashmap_put_all( mapp, pair);
+                } else if ( hashmapp( pair ) ) {
+                    hashmap_put_all( mapp, pair );
                 } else {
-                    hashmap_put( mapp, pair, TRUE);
+                    hashmap_put( mapp, pair, TRUE );
                 }
-                assoc = c_cdr( assoc);
+                assoc = c_cdr( assoc );
             }
-        } else if (hashmapp( assoc)) {
-            for (struct cons_pointer keys = hashmap_keys( assoc); !nilp( keys);
-                keys = c_cdr( keys)) {
-                struct cons_pointer key = c_car( keys);
-                hashmap_put( mapp, key, hashmap_get( assoc, key));
+        } else if ( hashmapp( assoc ) ) {
+            for ( struct cons_pointer keys = hashmap_keys( assoc );
+                  !nilp( keys ); keys = c_cdr( keys ) ) {
+                struct cons_pointer key = c_car( keys );
+                hashmap_put( mapp, key, hashmap_get( assoc, key ) );
             }
         }
     }
@@ -246,7 +246,8 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
                 result =
                     make_hashmap( from_pl.n_buckets, from_pl.hash_fn,
                                   from_pl.write_acl );
-                struct vector_space_object const *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++ ) {
@@ -257,9 +258,9 @@ 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 );
+            make_exception( c_string_to_lisp_string
+                            ( L"Arg to `clone_hashmap` must "
+                              L"be a readable hashmap.`" ), NIL );
     }
 
     return result;
@@ -299,9 +300,9 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         //     if ( equal( key, entry.payload.cons.car ) ) {
         //         result = entry.payload.cons.car;
         //     }
-        if (!nilp( c_assoc( key, store))) {
+        if ( !nilp( c_assoc( key, store ) ) ) {
             result = key;
-        } else if ( equal( key, privileged_symbol_nil)) {
+        } else if ( equal( key, privileged_symbol_nil ) ) {
             result = privileged_symbol_nil;
         }
     } else {
@@ -349,9 +350,10 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                         result = hashmap_get( entry_ptr, key );
                         break;
                     default:
-                        throw_exception( c_append(
-                            c_string_to_lisp_string( L"Store entry is of unknown type: " ),
-                            c_type( entry_ptr)), NIL);
+                        throw_exception( c_append
+                                         ( c_string_to_lisp_string
+                                           ( L"Store entry is of unknown type: " ),
+                                           c_type( entry_ptr ) ), NIL );
                 }
             }
         }
@@ -359,13 +361,13 @@ struct cons_pointer c_assoc( struct cons_pointer key,
         result = hashmap_get( store, key );
     } else if ( !nilp( store ) ) {
         debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-        debug_print_object( c_type( store), DEBUG_BIND );
+        debug_print_object( c_type( store ), DEBUG_BIND );
         debug_print( L"`\n", DEBUG_BIND );
         result =
-            throw_exception( 
-                c_append( 
-                    c_string_to_lisp_string( L"Store is of unknown type: " ),
-                    c_type( store)), NIL );
+            throw_exception( c_append
+                             ( c_string_to_lisp_string
+                               ( L"Store is of unknown type: " ),
+                               c_type( store ) ), NIL );
     }
 
     debug_print( L"c_assoc returning ", DEBUG_BIND );
@@ -419,14 +421,14 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     debug_dump_object( store, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    debug_printf( DEBUG_BIND, L"set: store is %s\n`", lisp_string_to_c_string( c_type( store)) );
-    if (nilp( value)) {
+    debug_printf( DEBUG_BIND, L"set: store is %s\n`",
+                  lisp_string_to_c_string( c_type( store ) ) );
+    if ( nilp( value ) ) {
         result = store;
-    }
-    else if ( nilp( store ) || consp( store ) ) {
+    } else if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
-        debug_print( L"set: storing in hashmap\n", DEBUG_BIND);
+        debug_print( L"set: storing in hashmap\n", DEBUG_BIND );
         result = hashmap_put( store, key, value );
     }
 
diff --git a/src/ops/intern.h b/src/ops/intern.h
index abc6f91..bc22bf7 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -36,7 +36,7 @@ struct cons_pointer hashmap_get( struct cons_pointer mapp,
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
                                  struct cons_pointer val );
-                
+
 struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
                                      struct cons_pointer assoc );
 
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index c0765cd..782afe0 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -446,9 +446,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.special.
-                              executable ) ( get_stack_frame( next_pointer ),
-                                             next_pointer, env );
+                            ( *fn_cell.payload.
+                              special.executable ) ( get_stack_frame
+                                                     ( next_pointer ),
+                                                     next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -1245,7 +1246,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1264,34 +1266,36 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env ) {
     struct cons_pointer expr = NIL;
-    
-    debug_printf(DEBUG_REPL, L"Entering new inner REPL\n");
+
+    debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
 //    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
-    
-    if (truep(frame->arg[0])) {
-        new_env = set( prompt_name, frame->arg[0], new_env);
+
+    if ( truep( frame->arg[0] ) ) {
+        new_env = set( prompt_name, frame->arg[0], new_env );
     }
-    if (readp(frame->arg[1])) {
-        new_env = set( c_string_to_lisp_symbol(L"*in*"), frame->arg[1], new_env);
+    if ( readp( frame->arg[1] ) ) {
+        new_env =
+            set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
         input = frame->arg[1];
     }
-    if (readp(frame->arg[2])) {
-        new_env = set( c_string_to_lisp_symbol(L"*out*"), frame->arg[2], new_env);
+    if ( readp( frame->arg[2] ) ) {
+        new_env =
+            set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
         output = frame->arg[2];
     }
-    
+
     inc_ref( input );
     inc_ref( output );
     inc_ref( prompt_name );
 
     URL_FILE *os = pointer2cell( output ).payload.stream.stream;
 
-    
+
     /* \todo this is subtly wrong. If we were evaluating
      *   (print (eval (read)))
      * then the stack frame for read would have the stack frame for
@@ -1353,10 +1357,10 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
-    dec_ref( new_env);
+    dec_ref( new_env );
+
+    debug_printf( DEBUG_REPL, L"Leaving inner repl\n" );
 
-    debug_printf(DEBUG_REPL, L"Leaving inner repl\n");
-    
     return expr;
 }
 
@@ -1426,13 +1430,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }
@@ -1588,8 +1593,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 //             }
 //         }
 //     }
-    
+
 
 
 //     return result;
-// }
\ No newline at end of file
+// }
diff --git a/src/repl.c b/src/repl.c
index 5295465..8ae0b43 100644
--- a/src/repl.c
+++ b/src/repl.c
@@ -23,15 +23,15 @@
  * 
  * @param dummy 
  */
-void int_handler(int dummy) {
-    wprintf(L"TODO: handle ctrl-C in a more interesting way\n");
+void int_handler( int dummy ) {
+    wprintf( L"TODO: handle ctrl-C in a more interesting way\n" );
 }
 
 /**
  * The read/eval/print loop.
  */
 void repl(  ) {
-    signal(SIGINT, int_handler);
+    signal( SIGINT, int_handler );
     debug_print( L"Entered repl\n", DEBUG_REPL );
 
     struct cons_pointer env =
diff --git a/state-of-play.md b/state-of-play.md
deleted file mode 100644
index 18fca93..0000000
--- a/state-of-play.md
+++ /dev/null
@@ -1,274 +0,0 @@
-# State of Play
-
-## 20260204
-
-### Testing what is leaking memory
-
-#### Analysis
-
-If you just start up and immediately abort the current build of psse, you get:
-
-> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
-
-Allocation summaries from the current unit tests give the following ranges of values:
-
-|                 | Min   | Max   |      |
-| --------------- | ----- | ----- | ---- |
-| Allocated       | 19991 | 39009 |      |
-| Deallocated     |   238 |  1952 |      |
-| Not deallocated | 19741 | 37057 |      |
-
-The numbers go up broadly in sinc with one another — that is to say, broadly, as the number allocated rises, so do both the numbers deallocated and the numbers not deallocated. But not exactly.
-
-#### Strategy: what doesn't get cleaned up?
-
-Write a test wrapper which reads a file of forms, one per line, from standard input, and passes each in turn to a fresh invocation of psse, reporting the form and the allocation summary.
-
-```bash
-#1/bin/bash
-
-while IFS= read -r form; do
-    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation`
-    echo "* ${allocation}: ${form}"
-done
-```
-
-So, from this:
-
-* Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.: 
-* Allocation summary: allocated 19990; deallocated 249; not deallocated 19741.: ()
-* Allocation summary: allocated 20019; deallocated 253; not deallocated 19766.: nil
-
-Allocating an empty list allocates four additional cells, all of which are deallocated. Allocating 'nil' allocates a further **29** cells, 25 of which are not deallocated. WTF?
-
-Following further work I have this, showing the difference added to the base case of cells allocated, cells deallocated, and, most critically, cells not deallocated.
-
-From this we see that reading and printing `nil` allocates an additional 33 cells, of which eight are not cleaned up. That's startling, and worrying.
-
-But the next row shows us that reading and printing an empty list costs only four cells, each of which is cleaned up. Further down the table we see that an empty map is also correctly cleaned up. Where we're leaking memory is in reading (or printing, although I doubt this) symbols, either atoms, numbers, or keywords (I haven't yet tried strings, but I expect they're similar.)
-
-| **Case**                          | **Delta Allocated** | **Delta Deallocated** | **Delta Not Deallocated** |
-| --------------------------------- | ------------------- | --------------------- | ------------------------- |
-| **Basecase**                      | 0                   | 0                     | 0                         |
-| **nil**                           | 33                  | 8                     | 25                        |
-| **()**                            | 4                   | 4                     | 0                         |
-| **(quote ())**                    | 39                  | 2                     | 37                        |
-| **(list )**                       | 37                  | 12                    | 25                        |
-| **(list 1)**                      | 47                  | 14                    | 33                        |
-| **(list 1 1)**                    | 57                  | 16                    | 41                        |
-| **(list 1 1 1)**                  | 67                  | 18                    | 49                        |
-| **(list 1 2 3)**                  | 67                  | 18                    | 49                        |
-| **(+)**                           | 36                  | 10                    | 26                        |
-| **(+ 1)**                         | 44                  | 12                    | 32                        |
-| **(+ 1 1)**                       | 53                  | 14                    | 39                        |
-| **(+ 1 1 1)**                     | 62                  | 16                    | 46                        |
-| **(+ 1 2 3)**                     | 62                  | 16                    | 46                        |
-| **(list 'a 'a 'a)**               | 151                 | 33                    | 118                       |
-| **(list 'a 'b 'c)**               | 151                 | 33                    | 118                       |
-| **(list :a :b :c)**               | 121                 | 15                    | 106                       |
-| **(list :alpha :bravo :charlie)** | 485                 | 15                    | 470                       |
-| **{}**                            | 6                   | 6                     | 0                         |
-| **{:z 0}**                        | 43                  | 10                    | 33                        |
-| **{:zero 0}**                     | 121                 | 10                    | 111                       |
-| **{:z 0 :o 1}**                   | 80                  | 11                    | 69                        |
-| **{:zero 0 :one 1}**              | 210                 | 14                    | 196                       |
-| **{:z 0 :o 1 :t 2}**              | 117                 | 12                    | 105                       |
-
-Looking at the entries, we see that
-
-1. each number read costs ten allocations, of which only two are successfully deallocated;
-2. the symbol `list` costs 33 cells, of which 25 are not deallocated, whereas the symbol `+` costs only one cell fewer, and an additional cell is not deallocated. So it doesn't seem that cell allocation scales with the length of the symbol;
-3. Keyword allocation does scale with the length of the keyword, apparently, since `(list :a :b :c)` allocates 121 and deallocates 15, while `(list :alpha :bravo :charlie)` allocates 485 and deallocates the same 15;
-4. The fact that both those two deallocate 15, and a addition of three numbers `(+ 1 2 3)` or `(+ 1 1 1)` deallocates 16 suggest to me that the list structure is being fully reclaimed but atoms are not being. 
-5. The atom `'a` costs more to read than the keyword `:a` because the reader macro is expanding `'a` to `(quote a)` behind the scenes.
-
-### The integer allocation bug
-
-Looking at what happens when we read a single digit  number, we get the following:
-
-```
-2
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 507 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 507 count 0
-                Integer cell: value 0, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 508 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 508 count 0
-                Integer cell: value 10, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 509 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 509 count 0
-                Integer cell: value 2, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 510 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 510 count 0
-                Integer cell: value 0, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 506 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 506 count 0
-                Integer cell: value 0, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 505 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 505 count 0
-                Integer cell: value 0, count 0
-Entering make_integer
-Allocated cell of type 'INTR' at 19, 504 
-make_integer: returning
-        INTR (1381256777) at page 19, offset 504 count 0
-                Integer cell: value 0, count 0
-
-Allocated cell of type 'STRG' at 19, 503 
-Freeing cell    STRG (1196577875) at page 19, offset 503 count 0
-                String cell: character '2' (50) with hash 0; next at page 0 offset 0, count 0
-                 value: "2"
-Freeing cell    INTR (1381256777) at page 19, offset 504 count 0
-                Integer cell: value 2, count 0
-2
-Allocated cell of type 'SYMB' at 19, 504 
-Allocated cell of type 'SYMB' at 19, 503 
-Allocated cell of type 'SYMB' at 19, 502 
-Allocated cell of type 'SYMB' at 19, 501 
-Freeing cell    SYMB (1112365395) at page 19, offset 501 count 0
-                Symbol cell: character '*' (42) with hash 485100; next at page 19 offset 502, count 0
-                 value: *in*
-Freeing cell    SYMB (1112365395) at page 19, offset 502 count 0
-                Symbol cell: character 'i' (105) with hash 11550; next at page 19 offset 503, count 0
-                 value: in*
-Freeing cell    SYMB (1112365395) at page 19, offset 503 count 0
-                Symbol cell: character 'n' (110) with hash 110; next at page 19 offset 504, count 0
-                 value: n*
-Freeing cell    SYMB (1112365395) at page 19, offset 504 count 0
-                Symbol cell: character '*' (42) with hash 0; next at page 0 offset 0, count 0
-                 value: *
-```
-
-Many things are worrying here.
-
-1. The only thing being freed here is the symbol to which the read stream is bound — and I didn't see where that got allocated, but we shouldn't be allocating and tearing down a symbol for every read! This implies that when I create a string with `c_string_to_lisp_string`, I need to make damn sure that that string is deallocated as soon as I'm done with it — and wherever I'm dealing with symbols which will be referred to repeatedly in `C` code, I need either
-   1.  to bind a global on the C side of the world, which will become messy;
-   2. or else write a hash function which returns, for a `C` string, the same value that the standard hashing function will return for the lexically equivalent `Lisp` string, so that I can search hashmap structures from C without having to allocate and deallocate a fresh copy of the `Lisp` string;
-   3. In reading numbers, I'm generating a fresh instance of `Lisp zero` and `Lisp ten`, each time `read_integer` is called, and I'm not deallocating them.
-   4. I am correctly deallocating the number I did read, though!
-
-## 20260203
-
-I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
-
-### Hashmaps, assoc lists, and generalised key/value stores
-
-I now have the oblist working as a hashmap, and also hybrid assoc lists which incorporate hashmaps working. I don't 100% have consistent methods for reading stores which may be plain old assoc lists, new hybrid assoc lists, or hashmaps working but it isn't far off. This also takes me streets further towards doing hierarchies of hashmaps, allowing my namespace idea to work — and hybrid assoc lists provide a very sound basis for building environment structures.
-
-Currently all hashmaps are mutable, and my doctrine is that that is fixable when access control lists are actually implemented. 
-
-#### assoc
-
-The function `(assoc store key) => value` should be the standard way of getting a value out of a store.  
-
-#### put!
-
-The function `(put! store key value) => store` should become the standard way of setting a value in a store (of course, if the store is an assoc list or an immutable map, a new store will be returned which holds the additional key/value binding).
-
-### State of unit tests
-
-Currently:
-
-> Tested 45, passed 39, failed 6
-
-But the failures are as follows:
-```
-unit-tests/bignum-add.sh => checking a bignum was created: Fail
-unit-tests/bignum-add.sh => adding 1152921504606846977 to 1: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 1152921504606846977: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1152921504606846977 to 1152921504606846977: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 10000000000000000000 to 10000000000000000000: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 1329227995784915872903807060280344576: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 3064991081731777716716694054300618367237478244367204352: Fail: expected 't', got 'nil'
-unit-tests/bignum-expt.sh => (expt 2 60): Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got '2'
-unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got '16'
-unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got '32'
-unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '2'
-unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '1151321504605245376'
-unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '1'
-unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '0'
-unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '2'
-unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '1'
-unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '-376293541461622793'
-unit-tests/memory.sh
-```
-
-In other words, all failures are in bignum arithmetic **except** that I still have a major memory leak due to not decrefing somewhere where I ought to.
-
-### Zig
-
-I've also experimented with autotranslating my C into Zig, but this failed. Although I don't think C is the right language for implementing my base Lisp in, it's what I've got; and until I can get some form of autotranslate to bootstrap me into some more modern systems language, I think I need to stick with it.
-
-## 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 263 nor 264.
-
-|                |                      |      |
-| -------------- | -------------------- | ---- |
-| 262 | 4611686018427387904  |      |
-| 263 | 9223372036854775808  |      |
-| 264 | 18446744073709551616 |      |
-| Mystery number | 1152921504606846976  |      |
-
-In fact, our mystery number turns out (by inspection) to be 260. But **why**?

From 367f00295185e14f6548c1fc984e09b1370034ae Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Feb 2026 20:00:48 +0000
Subject: [PATCH 52/90] Moved `state-of-play.md` into docs.

---
 .gitignore            |  13 +-
 docs/state-of-play.md | 366 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 377 insertions(+), 2 deletions(-)
 create mode 100644 docs/state-of-play.md

diff --git a/.gitignore b/.gitignore
index b07b2a6..a9d1e3e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,7 @@
 
-*.d
+**/*.d
 
-*.o
+**/*.o
 
 target/
 
@@ -46,3 +46,12 @@ core
 .kdev4/
 
 post-scarcity.kdev4
+
+\.calva/
+\.clj-kondo/
+\.lsp/
+\.portal/
+\.settings/
+\.zig-cache/
+sq/
+tmp/
diff --git a/docs/state-of-play.md b/docs/state-of-play.md
new file mode 100644
index 0000000..a596456
--- /dev/null
+++ b/docs/state-of-play.md
@@ -0,0 +1,366 @@
+# State of Play
+
+## 20260214
+
+### Memory leaks
+
+The amount I'm leaking memory is now down by an order of magnitude, but the problem is not fixed. 
+Better, not good enough. And although I'm aware of the amount to which Lisp objects are not being
+reclaimed, there may also be transient C objects — cheifly strings — which are also
+not being freed. This is an ongoing process. 
+
+But you'll remember that a week ago my base case was:
+
+> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
+
+Now it's 
+
+> Allocation summary: allocated 1188; deallocated 10; not deallocated 1178.
+
+That is better.
+
+### Unit tests
+
+The unit test system got into a mess because the bignum tests are failing. But because I know
+some tests are failing, and the bignum problem feels so intractable that I don't want to 
+tackle it, I've been ignoring the fact that tests are failing; which means I've
+missed regressions — until I started to get an 'Attempt to take value of unbound symbol' 
+exception for `nil`, which is extremely serious and broke a lot of things.
+
+That arose out of work on the 'generalised key/value stores' feature, logged under 
+[#20260203](20260203), below. However, because I wasn't paying attention to failing tests, it
+took me a week to find and fix it.
+
+But I've fixed that one. And I've put a lot of work into [cleaning up the unit tests](https://git.journeyman.cc/simon/post-scarcity/commit/222368bf640a0b79d57322878dee42ed58b47bd6).
+There is more work to do on this.
+
+### Documentation
+
+I'm also gradually working through cleaning up documentation.
+
+### Regressions
+
+Meantime we have some regressions which are serious, and must be resolved.
+
+#### equals
+
+The core function `equals` is now failing, at least for integers. Also.
+
+```lisp
+(= 0.75 3/4)
+```
+
+fails because I've never implemented a method for it, which I ought.
+
+#### cond
+
+The current unit test for `cond` and that for `recursion` both fail but *I think* this is because `equals` is failing.
+
+#### rational arithmetic
+
+I have a horrible new regression in rational arithmetic which looks as though something is being freed when it shouldn't be.
+
+#### All tests failing as at 20260214
+
+As follows:
+
+1. unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got ''
+2. unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got ''
+3. unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got ''
+4. unit-tests/bignum-print.sh => unit-tests/bignum-print.sh => printing 576460752303423488: Fail: expected '576460752303423488', got '0'
+5. unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '0'
+6. unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '1'
+7. unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '0'
+8. unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '0'
+9. unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '4294967295'
+10. unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '0'
+11. unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '1'
+12. unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '0'
+13. unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '2313682944'
+14. unit-tests/cond.sh => unit-tests/cond.sh: cond with one clause... Fail: expected '5', got 'nil'
+15. unit-tests/memory.sh => Fail: expected '1188', got '10'
+16. unit-tests/ratio-addition.sh => Fail: expected '1/4', got 'Error: Unrecognised tag value 4539730 ( REE)'
+17. unit-tests/recursion.sh => Fail: expected 'nil 3,628,800', got ''
+
+### New master version
+
+I haven't done a 'release' of Post Scarcity since September 2021, because I've 
+been so despondent about the bignum problem. But actually a lot of this *is*
+usable, and it's at least sufficiently intereting that other people might want
+to play with it, and possibly even might fix some bugs.
+
+So I'm currently planning to release a new master before the end of this month,
+and publicise it.
+
+## 20260204
+
+### Testing what is leaking memory
+
+#### Analysis
+
+If you just start up and immediately abort the current build of psse, you get:
+
+> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
+
+Allocation summaries from the current unit tests give the following ranges of values:
+
+|                 | Min   | Max   |      |
+| --------------- | ----- | ----- | ---- |
+| Allocated       | 19991 | 39009 |      |
+| Deallocated     |   238 |  1952 |      |
+| Not deallocated | 19741 | 37057 |      |
+
+The numbers go up broadly in sinc with one another — that is to say, broadly, as the number allocated rises, so do both the numbers deallocated and the numbers not deallocated. But not exactly.
+
+#### Strategy: what doesn't get cleaned up?
+
+Write a test wrapper which reads a file of forms, one per line, from standard input, and passes each in turn to a fresh invocation of psse, reporting the form and the allocation summary.
+
+```bash
+#1/bin/bash
+
+while IFS= read -r form; do
+    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation`
+    echo "* ${allocation}: ${form}"
+done
+```
+
+So, from this:
+
+* Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.: 
+* Allocation summary: allocated 19990; deallocated 249; not deallocated 19741.: ()
+* Allocation summary: allocated 20019; deallocated 253; not deallocated 19766.: nil
+
+Allocating an empty list allocates four additional cells, all of which are deallocated. Allocating 'nil' allocates a further **29** cells, 25 of which are not deallocated. WTF?
+
+Following further work I have this, showing the difference added to the base case of cells allocated, cells deallocated, and, most critically, cells not deallocated.
+
+From this we see that reading and printing `nil` allocates an additional 33 cells, of which eight are not cleaned up. That's startling, and worrying.
+
+But the next row shows us that reading and printing an empty list costs only four cells, each of which is cleaned up. Further down the table we see that an empty map is also correctly cleaned up. Where we're leaking memory is in reading (or printing, although I doubt this) symbols, either atoms, numbers, or keywords (I haven't yet tried strings, but I expect they're similar.)
+
+| **Case**                          | **Delta Allocated** | **Delta Deallocated** | **Delta Not Deallocated** |
+| --------------------------------- | ------------------- | --------------------- | ------------------------- |
+| **Basecase**                      | 0                   | 0                     | 0                         |
+| **nil**                           | 33                  | 8                     | 25                        |
+| **()**                            | 4                   | 4                     | 0                         |
+| **(quote ())**                    | 39                  | 2                     | 37                        |
+| **(list )**                       | 37                  | 12                    | 25                        |
+| **(list 1)**                      | 47                  | 14                    | 33                        |
+| **(list 1 1)**                    | 57                  | 16                    | 41                        |
+| **(list 1 1 1)**                  | 67                  | 18                    | 49                        |
+| **(list 1 2 3)**                  | 67                  | 18                    | 49                        |
+| **(+)**                           | 36                  | 10                    | 26                        |
+| **(+ 1)**                         | 44                  | 12                    | 32                        |
+| **(+ 1 1)**                       | 53                  | 14                    | 39                        |
+| **(+ 1 1 1)**                     | 62                  | 16                    | 46                        |
+| **(+ 1 2 3)**                     | 62                  | 16                    | 46                        |
+| **(list 'a 'a 'a)**               | 151                 | 33                    | 118                       |
+| **(list 'a 'b 'c)**               | 151                 | 33                    | 118                       |
+| **(list :a :b :c)**               | 121                 | 15                    | 106                       |
+| **(list :alpha :bravo :charlie)** | 485                 | 15                    | 470                       |
+| **{}**                            | 6                   | 6                     | 0                         |
+| **{:z 0}**                        | 43                  | 10                    | 33                        |
+| **{:zero 0}**                     | 121                 | 10                    | 111                       |
+| **{:z 0 :o 1}**                   | 80                  | 11                    | 69                        |
+| **{:zero 0 :one 1}**              | 210                 | 14                    | 196                       |
+| **{:z 0 :o 1 :t 2}**              | 117                 | 12                    | 105                       |
+
+Looking at the entries, we see that
+
+1. each number read costs ten allocations, of which only two are successfully deallocated;
+2. the symbol `list` costs 33 cells, of which 25 are not deallocated, whereas the symbol `+` costs only one cell fewer, and an additional cell is not deallocated. So it doesn't seem that cell allocation scales with the length of the symbol;
+3. Keyword allocation does scale with the length of the keyword, apparently, since `(list :a :b :c)` allocates 121 and deallocates 15, while `(list :alpha :bravo :charlie)` allocates 485 and deallocates the same 15;
+4. The fact that both those two deallocate 15, and a addition of three numbers `(+ 1 2 3)` or `(+ 1 1 1)` deallocates 16 suggest to me that the list structure is being fully reclaimed but atoms are not being. 
+5. The atom `'a` costs more to read than the keyword `:a` because the reader macro is expanding `'a` to `(quote a)` behind the scenes.
+
+### The integer allocation bug
+
+Looking at what happens when we read a single digit  number, we get the following:
+
+```
+2
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 507 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 507 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 508 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 508 count 0
+                Integer cell: value 10, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 509 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 509 count 0
+                Integer cell: value 2, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 510 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 510 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 506 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 506 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 505 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 505 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 504 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 0, count 0
+
+Allocated cell of type 'STRG' at 19, 503 
+Freeing cell    STRG (1196577875) at page 19, offset 503 count 0
+                String cell: character '2' (50) with hash 0; next at page 0 offset 0, count 0
+                 value: "2"
+Freeing cell    INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 2, count 0
+2
+Allocated cell of type 'SYMB' at 19, 504 
+Allocated cell of type 'SYMB' at 19, 503 
+Allocated cell of type 'SYMB' at 19, 502 
+Allocated cell of type 'SYMB' at 19, 501 
+Freeing cell    SYMB (1112365395) at page 19, offset 501 count 0
+                Symbol cell: character '*' (42) with hash 485100; next at page 19 offset 502, count 0
+                 value: *in*
+Freeing cell    SYMB (1112365395) at page 19, offset 502 count 0
+                Symbol cell: character 'i' (105) with hash 11550; next at page 19 offset 503, count 0
+                 value: in*
+Freeing cell    SYMB (1112365395) at page 19, offset 503 count 0
+                Symbol cell: character 'n' (110) with hash 110; next at page 19 offset 504, count 0
+                 value: n*
+Freeing cell    SYMB (1112365395) at page 19, offset 504 count 0
+                Symbol cell: character '*' (42) with hash 0; next at page 0 offset 0, count 0
+                 value: *
+```
+
+Many things are worrying here.
+
+1. The only thing being freed here is the symbol to which the read stream is bound — and I didn't see where that got allocated, but we shouldn't be allocating and tearing down a symbol for every read! This implies that when I create a string with `c_string_to_lisp_string`, I need to make damn sure that that string is deallocated as soon as I'm done with it — and wherever I'm dealing with symbols which will be referred to repeatedly in `C` code, I need either
+   1.  to bind a global on the C side of the world, which will become messy;
+   2. or else write a hash function which returns, for a `C` string, the same value that the standard hashing function will return for the lexically equivalent `Lisp` string, so that I can search hashmap structures from C without having to allocate and deallocate a fresh copy of the `Lisp` string;
+   3. In reading numbers, I'm generating a fresh instance of `Lisp zero` and `Lisp ten`, each time `read_integer` is called, and I'm not deallocating them.
+   4. I am correctly deallocating the number I did read, though!
+
+## 20260203
+
+I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
+
+### Hashmaps, assoc lists, and generalised key/value stores
+
+I now have the oblist working as a hashmap, and also hybrid assoc lists which incorporate hashmaps working. I don't 100% have consistent methods for reading stores which may be plain old assoc lists, new hybrid assoc lists, or hashmaps working but it isn't far off. This also takes me streets further towards doing hierarchies of hashmaps, allowing my namespace idea to work — and hybrid assoc lists provide a very sound basis for building environment structures.
+
+Currently all hashmaps are mutable, and my doctrine is that that is fixable when access control lists are actually implemented. 
+
+#### assoc
+
+The function `(assoc store key) => value` should be the standard way of getting a value out of a store.  
+
+#### put!
+
+The function `(put! store key value) => store` should become the standard way of setting a value in a store (of course, if the store is an assoc list or an immutable map, a new store will be returned which holds the additional key/value binding).
+
+### State of unit tests
+
+Currently:
+
+> Tested 45, passed 39, failed 6
+
+But the failures are as follows:
+```
+unit-tests/bignum-add.sh => checking a bignum was created: Fail
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 10000000000000000000 to 10000000000000000000: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1329227995784915872903807060280344576: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 3064991081731777716716694054300618367237478244367204352: Fail: expected 't', got 'nil'
+unit-tests/bignum-expt.sh => (expt 2 60): Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got '2'
+unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got '16'
+unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got '32'
+unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '1151321504605245376'
+unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '1'
+unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '0'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '-376293541461622793'
+unit-tests/memory.sh
+```
+
+In other words, all failures are in bignum arithmetic **except** that I still have a major memory leak due to not decrefing somewhere where I ought to.
+
+### Zig
+
+I've also experimented with autotranslating my C into Zig, but this failed. Although I don't think C is the right language for implementing my base Lisp in, it's what I've got; and until I can get some form of autotranslate to bootstrap me into some more modern systems language, I think I need to stick with it.
+
+## 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 263 nor 264.
+
+|                |                      |      |
+| -------------- | -------------------- | ---- |
+| 262 | 4611686018427387904  |      |
+| 263 | 9223372036854775808  |      |
+| 264 | 18446744073709551616 |      |
+| Mystery number | 1152921504606846976  |      |
+
+In fact, our mystery number turns out (by inspection) to be 260. But **why**?

From 219f082885cd3142ac700da779852c8dbc8f9b43 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Feb 2026 20:36:07 +0000
Subject: [PATCH 53/90] Redone fixes to unit tests which I know I did this
 afternoon, so I've messed up git somehow.

---
 unit-tests/empty-list.sh        | 2 +-
 unit-tests/empty-string.sh      | 2 +-
 unit-tests/eval-integer.sh      | 2 +-
 unit-tests/eval-quote-sexpr.sh  | 3 ++-
 unit-tests/eval-quote-symbol.sh | 2 +-
 unit-tests/eval-real.sh         | 2 +-
 unit-tests/eval-string.sh       | 2 +-
 unit-tests/fred.sh              | 2 +-
 unit-tests/integer.sh           | 2 +-
 unit-tests/interpreter.sh       | 2 +-
 unit-tests/nlambda.sh           | 2 +-
 unit-tests/path-notation.sh     | 3 +--
 12 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/unit-tests/empty-list.sh b/unit-tests/empty-list.sh
index 8f0f702..2588202 100755
--- a/unit-tests/empty-list.sh
+++ b/unit-tests/empty-list.sh
@@ -7,7 +7,7 @@
 #
 
 expected=nil
-actual=`echo "'()" | target/psse | tail -1`
+actual=`echo "'()" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/empty-string.sh b/unit-tests/empty-string.sh
index a1e5baa..bdd7dfd 100755
--- a/unit-tests/empty-string.sh
+++ b/unit-tests/empty-string.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="\"\""
-actual=`echo '""' | target/psse | tail -1`
+actual=`echo '""' | target/psse 2>/dev/null | tail -1`
 
 if [ "$expected" = "$actual" ]
 then
diff --git a/unit-tests/eval-integer.sh b/unit-tests/eval-integer.sh
index 1aadb39..6e93628 100755
--- a/unit-tests/eval-integer.sh
+++ b/unit-tests/eval-integer.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='5'
-actual=`echo "(eval 5)" | target/psse | tail -1`
+actual=`echo "(eval 5)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/eval-quote-sexpr.sh b/unit-tests/eval-quote-sexpr.sh
index d83bbe8..9b3099d 100755
--- a/unit-tests/eval-quote-sexpr.sh
+++ b/unit-tests/eval-quote-sexpr.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='5'
-actual=`echo "(eval '(add 2 3))" | target/psse | tail -1`
+actual=`echo "(eval '(add 2 3))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -10,3 +10,4 @@ else
     echo "Fail: expected '${expected}', got '${actual}'"
     exit 1
 fi
+ 2>/dev/null
\ No newline at end of file
diff --git a/unit-tests/eval-quote-symbol.sh b/unit-tests/eval-quote-symbol.sh
index e977461..1f25241 100755
--- a/unit-tests/eval-quote-symbol.sh
+++ b/unit-tests/eval-quote-symbol.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected=''
-actual=`echo "(eval 'cond)" | target/psse | tail -1`
+actual=`echo "(eval 'cond)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/eval-real.sh b/unit-tests/eval-real.sh
index 3aa16d7..965d445 100755
--- a/unit-tests/eval-real.sh
+++ b/unit-tests/eval-real.sh
@@ -3,7 +3,7 @@
 # for this test, trailing zeros can be ignored
 expected='5.05'
 actual=`echo "(eval 5.05)" |\
-  target/psse 2> /dev/null |\
+  target/psse 2>/dev/null |\
   sed 's/0*$//' |\
   tail -1`
 
diff --git a/unit-tests/eval-string.sh b/unit-tests/eval-string.sh
index 90f6f2c..95b987d 100755
--- a/unit-tests/eval-string.sh
+++ b/unit-tests/eval-string.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"5"'
-actual=`echo '(eval "5")' | target/psse | tail -1`
+actual=`echo '(eval "5")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/fred.sh b/unit-tests/fred.sh
index 8e3d513..82691b6 100755
--- a/unit-tests/fred.sh
+++ b/unit-tests/fred.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"Fred"'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/integer.sh b/unit-tests/integer.sh
index 18ae66e..3a1e542 100755
--- a/unit-tests/integer.sh
+++ b/unit-tests/integer.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='354'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/interpreter.sh b/unit-tests/interpreter.sh
index 6f23fc9..a9c95bc 100755
--- a/unit-tests/interpreter.sh
+++ b/unit-tests/interpreter.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='6'
-actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse | tail -1`
+actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/nlambda.sh b/unit-tests/nlambda.sh
index 68f0447..117c633 100755
--- a/unit-tests/nlambda.sh
+++ b/unit-tests/nlambda.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='a'
-actual=`echo "((nlambda (x) x) a)" | target/psse | tail -1`
+actual=`echo "((nlambda (x) x) a)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/path-notation.sh b/unit-tests/path-notation.sh
index cbb9dea..3ba2e99 100755
--- a/unit-tests/path-notation.sh
+++ b/unit-tests/path-notation.sh
@@ -5,10 +5,9 @@ result=0
 #####################################################################
 # Create a path from root using compact path notation
 echo -n "$0: Create a path from root using compact path notation... "
-expected='(-> oblist :users :simon :functions (quote assoc))'
+expected='(-> (oblist) :users :simon :functions (quote assoc))'
 actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
 
-echo -n "Path from root (oblist) using compact notation: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"

From b97401bfde020bc2a6eda7223737b83bdfcd40e1 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 15 Feb 2026 00:50:30 +0000
Subject: [PATCH 54/90] Work on the equality of numbers. The good news: two
 additional unit tests pass. The bad news: I'm getting segfaults.

---
 src/arith/integer.c |  18 ----
 src/ops/equal.c     | 207 ++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 202 insertions(+), 23 deletions(-)

diff --git a/src/arith/integer.c b/src/arith/integer.c
index 5452107..01fc8fb 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -521,21 +521,3 @@ bool equal_integer_integer( struct cons_pointer a, struct cons_pointer b ) {
 
     return result;
 }
-
-/**
- * true if `a` is an integer, and `b` is a real number whose value is the
- * value of that integer.
- */
-bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) {
-    bool result = false;
-
-    if ( integerp( a ) && realp( b ) ) {
-        long double bv = pointer2cell( b ).payload.real.value;
-
-        if ( floor( bv ) == bv ) {
-            result = pointer2cell( a ).payload.integer.value == ( int64_t ) bv;
-        }
-    }
-
-    return result;
-}
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 39d80af..4c713e8 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -15,6 +15,7 @@
 #include "arith/integer.h"
 #include "arith/peano.h"
 #include "arith/ratio.h"
+#include "debug.h"
 
 /**
  * Shallow, and thus cheap, equality: true if these two objects are
@@ -48,11 +49,209 @@ bool end_of_string( struct cons_pointer string ) {
         pointer2cell( string ).payload.string.character == '\0';
 }
 
+/**
+ * @brief compare two long doubles and returns true if they are the same to
+ * within a tolerance of one part in a million.
+ * 
+ * @param a 
+ * @param b 
+ * @return true if `a` and `b` are equal to within one part in a million.
+ * @return false otherwise.
+ */
+bool equal_ld_ld( long double a, long double b) {
+    long double fa = fabsl( a);
+    long double fb = fabsl( b);
+    /* difference of magnitudes */
+    long double diff = fabsl( fa - fb);
+    /* average magnitude of the two */
+    long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
+    /* amount of difference we will tolerate for equality */
+    long double tolerance = av * 0.0000001;
+
+    bool result = ( fabsl( a - b) < tolerance);
+
+    debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
+
+    return result;
+}
+
+/**
+ * @brief Private function, don't use. It depends on its arguments being 
+ * numbers and doesn't sanity check them.
+ * 
+ * @param a a lisp integer -- if it isn't an integer, things will break.
+ * @param b a lisp real -- if it isn't a real, things will break.
+ * @return true if the two numbers have equal value.
+ * @return false if they don't.
+ */
+bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
+    debug_print( L"\nequal_integer_real: ", DEBUG_ARITH);
+    debug_print_object( a, DEBUG_ARITH);
+    debug_print( L" = ", DEBUG_ARITH);
+    debug_print_object( b, DEBUG_ARITH);
+    bool result = false;
+    struct cons_space_object * cell_a = &pointer2cell( a);
+    struct cons_space_object * cell_b = & pointer2cell( b);
+
+    if (nilp( cell_a->payload.integer.more)) {
+        result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value);
+    } else {
+        fwprintf( stderr, L"\nequality is not yet implemented for bignums compared to reals.");
+    }
+
+    debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", result );
+
+    return result;
+}
+
+/**
+ * @brief Private function, don't use. It depends on its arguments being 
+ * numbers and doesn't sanity check them.
+ * 
+ * @param a a lisp integer -- if it isn't an integer, things will break.
+ * @param b a lisp number.
+ * @return true if the two numbers have equal value.
+ * @return false if they don't.
+ */
+bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
+    debug_print( L"\nequal_integer_number: ", DEBUG_ARITH);
+    debug_print_object( a, DEBUG_ARITH);
+    debug_print( L" = ", DEBUG_ARITH);
+    debug_print_object( b, DEBUG_ARITH);
+    bool result = false;
+    struct cons_space_object * cell_b = & pointer2cell( b);
+
+    switch ( cell_b->tag.value) {
+        case INTEGERTV:
+            result = equal_integer_integer( a, b);
+            break;
+        case REALTV: 
+            result = equal_integer_real( a, b);
+            break;
+        case RATIOTV:
+            result = false;
+            break;
+    }
+        
+    debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", result );
+
+    return result;
+}
+
+/**
+ * @brief Private function, don't use. It depends on its arguments being 
+ * numbers and doesn't sanity check them.
+ * 
+ * @param a a lisp real -- if it isn't an real, things will break.
+ * @param b a lisp number.
+ * @return true if the two numbers have equal value.
+ * @return false if they don't.
+ */
+bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
+    debug_print( L"\nequal_real_number: ", DEBUG_ARITH);
+    debug_print_object( a, DEBUG_ARITH);
+    debug_print( L" = ", DEBUG_ARITH);
+    debug_print_object( b, DEBUG_ARITH);
+    bool result = false;
+    struct cons_space_object * cell_b = & pointer2cell( b);
+
+    switch ( cell_b->tag.value) {
+        case INTEGERTV:
+            result = equal_integer_real( b, a);
+            break;
+        case REALTV: {
+                struct cons_space_object * cell_a = & pointer2cell( a);
+                result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
+            }
+            break;
+        case RATIOTV: {
+                struct cons_space_object * cell_a = & pointer2cell( a);
+                struct cons_pointer dv = cell_a->payload.ratio.divisor;
+                struct cons_space_object * dv_cell = &pointer2cell( dv);
+                struct cons_pointer dd = cell_a->payload.ratio.dividend;
+                struct cons_space_object * dd_cell = &pointer2cell( dd);
+                
+                if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
+                    long double bv = ((long double) dv_cell->payload.integer.value) / ((long double) dd_cell->payload.integer.value);
+                    result = equal_ld_ld( bv, cell_a->payload.real.value);
+                } else {
+                    fwprintf( stderr, L"\nequality is not yet implemented for bignums rationals compared to reals.");
+                }
+            }
+            break;
+        }
+
+        debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
+
+    return result;
+}
+
+/**
+ * @brief Private function, don't use. It depends on its arguments being 
+ * numbers and doesn't sanity check them.
+ * 
+ * @param a a number
+ * @param b a number
+ * @return true if the two numbers have equal value.
+ * @return false if they don't.
+ */
+bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
+    bool result = eq( a, b );
+
+    debug_print( L"\nequal_number_number: ", DEBUG_ARITH);
+    debug_print_object( a, DEBUG_ARITH);
+    debug_print( L" = ", DEBUG_ARITH);
+    debug_print_object( b, DEBUG_ARITH);
+
+    if ( !result ) {
+        struct cons_space_object * cell_a = & pointer2cell( a);
+        struct cons_space_object * cell_b = & pointer2cell( b);
+
+        switch ( cell_a->tag.value) {
+            case INTEGERTV: 
+                result = equal_integer_number( a, b);
+                break;
+            case REALTV:
+                result = equal_real_number( a, b);
+                break;
+            case RATIOTV:
+                switch( cell_b->tag.value) {
+                    case INTEGERTV:
+                        /* as all ratios are simplified by make_ratio, any
+                         * ratio that would simplify to an integer is an
+                         * integer, */
+                        result = false;
+                        break;
+                    case REALTV:
+                        result = equal_real_number( b, a);
+                        break;
+                    case RATIOTV:
+                        result = equal_ratio_ratio( a, b);
+                        break;
+                    /* can't throw an exception from here, but non-numbers
+                     * shouldn't have been passed in anyway, so no default. */
+                }
+                break;
+                /* can't throw an exception from here, but non-numbers
+                 * shouldn't have been passed in anyway, so no default. */
+        }
+    }
+
+    debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", result );
+
+    return result;
+}
+ 
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
  */
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
+    debug_print( L"\nequal: ", DEBUG_ARITH);
+    debug_print_object( a, DEBUG_ARITH);
+    debug_print( L" = ", DEBUG_ARITH);
+    debug_print_object( b, DEBUG_ARITH);
+
     bool result = eq( a, b );
 
     if ( !result && same_type( a, b ) ) {
@@ -121,11 +320,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 break;
         }
     } else if ( numberp( a ) && numberp( b ) ) {
-        if ( integerp( a ) ) {
-            result = equal_integer_real( a, b );
-        } else if ( integerp( b ) ) {
-            result = equal_integer_real( b, a );
-        }
+        result = equal_number_number( a, b);
     }
 
     /*
@@ -136,5 +331,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
+    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
+
     return result;
 }

From d7e02206742339adef9455c9c0b0f90219bec210 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 15 Feb 2026 13:30:27 +0000
Subject: [PATCH 55/90] Arithmetic equality fixed.

---
 src/arith/peano.c | 26 ++++++++++++++
 src/arith/peano.h |  3 ++
 src/arith/ratio.c | 90 +++++++++++++++++++++++++++++++++++++++++------
 src/arith/ratio.h |  2 ++
 src/init.c        |  2 ++
 src/ops/equal.c   | 21 +++--------
 6 files changed, 117 insertions(+), 27 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index ae23a00..1a43f55 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -748,3 +748,29 @@ struct cons_pointer lisp_divide( struct
 
     return result;
 }
+
+/**
+ * @brief Function: return a real (approcimately) equal in value to the ratio 
+ * which is the first argument.
+ * 
+ * @param frame 
+ * @param frame_pointer 
+ * @param env 
+ * @return struct cons_pointer a pointer to a real
+ */
+// struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
+//            struct cons_pointer env )
+struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
+    struct cons_pointer env) {
+    struct cons_pointer result = NIL;
+    struct cons_pointer rat = frame->arg[0];
+
+    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
+    debug_print_object( rat, DEBUG_ARITH);
+
+    if ( ratiop( rat)) {
+        result = make_real( c_ratio_to_ld( rat));
+    } // TODO: else throw an exception?
+
+    return result;
+}
\ No newline at end of file
diff --git a/src/arith/peano.h b/src/arith/peano.h
index 5e83f0c..8b2908c 100644
--- a/src/arith/peano.h
+++ b/src/arith/peano.h
@@ -75,4 +75,7 @@ struct cons_pointer
 lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
              struct cons_pointer env );
 
+struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
+    struct cons_pointer env);
+
 #endif /* PEANO_H */
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 5608717..9c7c524 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -11,15 +11,17 @@
 #include 
 #include 
 
+#include "arith/integer.h"
+#include "arith/peano.h"
+#include "arith/ratio.h"
+#include "arith/real.h"
+#include "debug.h"
+#include "io/print.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "debug.h"
+#include "memory/stack.h"
 #include "ops/equal.h"
-#include "arith/integer.h"
 #include "ops/lispops.h"
-#include "arith/peano.h"
-#include "io/print.h"
-#include "arith/ratio.h"
 
 
 /**
@@ -91,11 +93,10 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                      struct cons_pointer arg2 ) {
     struct cons_pointer r, result;
 
-    debug_print( L"add_ratio_ratio( arg1 = ", DEBUG_ARITH );
-    debug_print_object( arg1, DEBUG_ARITH );
-    debug_print( L"; arg2 = ", DEBUG_ARITH );
-    debug_print_object( arg2, DEBUG_ARITH );
-    debug_print( L")\n", DEBUG_ARITH );
+    debug_print( L"\naadd_ratio_ratio: ", DEBUG_ARITH);
+    debug_print_object( arg1, DEBUG_ARITH);
+    debug_print( L" + ", DEBUG_ARITH);
+    debug_print_object( arg2, DEBUG_ARITH);
 
     if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
         struct cons_space_object cell1 = pointer2cell( arg1 );
@@ -111,7 +112,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
             lcm = least_common_multiple( dr1v, dr2v ),
             m1 = lcm / dr1v, m2 = lcm / dr2v;
 
-        debug_printf( DEBUG_ARITH, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm,
+        debug_printf( DEBUG_ARITH, L"; lcm = %ld; m1 = %ld; m2 = %ld", lcm,
                       m1, m2 );
 
         if ( dr1v == dr2v ) {
@@ -170,6 +171,11 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
                                        struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
+    debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH);
+    debug_print_object( intarg, DEBUG_ARITH);
+    debug_print( L" + ", DEBUG_ARITH);
+    debug_print_object( ratarg, DEBUG_ARITH);
+
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: not longer works
         struct cons_pointer one = acquire_integer( 1, NIL ),
@@ -188,6 +194,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
                                                               NIL ) ) ), NIL );
     }
 
+    debug_print( L" => ", DEBUG_ARITH );
+    debug_print_object( result, DEBUG_ARITH );
+    debug_print( L"\n", DEBUG_ARITH );
+
     return result;
 }
 
@@ -199,6 +209,10 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
                                         struct cons_pointer arg2 ) {
+    debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH);
+    debug_print_object( arg1, DEBUG_ARITH);
+    debug_print( L" / ", DEBUG_ARITH);
+    debug_print_object( arg2, DEBUG_ARITH);
     // TODO: this now has to work if `arg1` is an integer
     struct cons_pointer i =
         make_ratio( pointer2cell( arg2 ).payload.ratio.divisor,
@@ -207,6 +221,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
 
     dec_ref( i );
 
+    debug_print( L" => ", DEBUG_ARITH );
+    debug_print_object( result, DEBUG_ARITH );
+    debug_print( L"\n", DEBUG_ARITH );
+
     return result;
 }
 
@@ -259,6 +277,10 @@ struct cons_pointer multiply_ratio_ratio( struct
                              NIL );
     }
 
+    debug_print( L" => ", DEBUG_ARITH );
+    debug_print_object( result, DEBUG_ARITH );
+    debug_print( L"\n", DEBUG_ARITH );
+
     return result;
 }
 
@@ -272,6 +294,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
                                             struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
+    debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH);
+    debug_print_object( intarg, DEBUG_ARITH);
+    debug_print( L" * ", DEBUG_ARITH);
+    debug_print_object( ratarg, DEBUG_ARITH);
+
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: no longer works; fix
         struct cons_pointer one = acquire_integer( 1, NIL ),
@@ -286,6 +313,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
                              NIL );
     }
 
+    debug_print( L" => ", DEBUG_ARITH );
+    debug_print_object( result, DEBUG_ARITH );
+    debug_print( L"\n", DEBUG_ARITH );
+
     return result;
 }
 
@@ -298,6 +329,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
                                           struct cons_pointer arg2 ) {
+    debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH);
+    debug_print_object( arg1, DEBUG_ARITH);
+    debug_print( L" * ", DEBUG_ARITH);
+    debug_print_object( arg2, DEBUG_ARITH);
+
     struct cons_pointer i = negative( arg2 ),
         result = add_ratio_ratio( arg1, i );
 
@@ -361,3 +397,35 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
 
     return result;
 }
+
+/**
+ * @brief convert a ratio to an equivalent long double.
+ * 
+ * @param rat a pointer to a ratio.
+ * @return long double 
+ */
+long double c_ratio_to_ld( struct cons_pointer rat) {
+    long double result = NAN;
+
+    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
+    debug_print_object( rat, DEBUG_ARITH);
+
+    if ( ratiop( rat)) {
+        struct cons_space_object * cell_a = & pointer2cell( rat);
+        struct cons_pointer dv = cell_a->payload.ratio.divisor;
+        struct cons_space_object * dv_cell = &pointer2cell( dv);
+        struct cons_pointer dd = cell_a->payload.ratio.dividend;
+        struct cons_space_object * dd_cell = &pointer2cell( dd);
+        
+        if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
+            result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);;
+        } else {
+            fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals.");
+        } 
+    }
+
+    debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result );
+
+    return result;
+}
+
diff --git a/src/arith/ratio.h b/src/arith/ratio.h
index 9068bfb..8d93f44 100644
--- a/src/arith/ratio.h
+++ b/src/arith/ratio.h
@@ -36,4 +36,6 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
 
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
 
+long double c_ratio_to_ld( struct cons_pointer rat);
+
 #endif
diff --git a/src/init.c b/src/init.c
index 912ba45..2d3d394 100644
--- a/src/init.c
+++ b/src/init.c
@@ -20,6 +20,7 @@
 /* libcurl, used for io */
 #include 
 
+#include "arith/ratio.h"
 #include "version.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
@@ -347,6 +348,7 @@ int main( int argc, char *argv[] ) {
     bind_function( L"print", &lisp_print );
     bind_function( L"put!", lisp_hashmap_put );
     bind_function( L"put-all!", &lisp_hashmap_put_all );
+    bind_function( L"ratio->real", &lisp_ratio_to_real );
     bind_function( L"read", &lisp_read );
     bind_function( L"read-char", &lisp_read_char );
     bind_function( L"repl", &lisp_repl );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 4c713e8..0b21060 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -51,11 +51,11 @@ bool end_of_string( struct cons_pointer string ) {
 
 /**
  * @brief compare two long doubles and returns true if they are the same to
- * within a tolerance of one part in a million.
+ * within a tolerance of one part in a billion.
  * 
  * @param a 
  * @param b 
- * @return true if `a` and `b` are equal to within one part in a million.
+ * @return true if `a` and `b` are equal to within one part in a billion.
  * @return false otherwise.
  */
 bool equal_ld_ld( long double a, long double b) {
@@ -66,7 +66,7 @@ bool equal_ld_ld( long double a, long double b) {
     /* average magnitude of the two */
     long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
     /* amount of difference we will tolerate for equality */
-    long double tolerance = av * 0.0000001;
+    long double tolerance = av * 0.000000001;
 
     bool result = ( fabsl( a - b) < tolerance);
 
@@ -164,20 +164,9 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
                 result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
             }
             break;
-        case RATIOTV: {
+        case RATIOTV: 
                 struct cons_space_object * cell_a = & pointer2cell( a);
-                struct cons_pointer dv = cell_a->payload.ratio.divisor;
-                struct cons_space_object * dv_cell = &pointer2cell( dv);
-                struct cons_pointer dd = cell_a->payload.ratio.dividend;
-                struct cons_space_object * dd_cell = &pointer2cell( dd);
-                
-                if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
-                    long double bv = ((long double) dv_cell->payload.integer.value) / ((long double) dd_cell->payload.integer.value);
-                    result = equal_ld_ld( bv, cell_a->payload.real.value);
-                } else {
-                    fwprintf( stderr, L"\nequality is not yet implemented for bignums rationals compared to reals.");
-                }
-            }
+                result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value);
             break;
         }
 

From 169afc9eb4761a4fe158db206147d3250225ed91 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 15 Feb 2026 17:38:54 +0000
Subject: [PATCH 56/90] add_ratio_ratio fixed.

---
 docs/state-of-play.md     | 22 ++++++++++++
 src/arith/ratio.c         | 73 ++++++++++-----------------------------
 unit-tests/bignum-expt.sh | 26 +++++++-------
 3 files changed, 53 insertions(+), 68 deletions(-)

diff --git a/docs/state-of-play.md b/docs/state-of-play.md
index a596456..3562cc6 100644
--- a/docs/state-of-play.md
+++ b/docs/state-of-play.md
@@ -1,5 +1,27 @@
 # State of Play
 
+## 20260215
+
+Both of yesterday's regressions are fixed. Memory problem still in much the 
+same state.
+
+> Allocation summary: allocated 1210; deallocated 10; not deallocated 1200.
+
+That left the add ratios problem which was deeper. I had unintended unterminated 
+recursion happening there. :-(
+
+It burned through 74 cons pages each of 1,024 cons cells, total 76,800 cells, 
+and 19,153 stack frames. before it got there; and then threw the exception back
+up through each of those 19,153 stack frames. But the actual exception message
+was `Unrecognised tag value 0 (    )`, which is not enormously helpful.
+
+However, once I had recognised what the problem was, it was quickly fixed, with
+the added bonus that the new solution will automatically work for bignum 
+fractions once bignums are working.
+
+So we're down to eight unit tests failing: the memory leak, one unimplemented 
+feature, and the bignum problem.
+
 ## 20260214
 
 ### Memory leaks
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 9c7c524..80aff8f 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -25,7 +25,7 @@
 
 
 /**
- * return, as a int64_t, the greatest common divisor of `m` and `n`,
+ * @brief return, as an int64_t, the greatest common divisor of `m` and `n`,
  */
 int64_t greatest_common_divisor( int64_t m, int64_t n ) {
     int o;
@@ -39,7 +39,7 @@ int64_t greatest_common_divisor( int64_t m, int64_t n ) {
 }
 
 /**
- * return, as a int64_t, the least common multiple of `m` and `n`,
+ * @brief return, as an int64_t, the least common multiple of `m` and `n`,
  */
 int64_t least_common_multiple( int64_t m, int64_t n ) {
     return m / greatest_common_divisor( m, n ) * n;
@@ -64,7 +64,7 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
 
             if ( gcd > 1 ) {
                 if ( drrv / gcd == 1 ) {
-                    result = acquire_integer( ddrv / gcd, NIL );
+                    result = acquire_integer( (int64_t)(ddrv / gcd), NIL );
                 } else {
                     debug_printf( DEBUG_ARITH,
                                   L"simplify_ratio: %ld/%ld => %ld/%ld\n",
@@ -91,61 +91,26 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
  */
 struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                      struct cons_pointer arg2 ) {
-    struct cons_pointer r, result;
+    struct cons_pointer r;
 
-    debug_print( L"\naadd_ratio_ratio: ", DEBUG_ARITH);
+    debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH);
     debug_print_object( arg1, DEBUG_ARITH);
     debug_print( L" + ", DEBUG_ARITH);
     debug_print_object( arg2, DEBUG_ARITH);
 
     if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
-        struct cons_space_object cell1 = pointer2cell( arg1 );
-        struct cons_space_object cell2 = pointer2cell( arg2 );
-        int64_t dd1v =
-            pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
-            dd2v =
-            pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
-            dr1v =
-            pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
-            dr2v =
-            pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
-            lcm = least_common_multiple( dr1v, dr2v ),
-            m1 = lcm / dr1v, m2 = lcm / dr2v;
-
-        debug_printf( DEBUG_ARITH, L"; lcm = %ld; m1 = %ld; m2 = %ld", lcm,
-                      m1, m2 );
-
-        if ( dr1v == dr2v ) {
-            r = make_ratio( acquire_integer( dd1v + dd2v, NIL ),
-                            cell1.payload.ratio.divisor );
-        } else {
-            struct cons_pointer dd1vm = acquire_integer( dd1v * m1, NIL ),
-                dr1vm = acquire_integer( dr1v * m1, NIL ),
-                dd2vm = acquire_integer( dd2v * m2, NIL ),
-                dr2vm = acquire_integer( dr2v * m2, NIL ),
-                r1 = make_ratio( dd1vm, dr1vm ),
-                r2 = make_ratio( dd2vm, dr2vm );
-
-            r = add_ratio_ratio( r1, r2 );
-
-            if ( !eq( r, r1 ) ) {
-                dec_ref( r1 );
-            }
-            if ( !eq( r, r2 ) ) {
-                dec_ref( r2 );
-            }
-
-            /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
-             * never incremented except when making r1 and r2, decrementing
-             * r1 and r2 should be enought to garbage collect them. */
-        }
-
-        result = simplify_ratio( r );
-        if ( !eq( r, result ) ) {
-            dec_ref( r );
-        }
+        struct cons_space_object * cell1 = &pointer2cell( arg1 );
+        struct cons_space_object * cell2 = &pointer2cell( arg2 );
+        
+        struct cons_pointer divisor = multiply_integers( cell1->payload.ratio.divisor, cell2->payload.ratio.divisor );
+        struct cons_pointer dividend = add_integers( 
+            multiply_integers( cell1->payload.ratio.dividend, 
+                cell2->payload.ratio.divisor),
+            multiply_integers( cell2->payload.ratio.dividend, 
+                cell1->payload.ratio.divisor));
+            r = make_ratio( dividend, divisor );
     } else {
-        result =
+        r =
             throw_exception( make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
@@ -153,11 +118,11 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                              NIL );
     }
 
-    debug_print( L" => ", DEBUG_ARITH );
-    debug_print_object( result, DEBUG_ARITH );
+    debug_print( L"add_ratio_ratio => ", DEBUG_ARITH );
+    debug_print_object( r, DEBUG_ARITH );
     debug_print( L"\n", DEBUG_ARITH );
 
-    return result;
+    return r;
 }
 
 
diff --git a/unit-tests/bignum-expt.sh b/unit-tests/bignum-expt.sh
index 878acd3..aa76af7 100755
--- a/unit-tests/bignum-expt.sh
+++ b/unit-tests/bignum-expt.sh
@@ -1,13 +1,13 @@
 #!/bin/bash
 
-return=0
+result=0
 
 #####################################################################
 # last 'smallnum' value:
 # sbcl calculates (expt 2 59) => 576460752303423488
 expected='576460752303423488'
 
-output=`target/psse </dev/null < 1152921504606846976
 expected='1152921504606846976'
 
-output=`target/psse </dev/null < 2305843009213693952
 expected='2305843009213693952'
 
-output=`target/psse </dev/null < 18446744073709551616
 expected='18446744073709551616'
 
-output=`target/psse </dev/null < 36893488147419103232
 expected='36893488147419103232'
 
-output=`target/psse </dev/null <
Date: Sun, 15 Feb 2026 23:47:28 +0000
Subject: [PATCH 57/90] Added a flag, `simplify` to the arg list of
 `make_ratio`, so that we can create ratios which would otherwise somplify to
 integers, in order to make ratio arithmetic easier.

---
 Makefile              |   1 +
 docs/state-of-play.md |  21 +++++++
 src/arith/peano.c     |  43 ++++++-------
 src/arith/peano.h     |   5 +-
 src/arith/ratio.c     | 140 ++++++++++++++++++++++-------------------
 src/arith/ratio.h     |   5 +-
 src/io/io.c           |   4 +-
 src/io/read.c         |   6 +-
 src/memory/dump.c     |   8 +--
 src/ops/equal.c       | 141 ++++++++++++++++++++++--------------------
 src/ops/lispops.c     |  19 +++---
 11 files changed, 213 insertions(+), 180 deletions(-)

diff --git a/Makefile b/Makefile
index 85c8b8f..7c55be3 100644
--- a/Makefile
+++ b/Makefile
@@ -30,6 +30,7 @@ $(TARGET): $(OBJS) Makefile
 
 doc: $(SRCS) Makefile Doxyfile
 	doxygen
+	tar czvf target/doc.tgz doc
 
 format: $(SRCS) $(HDRS) Makefile
 ifeq ($(shell uname -s), Darwin)
diff --git a/docs/state-of-play.md b/docs/state-of-play.md
index 3562cc6..50c4cec 100644
--- a/docs/state-of-play.md
+++ b/docs/state-of-play.md
@@ -22,6 +22,27 @@ fractions once bignums are working.
 So we're down to eight unit tests failing: the memory leak, one unimplemented 
 feature, and the bignum problem.
 
+At the end of the day I decided to chew up some memory by doing a series of 
+moderately large computations, to see how much memory is being successfully 
+deallocated.
+
+```lisp
+:: (mapcar fact '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20))
+
+(1 2 6 24 120 720 5,040 40,320 362,880 3,628,800 39,916,800 479,001,600 
+1,932,053,504 1,278,945,280 2,004,310,016 2,004,189,184 4,006,445,056 
+3,396,534,272 109,641,728 2,192,834,560)
+:: 
+
+Allocation summary: allocated 10136; deallocated 548; not deallocated 9588.
+```
+
+So, about 5%. This is still a major problem, and is making me doubt my reference
+counting strategy. Must do better!
+
+Note that the reason that the numbers become eratic past about two billion is 
+the bignum arithmetic bug.
+
 ## 20260214
 
 ### Memory leaks
diff --git a/src/arith/peano.c b/src/arith/peano.c
index 1a43f55..f2c81e0 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -99,7 +99,7 @@ struct cons_pointer absolute( struct cons_pointer arg ) {
                 break;
             case RATIOTV:
                 result = make_ratio( absolute( cell.payload.ratio.dividend ),
-                                     cell.payload.ratio.divisor );
+                                     cell.payload.ratio.divisor, false );
                 break;
             case REALTV:
                 result = make_real( 0 - cell.payload.real.value );
@@ -504,7 +504,7 @@ struct cons_pointer negative( struct cons_pointer arg ) {
             break;
         case RATIOTV:
             result = make_ratio( negative( cell.payload.ratio.dividend ),
-                                 cell.payload.ratio.divisor );
+                                 cell.payload.ratio.divisor, false );
             break;
         case REALTV:
             result = make_real( 0 - to_long_double( arg ) );
@@ -566,7 +566,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 case RATIOTV:{
                         struct cons_pointer tmp = make_ratio( arg1,
                                                               make_integer( 1,
-                                                                            NIL ) );
+                                                                            NIL ), false );
                         inc_ref( tmp );
                         result = subtract_ratio_ratio( tmp, arg2 );
                         dec_ref( tmp );
@@ -592,7 +592,7 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 case INTEGERTV:{
                         struct cons_pointer tmp = make_ratio( arg2,
                                                               make_integer( 1,
-                                                                            NIL ) );
+                                                                            NIL ), false );
                         inc_ref( tmp );
                         result = subtract_ratio_ratio( arg1, tmp );
                         dec_ref( tmp );
@@ -670,21 +670,15 @@ struct cons_pointer lisp_divide( struct
                     result = frame->arg[1];
                     break;
                 case INTEGERTV:{
-                        struct cons_pointer unsimplified =
+                        result =
                             make_ratio( frame->arg[0],
-                                        frame->arg[1] );
-                        /* OK, if result may be unsimplified, we should not inc_ref it
-                         * - but if not, we should dec_ref it. */
-                        result = simplify_ratio( unsimplified );
-                        if ( !eq( unsimplified, result ) ) {
-                            dec_ref( unsimplified );
-                        }
+                                        frame->arg[1], true);
                     }
                     break;
                 case RATIOTV:{
                         struct cons_pointer one = make_integer( 1, NIL );
                         struct cons_pointer ratio =
-                            make_ratio( frame->arg[0], one );
+                            make_ratio( frame->arg[0], one, false );
                         inc_ref( ratio );
                         result = divide_ratio_ratio( ratio, frame->arg[1] );
                         dec_ref( ratio );
@@ -709,11 +703,9 @@ struct cons_pointer lisp_divide( struct
                     break;
                 case INTEGERTV:{
                         struct cons_pointer one = make_integer( 1, NIL );
-                        inc_ref( one );
                         struct cons_pointer ratio =
-                            make_ratio( frame->arg[1], one );
-                        inc_ref( ratio );
-                        result = divide_ratio_ratio( frame->arg[0], ratio );
+                            make_ratio( frame->arg[1], one, false);
+                         result = divide_ratio_ratio( frame->arg[0], ratio );
                         dec_ref( ratio );
                         dec_ref( one );
                     }
@@ -760,17 +752,18 @@ struct cons_pointer lisp_divide( struct
  */
 // struct cons_pointer lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
 //            struct cons_pointer env )
-struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
-    struct cons_pointer env) {
+struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame,
+                                        struct cons_pointer frame_pointer,
+                                        struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     struct cons_pointer rat = frame->arg[0];
 
-    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
-    debug_print_object( rat, DEBUG_ARITH);
+    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH );
+    debug_print_object( rat, DEBUG_ARITH );
 
-    if ( ratiop( rat)) {
-        result = make_real( c_ratio_to_ld( rat));
-    } // TODO: else throw an exception?
+    if ( ratiop( rat ) ) {
+        result = make_real( c_ratio_to_ld( rat ) );
+    }                           // TODO: else throw an exception?
 
     return result;
-}
\ No newline at end of file
+}
diff --git a/src/arith/peano.h b/src/arith/peano.h
index 8b2908c..9e02a4d 100644
--- a/src/arith/peano.h
+++ b/src/arith/peano.h
@@ -75,7 +75,8 @@ struct cons_pointer
 lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
              struct cons_pointer env );
 
-struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame, struct cons_pointer frame_pointer,
-    struct cons_pointer env);
+struct cons_pointer lisp_ratio_to_real( struct stack_frame *frame,
+                                        struct cons_pointer frame_pointer,
+                                        struct cons_pointer env );
 
 #endif /* PEANO_H */
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 80aff8f..cf67e88 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -64,14 +64,15 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
 
             if ( gcd > 1 ) {
                 if ( drrv / gcd == 1 ) {
-                    result = acquire_integer( (int64_t)(ddrv / gcd), NIL );
+                    result =
+                        acquire_integer( ( int64_t ) ( ddrv / gcd ), NIL );
                 } else {
                     debug_printf( DEBUG_ARITH,
                                   L"simplify_ratio: %ld/%ld => %ld/%ld\n",
                                   ddrv, drrv, ddrv / gcd, drrv / gcd );
                     result =
                         make_ratio( acquire_integer( ddrv / gcd, NIL ),
-                                    acquire_integer( drrv / gcd, NIL ) );
+                                    acquire_integer( drrv / gcd, NIL ), false);
                 }
             }
         }
@@ -93,25 +94,26 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                      struct cons_pointer arg2 ) {
     struct cons_pointer r;
 
-    debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH);
-    debug_print_object( arg1, DEBUG_ARITH);
-    debug_print( L" + ", DEBUG_ARITH);
-    debug_print_object( arg2, DEBUG_ARITH);
+    debug_print( L"\nadd_ratio_ratio: ", DEBUG_ARITH );
+    debug_print_object( arg1, DEBUG_ARITH );
+    debug_print( L" + ", DEBUG_ARITH );
+    debug_print_object( arg2, DEBUG_ARITH );
 
     if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
-        struct cons_space_object * cell1 = &pointer2cell( arg1 );
-        struct cons_space_object * cell2 = &pointer2cell( arg2 );
-        
-        struct cons_pointer divisor = multiply_integers( cell1->payload.ratio.divisor, cell2->payload.ratio.divisor );
-        struct cons_pointer dividend = add_integers( 
-            multiply_integers( cell1->payload.ratio.dividend, 
-                cell2->payload.ratio.divisor),
-            multiply_integers( cell2->payload.ratio.dividend, 
-                cell1->payload.ratio.divisor));
-            r = make_ratio( dividend, divisor );
+        struct cons_space_object *cell1 = &pointer2cell( arg1 );
+        struct cons_space_object *cell2 = &pointer2cell( arg2 );
+
+        struct cons_pointer divisor =
+            multiply_integers( cell1->payload.ratio.divisor,
+                               cell2->payload.ratio.divisor );
+        struct cons_pointer dividend =
+            add_integers( multiply_integers( cell1->payload.ratio.dividend,
+                                             cell2->payload.ratio.divisor ),
+                          multiply_integers( cell2->payload.ratio.dividend,
+                                             cell1->payload.ratio.divisor ) );
+        r = make_ratio( dividend, divisor, true );
     } else {
-        r =
-            throw_exception( make_cons( c_string_to_lisp_string
+        r = throw_exception( make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -136,15 +138,14 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
                                        struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
-    debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH);
-    debug_print_object( intarg, DEBUG_ARITH);
-    debug_print( L" + ", DEBUG_ARITH);
-    debug_print_object( ratarg, DEBUG_ARITH);
+    debug_print( L"\nadd_integer_ratio: ", DEBUG_ARITH );
+    debug_print_object( intarg, DEBUG_ARITH );
+    debug_print( L" + ", DEBUG_ARITH );
+    debug_print_object( ratarg, DEBUG_ARITH );
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
-        // TODO: not longer works
         struct cons_pointer one = acquire_integer( 1, NIL ),
-            ratio = make_ratio( intarg, one );
+            ratio = make_ratio( intarg, one, false );
 
         result = add_ratio_ratio( ratio, ratarg );
 
@@ -174,14 +175,14 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
                                         struct cons_pointer arg2 ) {
-    debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH);
-    debug_print_object( arg1, DEBUG_ARITH);
-    debug_print( L" / ", DEBUG_ARITH);
-    debug_print_object( arg2, DEBUG_ARITH);
+    debug_print( L"\ndivide_ratio_ratio: ", DEBUG_ARITH );
+    debug_print_object( arg1, DEBUG_ARITH );
+    debug_print( L" / ", DEBUG_ARITH );
+    debug_print_object( arg2, DEBUG_ARITH );
     // TODO: this now has to work if `arg1` is an integer
     struct cons_pointer i =
         make_ratio( pointer2cell( arg2 ).payload.ratio.divisor,
-                    pointer2cell( arg2 ).payload.ratio.dividend ), result =
+                    pointer2cell( arg2 ).payload.ratio.dividend, false ), result =
         multiply_ratio_ratio( arg1, i );
 
     dec_ref( i );
@@ -226,15 +227,10 @@ struct cons_pointer multiply_ratio_ratio( struct
 
         struct cons_pointer dividend = acquire_integer( ddrv, NIL );
         struct cons_pointer divisor = acquire_integer( drrv, NIL );
-        struct cons_pointer unsimplified = make_ratio( dividend, divisor );
-        result = simplify_ratio( unsimplified );
-
+        result = make_ratio( dividend, divisor, true );
+        
         release_integer( dividend );
         release_integer( divisor );
-
-        if ( !eq( unsimplified, result ) ) {
-            dec_ref( unsimplified );
-        }
     } else {
         result =
             throw_exception( c_string_to_lisp_string
@@ -259,15 +255,14 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
                                             struct cons_pointer ratarg ) {
     struct cons_pointer result;
 
-    debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH);
-    debug_print_object( intarg, DEBUG_ARITH);
-    debug_print( L" * ", DEBUG_ARITH);
-    debug_print_object( ratarg, DEBUG_ARITH);
+    debug_print( L"\nmultiply_integer_ratio: ", DEBUG_ARITH );
+    debug_print_object( intarg, DEBUG_ARITH );
+    debug_print( L" * ", DEBUG_ARITH );
+    debug_print_object( ratarg, DEBUG_ARITH );
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
-        // TODO: no longer works; fix
         struct cons_pointer one = acquire_integer( 1, NIL ),
-            ratio = make_ratio( intarg, one );
+            ratio = make_ratio( intarg, one, false );
         result = multiply_ratio_ratio( ratio, ratarg );
 
         release_integer( one );
@@ -294,10 +289,10 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
  */
 struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
                                           struct cons_pointer arg2 ) {
-    debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH);
-    debug_print_object( arg1, DEBUG_ARITH);
-    debug_print( L" * ", DEBUG_ARITH);
-    debug_print_object( arg2, DEBUG_ARITH);
+    debug_print( L"\nsubtract_ratio_ratio: ", DEBUG_ARITH );
+    debug_print_object( arg1, DEBUG_ARITH );
+    debug_print( L" * ", DEBUG_ARITH );
+    debug_print_object( arg2, DEBUG_ARITH );
 
     struct cons_pointer i = negative( arg2 ),
         result = add_ratio_ratio( arg1, i );
@@ -315,7 +310,14 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
  * @exception if either `dividend` or `divisor` is not an integer.
  */
 struct cons_pointer make_ratio( struct cons_pointer dividend,
-                                struct cons_pointer divisor ) {
+                                struct cons_pointer divisor,
+                                bool simplify ) {
+    debug_print( L"make_ratio: dividend = ", DEBUG_ALLOC);
+    debug_print_object( dividend, DEBUG_ALLOC);
+    debug_print( L"; divisor = ", DEBUG_ALLOC);
+    debug_print_object( divisor, DEBUG_ALLOC);
+    debug_printf( DEBUG_ALLOC, L"; simplify = %d\n", simplify);
+
     struct cons_pointer result;
     if ( integerp( dividend ) && integerp( divisor ) ) {
         inc_ref( dividend );
@@ -325,9 +327,13 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         cell->payload.ratio.dividend = dividend;
         cell->payload.ratio.divisor = divisor;
 
-        result = simplify_ratio( unsimplified );
-        if ( !eq( result, unsimplified ) ) {
-            dec_ref( unsimplified );
+        if ( simplify) {
+            result = simplify_ratio( unsimplified );
+            if ( !eq( result, unsimplified ) ) {
+                dec_ref( unsimplified );
+            }
+        } else {
+            result = unsimplified;
         }
     } else {
         result =
@@ -335,8 +341,9 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
-    // debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
-    debug_dump_object( result, DEBUG_ARITH );
+    debug_print( L" => ", DEBUG_ALLOC);
+    debug_print_object( result, DEBUG_ALLOC );
+    debug_println( DEBUG_ALLOC);
 
     return result;
 }
@@ -369,28 +376,31 @@ bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
  * @param rat a pointer to a ratio.
  * @return long double 
  */
-long double c_ratio_to_ld( struct cons_pointer rat) {
+long double c_ratio_to_ld( struct cons_pointer rat ) {
     long double result = NAN;
 
-    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH);
-    debug_print_object( rat, DEBUG_ARITH);
+    debug_print( L"\nc_ratio_to_ld: ", DEBUG_ARITH );
+    debug_print_object( rat, DEBUG_ARITH );
 
-    if ( ratiop( rat)) {
-        struct cons_space_object * cell_a = & pointer2cell( rat);
+    if ( ratiop( rat ) ) {
+        struct cons_space_object *cell_a = &pointer2cell( rat );
         struct cons_pointer dv = cell_a->payload.ratio.divisor;
-        struct cons_space_object * dv_cell = &pointer2cell( dv);
+        struct cons_space_object *dv_cell = &pointer2cell( dv );
         struct cons_pointer dd = cell_a->payload.ratio.dividend;
-        struct cons_space_object * dd_cell = &pointer2cell( dd);
-        
-        if ( nilp( dv_cell->payload.integer.more) && nilp( dd_cell->payload.integer.more)) {
-            result = ((long double) dd_cell->payload.integer.value) / ((long double) dv_cell->payload.integer.value);;
+        struct cons_space_object *dd_cell = &pointer2cell( dd );
+
+        if ( nilp( dv_cell->payload.integer.more )
+             && nilp( dd_cell->payload.integer.more ) ) {
+            result =
+                ( ( long double ) dd_cell->payload.integer.value ) /
+                ( ( long double ) dv_cell->payload.integer.value );;
         } else {
-            fwprintf( stderr, L"real conversion is not yet implemented for bignums rationals.");
-        } 
+            fwprintf( stderr,
+                      L"real conversion is not yet implemented for bignums rationals." );
+        }
     }
 
     debug_printf( DEBUG_ARITH, L"\nc_ratio_to_ld returning %d\n", result );
 
     return result;
 }
-
diff --git a/src/arith/ratio.h b/src/arith/ratio.h
index 8d93f44..4ef0d24 100644
--- a/src/arith/ratio.h
+++ b/src/arith/ratio.h
@@ -32,10 +32,11 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
                                           struct cons_pointer arg2 );
 
 struct cons_pointer make_ratio( struct cons_pointer dividend,
-                                struct cons_pointer divisor );
+                                struct cons_pointer divisor,
+                                bool simplify );
 
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
 
-long double c_ratio_to_ld( struct cons_pointer rat);
+long double c_ratio_to_ld( struct cons_pointer rat );
 
 #endif
diff --git a/src/io/io.c b/src/io/io.c
index b7dc11c..aa960f0 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/io/read.c b/src/io/read.c
index 24a47fb..c103274 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -90,7 +90,7 @@ struct cons_pointer read_path( URL_FILE *input, wint_t initial,
 
     switch ( initial ) {
         case '/':
-            prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL);
+            prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL );
             break;
         case '$':
         case LSESSION:
@@ -370,7 +370,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
                                                                ( to_long_double
                                                                  ( base ),
                                                                  places_of_decimals ),
-                                                               NIL ) );
+                                                               NIL ), true);
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
@@ -378,7 +378,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
         dec_ref( div );
     } else if ( integerp( dividend ) ) {
         debug_print( L"read_number: converting result to ratio\n", DEBUG_IO );
-        result = make_ratio( dividend, result );
+        result = make_ratio( dividend, result, true );
     }
 
     if ( neg ) {
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 0b21060..105cc93 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -58,17 +58,17 @@ bool end_of_string( struct cons_pointer string ) {
  * @return true if `a` and `b` are equal to within one part in a billion.
  * @return false otherwise.
  */
-bool equal_ld_ld( long double a, long double b) {
-    long double fa = fabsl( a);
-    long double fb = fabsl( b);
+bool equal_ld_ld( long double a, long double b ) {
+    long double fa = fabsl( a );
+    long double fb = fabsl( b );
     /* difference of magnitudes */
-    long double diff = fabsl( fa - fb);
+    long double diff = fabsl( fa - fb );
     /* average magnitude of the two */
-    long double av = (fa > fb) ? ( fa - diff) : ( fb - diff);
+    long double av = ( fa > fb ) ? ( fa - diff ) : ( fb - diff );
     /* amount of difference we will tolerate for equality */
     long double tolerance = av * 0.000000001;
 
-    bool result = ( fabsl( a - b) < tolerance);
+    bool result = ( fabsl( a - b ) < tolerance );
 
     debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
 
@@ -84,22 +84,26 @@ bool equal_ld_ld( long double a, long double b) {
  * @return true if the two numbers have equal value.
  * @return false if they don't.
  */
-bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
-    debug_print( L"\nequal_integer_real: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
+bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ) {
+    debug_print( L"\nequal_integer_real: ", DEBUG_ARITH );
+    debug_print_object( a, DEBUG_ARITH );
+    debug_print( L" = ", DEBUG_ARITH );
+    debug_print_object( b, DEBUG_ARITH );
     bool result = false;
-    struct cons_space_object * cell_a = &pointer2cell( a);
-    struct cons_space_object * cell_b = & pointer2cell( b);
+    struct cons_space_object *cell_a = &pointer2cell( a );
+    struct cons_space_object *cell_b = &pointer2cell( b );
 
-    if (nilp( cell_a->payload.integer.more)) {
-        result = equal_ld_ld( (long double) cell_a->payload.integer.value, cell_b->payload.real.value);
+    if ( nilp( cell_a->payload.integer.more ) ) {
+        result =
+            equal_ld_ld( ( long double ) cell_a->payload.integer.value,
+                         cell_b->payload.real.value );
     } else {
-        fwprintf( stderr, L"\nequality is not yet implemented for bignums compared to reals.");
+        fwprintf( stderr,
+                  L"\nequality is not yet implemented for bignums compared to reals." );
     }
 
-    debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n", result );
+    debug_printf( DEBUG_ARITH, L"\nequal_integer_real returning %d\n",
+                  result );
 
     return result;
 }
@@ -114,26 +118,27 @@ bool equal_integer_real( struct cons_pointer a, struct cons_pointer b ){
  * @return false if they don't.
  */
 bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal_integer_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
+    debug_print( L"\nequal_integer_number: ", DEBUG_ARITH );
+    debug_print_object( a, DEBUG_ARITH );
+    debug_print( L" = ", DEBUG_ARITH );
+    debug_print_object( b, DEBUG_ARITH );
     bool result = false;
-    struct cons_space_object * cell_b = & pointer2cell( b);
+    struct cons_space_object *cell_b = &pointer2cell( b );
 
-    switch ( cell_b->tag.value) {
+    switch ( cell_b->tag.value ) {
         case INTEGERTV:
-            result = equal_integer_integer( a, b);
+            result = equal_integer_integer( a, b );
             break;
-        case REALTV: 
-            result = equal_integer_real( a, b);
+        case REALTV:
+            result = equal_integer_real( a, b );
             break;
         case RATIOTV:
             result = false;
             break;
     }
-        
-    debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n", result );
+
+    debug_printf( DEBUG_ARITH, L"\nequal_integer_number returning %d\n",
+                  result );
 
     return result;
 }
@@ -147,30 +152,33 @@ bool equal_integer_number( struct cons_pointer a, struct cons_pointer b ) {
  * @return true if the two numbers have equal value.
  * @return false if they don't.
  */
-bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
-    debug_print( L"\nequal_real_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
+bool equal_real_number( struct cons_pointer a, struct cons_pointer b ) {
+    debug_print( L"\nequal_real_number: ", DEBUG_ARITH );
+    debug_print_object( a, DEBUG_ARITH );
+    debug_print( L" = ", DEBUG_ARITH );
+    debug_print_object( b, DEBUG_ARITH );
     bool result = false;
-    struct cons_space_object * cell_b = & pointer2cell( b);
+    struct cons_space_object *cell_b = &pointer2cell( b );
 
-    switch ( cell_b->tag.value) {
+    switch ( cell_b->tag.value ) {
         case INTEGERTV:
-            result = equal_integer_real( b, a);
+            result = equal_integer_real( b, a );
             break;
-        case REALTV: {
-                struct cons_space_object * cell_a = & pointer2cell( a);
-                result = equal_ld_ld( cell_a->payload.real.value, cell_b->payload.real.value);
+        case REALTV:{
+                struct cons_space_object *cell_a = &pointer2cell( a );
+                result =
+                    equal_ld_ld( cell_a->payload.real.value,
+                                 cell_b->payload.real.value );
             }
             break;
-        case RATIOTV: 
-                struct cons_space_object * cell_a = & pointer2cell( a);
-                result = equal_ld_ld( c_ratio_to_ld( b), cell_a->payload.real.value);
+        case RATIOTV:
+            struct cons_space_object *cell_a = &pointer2cell( a );
+            result =
+                equal_ld_ld( c_ratio_to_ld( b ), cell_a->payload.real.value );
             break;
-        }
+    }
 
-        debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
+    debug_printf( DEBUG_ARITH, L"\nequal_real_number returning %d\n", result );
 
     return result;
 }
@@ -187,24 +195,24 @@ bool equal_real_number( struct cons_pointer a, struct cons_pointer b) {
 bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
     bool result = eq( a, b );
 
-    debug_print( L"\nequal_number_number: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
+    debug_print( L"\nequal_number_number: ", DEBUG_ARITH );
+    debug_print_object( a, DEBUG_ARITH );
+    debug_print( L" = ", DEBUG_ARITH );
+    debug_print_object( b, DEBUG_ARITH );
 
     if ( !result ) {
-        struct cons_space_object * cell_a = & pointer2cell( a);
-        struct cons_space_object * cell_b = & pointer2cell( b);
+        struct cons_space_object *cell_a = &pointer2cell( a );
+        struct cons_space_object *cell_b = &pointer2cell( b );
 
-        switch ( cell_a->tag.value) {
-            case INTEGERTV: 
-                result = equal_integer_number( a, b);
+        switch ( cell_a->tag.value ) {
+            case INTEGERTV:
+                result = equal_integer_number( a, b );
                 break;
             case REALTV:
-                result = equal_real_number( a, b);
+                result = equal_real_number( a, b );
                 break;
             case RATIOTV:
-                switch( cell_b->tag.value) {
+                switch ( cell_b->tag.value ) {
                     case INTEGERTV:
                         /* as all ratios are simplified by make_ratio, any
                          * ratio that would simplify to an integer is an
@@ -212,13 +220,13 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
                         result = false;
                         break;
                     case REALTV:
-                        result = equal_real_number( b, a);
+                        result = equal_real_number( b, a );
                         break;
                     case RATIOTV:
-                        result = equal_ratio_ratio( a, b);
+                        result = equal_ratio_ratio( a, b );
                         break;
-                    /* can't throw an exception from here, but non-numbers
-                     * shouldn't have been passed in anyway, so no default. */
+                        /* can't throw an exception from here, but non-numbers
+                         * shouldn't have been passed in anyway, so no default. */
                 }
                 break;
                 /* can't throw an exception from here, but non-numbers
@@ -226,20 +234,21 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
         }
     }
 
-    debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n", result );
+    debug_printf( DEBUG_ARITH, L"\nequal_number_number returning %d\n",
+                  result );
 
     return result;
 }
- 
+
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
  */
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal: ", DEBUG_ARITH);
-    debug_print_object( a, DEBUG_ARITH);
-    debug_print( L" = ", DEBUG_ARITH);
-    debug_print_object( b, DEBUG_ARITH);
+    debug_print( L"\nequal: ", DEBUG_ARITH );
+    debug_print_object( a, DEBUG_ARITH );
+    debug_print( L" = ", DEBUG_ARITH );
+    debug_print_object( b, DEBUG_ARITH );
 
     bool result = eq( a, b );
 
@@ -309,7 +318,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 break;
         }
     } else if ( numberp( a ) && numberp( b ) ) {
-        result = equal_number_number( a, b);
+        result = equal_number_number( a, b );
     }
 
     /*
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 782afe0..4584a9b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.
-                              special.executable ) ( get_stack_frame
-                                                     ( next_pointer ),
-                                                     next_pointer, env );
+                            ( *fn_cell.payload.special.
+                              executable ) ( get_stack_frame( next_pointer ),
+                                             next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -1246,8 +1245,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1430,14 +1428,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 70376c6529ae78b00353c44ba223b0830f0198be Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 20 Feb 2026 19:39:19 +0000
Subject: [PATCH 58/90] Careful debugging of the memory leak problem. At this
 stage, stack frames for interpreted (but not primitive) functions appear not
 to be being reclaimed, and the oblist doesn't seem to be being fully
 reclaimed.

---
 docs/Implementing-post-scarcity-hardware.md | 40 ++++++++-------
 docs/state-of-play.md                       | 56 ++++++++++++++++++++-
 lisp/defun.lisp                             |  6 +--
 lisp/fact.lisp                              |  2 +-
 src/arith/integer.c                         |  2 +-
 src/init.c                                  | 15 ++++--
 src/io/print.c                              |  3 ++
 src/memory/conspage.c                       |  9 ++--
 src/memory/consspaceobject.c                | 18 ++++++-
 src/memory/consspaceobject.h                |  5 ++
 src/memory/vectorspace.c                    |  6 ++-
 src/ops/equal.c                             | 10 +++-
 src/ops/intern.c                            | 24 ++++++---
 src/ops/lispops.c                           | 10 ++--
 14 files changed, 156 insertions(+), 50 deletions(-)

diff --git a/docs/Implementing-post-scarcity-hardware.md b/docs/Implementing-post-scarcity-hardware.md
index b8e0bc8..e7526ff 100644
--- a/docs/Implementing-post-scarcity-hardware.md
+++ b/docs/Implementing-post-scarcity-hardware.md
@@ -1,3 +1,5 @@
+# Implementing Post Scarcity Hardware
+
 The address space hinted at by using 64 bit cons-space and a 64 bit vector space containing objects each of whose length may be up to 1.4e20 bytes (2^64 of 64 bit words) is so large that a completely populated post-scarcity hardware machine can probably never be built. But that doesn't mean I'm wrong to specify such an address space: if we can make this architecture work for machines that can't (yet, anyway) be built, it will work for machines that can; and, changing the size of the pointers, which one might wish to do for storage economy, can be done with a few edits to consspaceobject.h.
 
 But, for the moment, let's discuss a potential 32 bit psh machine, and how it might be built.
@@ -5,53 +7,53 @@ But, for the moment, let's discuss a potential 32 bit psh machine, and how it mi
 ## Pass one: a literal implementation
 
  Let's say a processing node comprises a two core 32 bit processor, such as an ARM, 4GB of RAM, and a custom router chip. On each node, core zero is the actual processing node, and core one handles communications. We arrange these on a printed circuit board that is 4 nodes by 4 nodes. Each node is connected to the nodes in front, behind, left and right by tracks on the board, and by pins to the nodes on the boards above and below. On the edges of the board, the tracks which have no 'next neighbour' lead to some sort of reasonably high speed bidirectional serial connection — I'm imagining optical fibre (or possibly pairs of optical fibre, one for each direction). These boards are assembled in stacks of four, and the 'up' pins on the top board and the 'down' pins (or sockets) on the bottom board connect to similar high speed serial connectors.
- 
+
  This unit of 4 boards — 64 compute nodes — now forms both a logical and a physical cube. Let's call this cube module a crystal. Connect left to right, top to bottom and back to front, and you have a hypercube. But take another identical crystal, place it along side, connect the right of crystal A to the left of crystal B and the right of B to the left of A, leaving the tops and bottoms and fronts and backs of those crystals still connected to themselves, and you have a larger cuboid with more compute power and address space but slightly lower path efficiency. Continue in this manner until you have four layers of four crystals, and you have a compute unit of 4096 nodes. So the basic 4x4x4 building block — the 'crystal' — is a good place to start, and it is in some measure affordable to build — low numbers of thousands of pounds, even for a prototype.
- 
+
  I imagine you could get away with a two layer board — you might need more, I'm no expert in these things, but the data tracks between nodes can all go on one layer, and then you can have a raster bus on the other layer which carries power, backup data, and common signals (if needed).
- 
+
  So, each node has 4Gb of memory (or more, or less — 4Gb here is just illustrative). How is that memory organised? It could be treated as a heap, or it could be treated as four separate pages, but it must store four logical blocks of data: its own curated conspage, from which other nodes can request copies of objects; its own private housekeeping data (which can also be a conspage, but from which other nodes can't request copies); its cache of copies of data copied from other nodes; and its heap.
- 
+
  Note that a crystal of 64 nodes each with 4Gb or RAM has a total memory of 256Gb, which easily fits onto a single current generation hard disk or SSD module. So I'm envisaging that either the nodes take turns to back up their memory to backing store all the time during normal operation. They (obviously) don't need to backup their cache, since they don't curate it.
- 
+
  What does this cost? About £15 per processor chip, plus £30 for memory, plus the router, which is custom but probably still in tens of pounds, plus a share of the cost of the board; probably under £100 per node, or £6500 for the 'crystal'.
- 
+
 ## Pass two: a virtual implementation
 
  OK, OK, this crystal cube is a pretty concept, but let's get real. Using one core of each of 64 chips makes the architecture very concrete, but it's not necessarily efficient, either computationally or financially.
- 
+
  64 core ARM chips already exist:
- 
+
  1. [Qualcom Hydra](https://eltechs.com/hydra-is-the-name-of-qualcomms-64-core-arm-server-processor/) - 64 of 64 bit cores;
  2. [Macom X-Gene](https://www.apm.com/products/data-center/x-gene-family/x-gene/) - 64 of 64 bit cores;
  2. [Phytium Mars](https://www.nextplatform.com/2016/09/01/details-emerge-chinas-64-core-arm-chip/) - 64 cores, but frustratingly this does not say whether cores are 32 or 64 bit
- 
+
  There are other interesting chips which aren't strictly 64 core:
- 
+
  1. [Cavium ThunderX](https://www.servethehome.com/exclusive-first-cavium-thunderx-dual-48-core-96-core-total-arm-benchmarks) - ARM; 96 cores, each 64 bit, in pairs of two, shipping now;
  2. [Sparc M8](https://www.servethehome.com/oracle-sparc-m8-released-32-cores-256-threads-5-0ghz/) - 32 of 64 bit cores each capable of 8 concurrent threads; shipping now.
- 
+
 ## Implementing the virtual hypercube
 
  Of course, these chips are not designed as hypercubes. We can't route our own network of physical connections into the chips, so our communications channels have to be virtual. But we can implement a communications channel as a pair of buffers, an 'upstream' buffer writable by the lower-numbered processor and readable by the higher, and a 'downstream' buffer writable by the higher numbered processor and readable by the lower. Each buffer should be at least big enough to write a whole cons page object into, optionally including a cryptographic signature if that is implemented. Each pair of buffers also needs at least four bits of flags, in order to be able, for each direction, to be able to signal
- 
+
  0. Idle — the processor at the receiving end is idle and can accept work;
  1. Busy writing — the processor at the sending end is writing data to the buffer, which is not yet complete;
  2. Ready to read — the processor at the sending end has written data to the buffer, and it is complete;
  3. Read — the processor at the receiving end has read the current contents of the buffer.
- 
+
  Thus I think it takes at least six clock ticks to write the buffer (set busy-writing, copy four 64 bit words into the buffer, set ready-to-read) and five to read it out — again, more if the messages are cryptographically signed — for an eleven clock tick transfer (the buffers may be allocated in main memory, but in practice they will always live in L2 cache). That's probably cheaper than making a stack frame. All communications channels within the 'crystal' cost exactly the same.
- 
+
  But note! As in the virtual design, a single thread cannot at the same time execute user program and listen to communications from neighbours. So a node has to be able to run two threads. Whether that's two threads on a single core, or two cores per node, is a detail. But it makes the ThunderX and Spark M8 designs look particularly interesting.
- 
+
  But note that there's one huge advantage that this single-chip virtual crystal has over the literal design: all cores access the same memory pool. Consequently, vector space objects never have to be passed hop, hop, hop across the communications network, all can be accessed directly; and to pass a list, all you have to pass is its first cons cell. So any S-Expression can be passed from any node to any of its 6 proximal neighbours in one hop.
- 
+
  There are downsides to this, too. While communication inside the crystal is easier and quicker, communication between crystals becomes a lot more complex and I don't yet even have an idea how it might work. Also, contention on the main address bus, with 64 processors all trying to write to and read from the same memory at the same time, is likely to be horrendous, leading to much lower speed than the solution where each node has its own memory.
- 
+
  On a cost side, you probably fit this all onto one printed circuit board as against the 4 of the 'literal' design; the single processor chip is likely to cost around £400; and the memory will probably be a little cheaper than on the literal design; and you don't need the custom routers, or the connection hardware, or the optical transceivers. So the cost probably looks more like £5,000. Note also that this virtual crystal has 64 bit processors (although address bus contention will almost certainly burn all that advantage and more).
- 
+
 An experimental post-scarcity machine can be built now — and I can almost afford to build it. I don't have the skills, of course; but I can learn.
- 
+
 
 
 ## Size of a fully populated machine
diff --git a/docs/state-of-play.md b/docs/state-of-play.md
index 50c4cec..fc94b76 100644
--- a/docs/state-of-play.md
+++ b/docs/state-of-play.md
@@ -1,5 +1,57 @@
 # State of Play
 
+## 20260220
+
+### State of the build
+
+The only unit tests that are failing now are the bignum tests, which I have 
+consciously parked as a future problem, and the memory leak, similarly. The
+leak is a lot less bad than it was, but I'm worried that stack frames
+are not being freed.
+
+If you run 
+
+```
+cat lisp/fact.lisp | target/psse -d 2>&1 |\
+        grep 'Vector space object of type' | sort | uniq -c | sort -rn
+```
+
+you get a huge number (currently 394) of stack frames in the memory dump; they 
+should all have been reclaimed. There's other stuff in the memory dump as well, 
+
+```
+    422 CONS    ;; cons cells, obviously
+    394 VECP    ;; pointers to vector space objects -- specifically, the stack frames
+    335 SYMB    ;; symbols
+    149 INTR    ;; integers
+     83 STRG    ;; strings
+     46 FUNC    ;; primitive (i.e. written in C) functions
+     25 KEYW    ;; keywords
+     10 SPFM    ;; primitive special forms
+      3 WRIT    ;; write streams: `*out*`, `*log*`, `*sink*` 
+      1 TRUE    ;; t
+      1 READ    ;; read stream: `*in*`
+      1 NIL     ;; nil
+      1 LMDA    ;; lambda function, specifically `fact`
+```
+
+Generally, for each character in a string, symbol or keyword there will be one 
+cell (`STRG`, `SYMB`, or `KEYW`) cell, so the high number of STRG cells is not 
+especially surprising. It looks as though none of the symbols bound in the 
+oblist are being recovered on exit, which is undesirable but not catastrophic,
+since it's a fixed burden of memory which isn't expanding.
+
+But the fact that stack frames aren't being reclaimed is serious.
+
+### Update, 19:31
+
+Right, investigating this more deeply, I found that `make_empty_frame` was doing 
+an `inc_ref` it should not have been, Having fixed that I'm down to 27 frames 
+left in the dump. That's very close to the number which will be generated by
+running `(fact 25)`, so I expect it is now only stack frames for interpreted 
+functions which are not being reclaimed. This give me something to work on!
+
+
 ## 20260215
 
 Both of yesterday's regressions are fixed. Memory problem still in much the 
@@ -14,8 +66,8 @@ It burned through 74 cons pages each of 1,024 cons cells, total 76,800 cells,
 and 19,153 stack frames. before it got there; and then threw the exception back
 up through each of those 19,153 stack frames. But the actual exception message
 was `Unrecognised tag value 0 (    )`, which is not enormously helpful.
-
-However, once I had recognised what the problem was, it was quickly fixed, with
+S
+However, once I had recognised what the problem was, it was quickly fSixed, with
 the added bonus that the new solution will automatically work for bignum 
 fractions once bignums are working.
 
diff --git a/lisp/defun.lisp b/lisp/defun.lisp
index a18c33a..5c61e1b 100644
--- a/lisp/defun.lisp
+++ b/lisp/defun.lisp
@@ -1,9 +1,9 @@
-(set! symbolp (lambda (x) (equal (type x) "SYMB")))
+(set! symbol? (lambda (x) (equal (type x) "SYMB")))
 
 (set! defun!
       (nlambda
        form
-       (cond ((symbolp (car form))
+       (cond ((symbol? (car form))
               (set (car form) (apply 'lambda (cdr form))))
          (t nil))))
 
@@ -17,7 +17,7 @@
 (set! defsp!
       (nlambda
        form
-       (cond (symbolp (car form))
+       (cond (symbol? (car form))
          (set! (car form) (apply nlambda (cdr form))))))
 
 (defsp! cube (x) ((* x x x)))
diff --git a/lisp/fact.lisp b/lisp/fact.lisp
index 1ad4c19..a264b4d 100644
--- a/lisp/fact.lisp
+++ b/lisp/fact.lisp
@@ -4,6 +4,6 @@
       (cond ((= n 1) 1)
         (t (* n (fact (- n 1)))))))
 
-; (fact 1000)
+(fact 25)
 
 
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 01fc8fb..687ff3c 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -138,7 +138,7 @@ struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
         if ( !small_int_cache_initialised ) {
             for ( int64_t i = 0; i < SMALL_INT_LIMIT; i++ ) {
                 small_int_cache[i] = make_integer( i, NIL );
-                pointer2cell( small_int_cache[i] ).count = UINT32_MAX;  // lock it in so it can't be GC'd
+                pointer2cell( small_int_cache[i] ).count = MAXREFERENCE;  // lock it in so it can't be GC'd
             }
             small_int_cache_initialised = true;
             debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );
diff --git a/src/init.c b/src/init.c
index 2d3d394..ade0c8b 100644
--- a/src/init.c
+++ b/src/init.c
@@ -185,6 +185,7 @@ void print_options( FILE *stream ) {
               L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
     fwprintf( stream, L"\t-h\tPrint this message and exit;\n" );
     fwprintf( stream, L"\t-p\tShow a prompt (default is no prompt);\n" );
+#ifdef DEBUG
     fwprintf( stream,
               L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" );
     fwprintf( stream, L"\t\tWhere bits are interpreted as follows:\n" );
@@ -197,6 +198,7 @@ void print_options( FILE *stream ) {
     fwprintf( stream, L"\t\t64\tLAMBDA;\n" );
     fwprintf( stream, L"\t\t128\tREPL;\n" );
     fwprintf( stream, L"\t\t256\tSTACK.\n" );
+#endif
 }
 
 /**
@@ -384,14 +386,19 @@ int main( int argc, char *argv[] ) {
     repl( show_prompt );
 
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
+
+    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
+    while ( (pointer2cell(oblist)).count > 0) {
+        fprintf( stderr, "Dangling refs on oblist: %d\n", (pointer2cell(oblist)).count );
+        dec_ref( oblist );
+    }
+
+    free_init_symbols(  );
+
     if ( dump_at_end ) {
         dump_pages( file_to_url_file( stdout ) );
     }
 
-    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
-    dec_ref( oblist );
-    free_init_symbols(  );
-
     summarise_allocation(  );
     curl_global_cleanup(  );
     return ( 0 );
diff --git a/src/io/print.c b/src/io/print.c
index 18ed0af..5922b2b 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -116,6 +116,9 @@ void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
         case HASHTV:
             print_map( output, pointer );
             break;
+        case STACKFRAMETV:
+            dump_stack_trace( output, pointer);
+            break;
             // \todo: others.
         default:
             fwprintf( stderr, L"Unrecognised vector-space type '%d'\n",
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 3a5b48e..2b236dc 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -126,9 +126,12 @@ void dump_pages( URL_FILE *output ) {
         url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
 
         for ( int j = 0; j < CONSPAGESIZE; j++ ) {
-            dump_object( output, ( struct cons_pointer ) {
-                         i, j
-                         } );
+            struct cons_pointer pointer = ( struct cons_pointer ) { i, j};
+            if (!freep( pointer)) {
+                dump_object( output, ( struct cons_pointer ) {
+                            i, j
+                            } );
+            }
         }
     }
 }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 083e638..3f85ed6 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -64,6 +64,14 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
 
     if ( cell->count < MAXREFERENCE ) {
         cell->count++;
+#ifdef DEBUG
+        debug_printf( DEBUG_ALLOC, L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
+        if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
+            debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
+        } else {
+            debug_println( DEBUG_ALLOC);
+        }
+#endif
     }
 
     return pointer;
@@ -82,6 +90,14 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
 
     if ( cell->count > 0 && cell->count != UINT32_MAX ) {
         cell->count--;
+#ifdef DEBUG
+        debug_printf( DEBUG_ALLOC, L"\nDecremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
+        if ( strncmp( (char *)cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
+            debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
+        } else {
+            debug_println( DEBUG_ALLOC);
+        }
+#endif
 
         if ( cell->count == 0 ) {
             free_cell( pointer );
@@ -320,7 +336,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
     } else {
         // \todo should throw an exception!
         debug_printf( DEBUG_ALLOC,
-                      L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
+                      L"Warning: only %4.4s can be prepended to %4.4s\n",
                       tag, tag );
     }
 
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index 609226d..adde136 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -312,6 +312,11 @@
  */
 #define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV))
 
+/**
+ * true if `conspoint` points to an unassigned cell, else false
+ */
+#define freep(conspoint) (check_tag(conspoint,FREETV))
+
 /**
  * true if `conspoint` points to a function cell, else false
  */
diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c
index b8f0935..c209109 100644
--- a/src/memory/vectorspace.c
+++ b/src/memory/vectorspace.c
@@ -13,6 +13,8 @@
 #include 
 #include 
 #include 
+
+
 /*
  * wide characters
  */
@@ -22,6 +24,7 @@
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
 #include "debug.h"
+#include "io/io.h"
 #include "memory/hashmap.h"
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
@@ -123,7 +126,8 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
 void free_vso( struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
 
-    debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n",
+    debug_printf( DEBUG_ALLOC, L"About to free vector-space object of type %s at 0x%lx\n",
+                  (char *) cell.payload.vectorp.tag.bytes,
                   cell.payload.vectorp.address );
     struct vector_space_object *vso = cell.payload.vectorp.address;
 
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 105cc93..16ad83b 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -214,9 +214,9 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
             case RATIOTV:
                 switch ( cell_b->tag.value ) {
                     case INTEGERTV:
-                        /* as all ratios are simplified by make_ratio, any
+                        /* as ratios are simplified by make_ratio, any
                          * ratio that would simplify to an integer is an
-                         * integer, */
+                         * integer, TODO: no longer always true. */
                         result = false;
                         break;
                     case REALTV:
@@ -278,6 +278,12 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 /* TODO: it is not OK to do this on the stack since list-like 
                  * structures can be of indefinite extent. It *must* be done by 
                  * iteration (and even that is problematic) */
+#ifdef DEBUG
+                 debug_print( L"Comparing '", DEBUG_ARITH);
+                 debug_print_object( a, DEBUG_ARITH);
+                 debug_print( L"' to '", DEBUG_ARITH);
+                 debug_print_object( b, DEBUG_ARITH);
+#endif
                 result =
                     cell_a->payload.string.hash == cell_b->payload.string.hash
                     && cell_a->payload.string.character ==
diff --git a/src/ops/intern.c b/src/ops/intern.c
index b104e7e..6ea8261 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -18,6 +18,7 @@
  */
 
 #include 
+#include 
 /*
  * wide characters
  */
@@ -309,7 +310,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         debug_print( L"`", DEBUG_BIND );
         debug_print_object( key, DEBUG_BIND );
         debug_print( L"` is a ", DEBUG_BIND );
-        debug_print_object( c_type( key ), DEBUG_BIND );
+        debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
         debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
     }
 
@@ -361,7 +362,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
         result = hashmap_get( store, key );
     } else if ( !nilp( store ) ) {
         debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-        debug_print_object( c_type( store ), DEBUG_BIND );
+        debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
         debug_print( L"`\n", DEBUG_BIND );
         result =
             throw_exception( c_append
@@ -398,8 +399,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
         // hashmap to a bigger number of buckets, and return that.
 
         map->payload.hashmap.buckets[bucket_no] =
-            inc_ref( make_cons( make_cons( key, val ),
-                                map->payload.hashmap.buckets[bucket_no] ) );
+            make_cons( make_cons( key, val ),
+                                map->payload.hashmap.buckets[bucket_no] );
     }
 
     return mapp;
@@ -413,6 +414,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                          struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
+#ifdef DEBUG
     debug_print( L"set: binding `", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
     debug_print( L"` to `", DEBUG_BIND );
@@ -421,8 +423,15 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     debug_dump_object( store, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    debug_printf( DEBUG_BIND, L"set: store is %s\n`",
-                  lisp_string_to_c_string( c_type( store ) ) );
+    debug_printf( DEBUG_BIND, L"set: store is %4.4s",
+                  pointer2cell(store).tag.bytes );
+    if (strncmp(pointer2cell(store).tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
+        debug_printf( DEBUG_BIND, L" -> %4.4s\n",
+                  pointer2cell(store).payload.vectorp.tag.bytes );
+    } else {
+        debug_println( DEBUG_BIND);
+    }
+#endif
     if ( nilp( value ) ) {
         result = store;
     } else if ( nilp( store ) || consp( store ) ) {
@@ -440,8 +449,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
 }
 
 /**
- * @brief Binds this key to this value in the global oblist.
-
+ * @brief Binds this `key` to this `value` in the global oblist, and returns the `key`. 
  */
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4584a9b..bd2b398 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -92,7 +92,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
             {
                 struct cons_pointer next_pointer =
                     make_empty_frame( parent_pointer );
-                inc_ref( next_pointer );
+                // inc_ref( next_pointer );
 
                 struct stack_frame *next = get_stack_frame( next_pointer );
                 set_reg( next, 0, form );
@@ -362,7 +362,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+//                    inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -391,7 +391,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+//                    inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -424,7 +424,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+//                    inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -1269,7 +1269,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
-//    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
 
@@ -1342,6 +1341,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
         if ( exceptionp( expr )
              && url_feof( pointer2cell( input ).payload.stream.stream ) ) {
             /* suppress printing end of stream exception */
+            dec_ref( expr);
             break;
         }
 

From 8df304bc60718939fbd75925022340245719cd03 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 22 Feb 2026 11:41:25 +0000
Subject: [PATCH 59/90] Added the start of a new hardware essay.

---
 ...-Scarcity-Hardware-the-crystal-take-two.md | 57 +++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 docs/Post-Scarcity-Hardware-the-crystal-take-two.md

diff --git a/docs/Post-Scarcity-Hardware-the-crystal-take-two.md b/docs/Post-Scarcity-Hardware-the-crystal-take-two.md
new file mode 100644
index 0000000..28de7fc
--- /dev/null
+++ b/docs/Post-Scarcity-Hardware-the-crystal-take-two.md
@@ -0,0 +1,57 @@
+# Post Scarcity Hardware: the crystal, take two
+
+In my previous essay on hardware for the Post Scarcity system, [Implementing Post Scarcity Hardware](Implementing-post-scarcity-hardware.md), I proposed a hypercube structure built of modules called crystals, each itself a cube of  64 modules called nodes, arranged in an 8 x 8 x 8 lattice, and each having bidirectional serial connections to its up, down, north, south, east and west neighbours. A single crystal can form a hypercube in itself by linking the cells of each of its outside faces to the cells on its opposite face; or they can be plugged together to form larger hypercubes.
+
+In that essay I proposed a number of details on which my thinking has moved on.
+
+First, I proposed that the nodes should be based on commercially available 32 or 64 bit processors. Custom hardware would be needed on each node only for its router, which runs the six bidirectional connections to neighbours. For prototyping that still makes sense, although I will sketch an idea for fully custom hardware in this essay.
+
+I suggested that the address space of each node might be partitioned into four fixed and distinct spaces: its locally curated cons space for its own locally created cells; its locally curated vector space, for larger locally created objects; a space for cached copies of cons cells curated by other nodes; and a space for cached copies of vector space objects curated by other nodes.
+
+I never liked this 'four distinct spaces' idea. As I wrote way back in my first essay on [Post Scarcity software](Post-scarcity-software.md), one of the things that essay was in reaction against was the fixed size stacks on (e.g.) the Java virtual machine, and, more generally, that a software system should hit a wall when it ran out of memory in some arbitrarily delimited space.
+
+So I'm now back to the idea of each node treating its physical memory as one undifferentiated vector space, with its own cons pages, being arrays of equal sized cons-space objects, floating in that vector space. I'm proposing two new types of cons space object. 
+
+The idea of having four distinct spaces per node was that each node would curate just one cons page, and that  each cons pointer was 128 bits comprising 64 bits of originating node address, and 64 bits of page offset. 
+
+I'm still thinking that 128 bits is a not-unreasonable size for a cons pointer, but that it should now be considered made up of three distinct fields, node address, page number, offset. The exact sizes of each of those fields can be variable, but
+
+```
++------*------*----------+
+| 0    | 32   | 64...127 |
++------*------*----------+
+| Node | Page | Offset   |
++------*------*----------+
+
+```
+
+would allow for a hypercube with edges a billion cells long, each capable of addressing 2,535,301,200,456,458,802,993,406,410,752 (2.5x1030) bytes. As this is very substantially more than the number of atoms in the universe, a machine of that size could never be built; so this schema is sufficient for any possible machine which ever could be built!
+
+In practice, I don't actually need a 128 bit cons pointer, and at some stage I may make a pragmatic decision to make it smaller. But the whole idea of the post scarcity computing project is to design systems as though there weren't physical constraints on them, so I'm not proposing to change it yet.
+
+## The `CACH` Cell
+
+The first of these is the cache cell, with the tag `CACH`. A cache cell is like a cons cell, which is like a cons cell except that its `CAR` points to the foreign object which has been cached, and its `CDR` points to the local copy.
+
+There is a local namespace, `*cache*`, which holds a pointer to each such `CACH` cell indexed by the address of the foreign object it points to. A local sweep operation notes cells pointed to by any local cache cell in the `*cache*` which have only one remaining reference, removes the `CACH` cell from the `*cache*` into a temporary holding store (probably an assoc list, possibly a private namespace), sends a message to the owning node to decrement the reference to the object, and, on receiving confirmation that this has been received, decrements (and thus frees) the `CACH` cell and local copy.
+
+Obviously, when any user space function references a cache cell as argument, what is fetched is the locally cached copy of the foreign object, an indirection which needs to be handled by `eval`. When a user space function references a foreign object of which there is a local copy in `*cache*`, then the local copy is fetched. If there isn't a local copy in cache, then execution is obviously halted while the master copy is fetched hopitty hop across the hypercube, which is obviously expensive and undesirable.
+
+Consequently, copies of essential variables, functions and namespaces should be broadcast at bootstrap time and copied by each node. The only mutable things in this system are namespaces and output streams. Output streams are only readable by their destination, so nothing else needs to be alerted if they change. But any node may hold a cached copy of a namespace, so if a namespace is changed a change notification needs to be broadcast, or else every time a function on a node references a name in namespace, execution needs to halt while the curating node is queried whether the the binding has changed.
+
+Both of these solutions are expensive. Probably the best compromise is to have two tiers of namespaces, those which broadcast changes (probably reserved for essential system namespaces), and those which have to be checked when accessed. Note that, provided the binding hasn't changed, nothing below the binding can have changed unless it also is a namespace, so nothing needs to be refetched.
+
+## The `PROT` cell
+
+I've given myself 32 bits of tag space, mainly to allow a simple representation of mnemonics as tags. For this reason, all the tags I've so far assigned have values which, considered as ASCII strings, represent four upper case characters. There are thus 456,976 possible upper case tags, and an equal number of possible lower case tags. I have a thought that tags encoding mnemonics in all upper could be tags of system level cons space object types, and tags encoding mnemonics in all lower could be tags of user created cons space object types.
+
+But if users are able to create their own new types of cons space object, there has to be a way of specifying to the system how to use those novel cell types, and what sorts of operations are legal on them.
+
+This is where the `PROT` — or `PROT`otype — cell comes in.
+
+A cons space object is something which can be stored in [a cons cell](Cons-space.md), which has a fixed payload size of 128 bits.
+
+In designing the bootstrapping cons space object types of the system, I've designed cells which are essentially two 64 bit pointers (such as `CONS` or `RTIO`); one which is a single 128 bit [IEEE754]() floating point number (`REAL`); one which is a single `unsigned __int128` (`TIME`); several which comprise one 32 bit `wide character`, some padding, and a cons pointer to another cell of the same type (`KEYW`, `STRG`, `SYMB`); one which comprises a tag, some padding, and a 64 bit pointer into vector space (`VECP`); ones that are simply markers and have no payload (`LOOP`, `WRKR`) , and so on.
+
+There are a lot of different sorts of things you can store in 128 bits of memory. You can divide it up into fields any way you please, and store anything you like — that will fit — in those fields.
+

From 62ebaf981987b986b7bdc65549eb73d1c15bcb56 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Tue, 24 Feb 2026 01:45:51 +0000
Subject: [PATCH 60/90] Added logical operators `and`, `not` and `or`. Closes
 #3

---
 ...-Scarcity-Hardware-the-crystal-take-two.md |  36 +++--
 lisp/documentation.lisp                       |   4 +
 lisp/greaterp.lisp                            |   3 +
 lisp/member.lisp                              |   7 +
 lisp/nth.lisp                                 |   6 +
 lisp/types.lisp                               |  32 ++--
 src/arith/integer.h                           |   2 +
 src/arith/peano.c                             |  68 +++++++--
 src/arith/peano.h                             |  13 ++
 src/init.c                                    | 133 +++++++++++------
 src/ops/equal.c                               |  98 +++++++++++-
 src/ops/lispops.c                             | 139 ++++++++++++------
 src/ops/lispops.h                             |  13 ++
 13 files changed, 422 insertions(+), 132 deletions(-)
 create mode 100644 lisp/documentation.lisp
 create mode 100644 lisp/greaterp.lisp
 create mode 100644 lisp/member.lisp
 create mode 100644 lisp/nth.lisp

diff --git a/docs/Post-Scarcity-Hardware-the-crystal-take-two.md b/docs/Post-Scarcity-Hardware-the-crystal-take-two.md
index 28de7fc..2577623 100644
--- a/docs/Post-Scarcity-Hardware-the-crystal-take-two.md
+++ b/docs/Post-Scarcity-Hardware-the-crystal-take-two.md
@@ -12,22 +12,22 @@ I never liked this 'four distinct spaces' idea. As I wrote way back in my first
 
 So I'm now back to the idea of each node treating its physical memory as one undifferentiated vector space, with its own cons pages, being arrays of equal sized cons-space objects, floating in that vector space. I'm proposing two new types of cons space object. 
 
-The idea of having four distinct spaces per node was that each node would curate just one cons page, and that  each cons pointer was 128 bits comprising 64 bits of originating node address, and 64 bits of page offset. 
+The idea of having four distinct spaces per node was that each node would curate just one cons page, and that  each cons pointer was 64 bits comprising 32 bits of originating node address, and 32 bits of page offset. 
 
-I'm still thinking that 128 bits is a not-unreasonable size for a cons pointer, but that it should now be considered made up of three distinct fields, node address, page number, offset. The exact sizes of each of those fields can be variable, but
+I'm still thinking that 64 bits is a not-unreasonable size for a cons pointer, but that it should now be considered made up of three distinct fields, node address, page number, offset. The exact sizes of each of those fields can be variable, but
 
 ```
-+------*------*----------+
-| 0    | 32   | 64...127 |
-+------*------*----------+
-| Node | Page | Offset   |
-+------*------*----------+
++------*------*---------+
+| 0    | 32   | 40...63 |
++------*------*---------+
+| Node | Page | Offset  |
++------*------*---------+
 
 ```
 
-would allow for a hypercube with edges a billion cells long, each capable of addressing 2,535,301,200,456,458,802,993,406,410,752 (2.5x1030) bytes. As this is very substantially more than the number of atoms in the universe, a machine of that size could never be built; so this schema is sufficient for any possible machine which ever could be built!
+would allow for a hypercube with edges 536,870,912 — half a billion — nodes long, with each node capable of addressing 256 pages of each of 16,777,216 cells for a total of 4 billion cells, each of 32 bytes. So the cells alone addressable by a single node could occupy 237 =  137,438,953,472 bytes; but each node would have a 64 bit address bus, so the potential heap is vastly larger.
 
-In practice, I don't actually need a 128 bit cons pointer, and at some stage I may make a pragmatic decision to make it smaller. But the whole idea of the post scarcity computing project is to design systems as though there weren't physical constraints on them, so I'm not proposing to change it yet.
+In practice, I don't actually need a 64 bit cons pointer, and at some stage I may make a pragmatic decision to make it smaller. But the whole idea of the post scarcity computing project is to design systems as though there weren't physical constraints on them, so I'm not proposing to change it yet.
 
 ## The `CACH` Cell
 
@@ -55,3 +55,21 @@ In designing the bootstrapping cons space object types of the system, I've desig
 
 There are a lot of different sorts of things you can store in 128 bits of memory. You can divide it up into fields any way you please, and store anything you like — that will fit — in those fields.
 
+## The Node Processor hardware
+
+I suggested in my earlier essay that the node processors could be off the shelf parts, probably ARM chips. But the router still needs to be custom silicon. If you were to do custom silicon for the node processor, what would it look like?
+
+Well, firstly, although it could have a very small instruction set, I don't think it would count as strictly a RISC processor. The reason it wouldn't is that some of the instructions would be themselves recursive, meaning they could not complete in a single clock cycle.
+
+So, what does it look like?
+
+Firstly, it must have at least one register in which it can construct a complete cons space object, which is to say, 256 bits. 
+
+It must have sufficient registers to represent the full content of a stack frame, which is to say eleven 64 bit cons pointers and one 32 bit argument counter, so at least 736 bits (but 768 probably makes more sense). But note that a function call with zero args needs only 160 bits, one with one arg needs only 224 bits, one with three, 288 bits register. So when evaluating functions with low numbers of arguments, it's at least potentially possible for the processor to use unused bits in the stack frame register as additional shipyards in which to assemble cons space objects.
+
+H'mmm. You need two stack frame registers, one for the frame you're evaluating, and one for the frame you're assembling. I think you also need an additional cons space object shipyard, for the cons space object (VECP) which will point to the current frame when is released.
+
+### Instructions
+
+
+
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
new file mode 100644
index 0000000..7c20cf0
--- /dev/null
+++ b/lisp/documentation.lisp
@@ -0,0 +1,4 @@
+(set! documentation (lambda (name)
+    (:documentation  (meta name))))
+
+(set! doc documentation)
diff --git a/lisp/greaterp.lisp b/lisp/greaterp.lisp
new file mode 100644
index 0000000..04a48f9
--- /dev/null
+++ b/lisp/greaterp.lisp
@@ -0,0 +1,3 @@
+(set! > (lambda (a b)
+
+)
\ No newline at end of file
diff --git a/lisp/member.lisp b/lisp/member.lisp
new file mode 100644
index 0000000..71f5dcf
--- /dev/null
+++ b/lisp/member.lisp
@@ -0,0 +1,7 @@
+(set! member (lambda
+            (item collection)
+            "Return `t` if this `item` is a member of this `collection`, else `nil`."
+            (cond
+              ((nil? collection) nil)
+              ((= item (car collection)) t)
+              (t (member item (cdr collection))))))
\ No newline at end of file
diff --git a/lisp/nth.lisp b/lisp/nth.lisp
new file mode 100644
index 0000000..cd03355
--- /dev/null
+++ b/lisp/nth.lisp
@@ -0,0 +1,6 @@
+(set! nth (lambda (n l) 
+    "Return the `n`th member of this list `l`, or `nil` if none."
+    (cond ((= nil l) nil)
+        ((= n 1) (car l))
+        (t (nth (- n 1) (cdr l))))))
+
diff --git a/lisp/types.lisp b/lisp/types.lisp
index 7f7bf8c..e5976ff 100644
--- a/lisp/types.lisp
+++ b/lisp/types.lisp
@@ -1,17 +1,17 @@
-(set! cons? (lambda (o) "True if o is a cons cell." (= (type o) "CONS") ) )
-(set! exception? (lambda (o) "True if o is an exception." (= (type o) "EXEP")))
-(set! free? (lambda (o) "Trus if o is a free cell - this should be impossible!" (= (type o) "FREE")))
-(set! function? (lambda (o) "True if o is a compiled function." (= (type o) "EXEP")))
-(set! integer? (lambda (o) "True if o is an integer." (= (type o) "INTR")))
-(set! lambda? (lambda (o) "True if o is an interpreted (source) function." (= (type o) "LMDA")))
-(set! nil? (lambda (o) "True if o is the canonical nil value." (= (type o) "NIL ")))
-(set! nlambda? (lambda (o) "True if o is an interpreted (source) special form." (= (type o) "NLMD")))
-(set! rational? (lambda (o) "True if o is an rational number." (= (type o) "RTIO")))
-(set! read? (lambda (o) "True if o is a read stream." (= (type o) "READ") ) )
-(set! real? (lambda (o) "True if o is an real number." (= (type o) "REAL")))
-(set! special? (lambda (o) "True if o is a compiled special form." (= (type o) "SPFM") ) )
-(set! string? (lambda (o) "True if o is a string." (= (type o) "STRG") ) )
-(set! symbol? (lambda (o) "True if o is a symbol." (= (type o) "SYMB") ) )
-(set! true? (lambda (o) "True if o is the canonical true value." (= (type o) "TRUE") ) )
-(set! write? (lambda (o) "True if o is a write stream." (= (type o) "WRIT") ) )
+(set! cons? (lambda (o) "True if `o` is a cons cell." (= (type o) "CONS") ) )
+(set! exception? (lambda (o) "True if `o` is an exception." (= (type o) "EXEP")))
+(set! free? (lambda (o) "Trus if `o` is a free cell - this should be impossible!" (= (type o) "FREE")))
+(set! function? (lambda (o) "True if `o` is a compiled function." (= (type o) "EXEP")))
+(set! integer? (lambda (o) "True if `o` is an integer." (= (type o) "INTR")))
+(set! lambda? (lambda (o) "True if `o` is an interpreted (source) function." (= (type o) "LMDA")))
+(set! nil? (lambda (o) "True if `o` is the canonical nil value." (= (type o) "NIL ")))
+(set! nlambda? (lambda (o) "True if `o` is an interpreted (source) special form." (= (type o) "NLMD")))
+(set! rational? (lambda (o) "True if `o` is an rational number." (= (type o) "RTIO")))
+(set! read? (lambda (o) "True if `o` is a read stream." (= (type o) "READ") ) )
+(set! real? (lambda (o) "True if `o` is an real number." (= (type o) "REAL")))
+(set! special? (lambda (o) "True if `o` is a compiled special form." (= (type o) "SPFM") ) )
+(set! string? (lambda (o) "True if `o` is a string." (= (type o) "STRG") ) )
+(set! symbol? (lambda (o) "True if `o` is a symbol." (= (type o) "SYMB") ) )
+(set! true? (lambda (o) "True if `o` is the canonical true value." (= (type o) "TRUE") ) )
+(set! write? (lambda (o) "True if `o` is a write stream." (= (type o) "WRIT") ) )
 
diff --git a/src/arith/integer.h b/src/arith/integer.h
index 49f700c..e08549f 100644
--- a/src/arith/integer.h
+++ b/src/arith/integer.h
@@ -13,6 +13,8 @@
 
 #include 
 #include 
+#include "memory/consspaceobject.h"
+
 
 #define replace_integer_i(p,i) {struct cons_pointer __p = acquire_integer(i,NIL); release_integer(p); p = __p;}
 #define replace_integer_p(p,q) {struct cons_pointer __p = p; release_integer( p);  p = q;}
diff --git a/src/arith/peano.c b/src/arith/peano.c
index f2c81e0..7e3dfc6 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -64,6 +64,35 @@ bool zerop( struct cons_pointer arg ) {
     return result;
 }
 
+// TODO: think about
+// bool greaterp( struct cons_pointer arg_1, struct cons_pointer arg_2) {
+//     bool result = false;
+//     struct cons_space_object * cell_1 = & pointer2cell( arg_1 );
+//     struct cons_space_object * cell_2 = & pointer2cell( arg_2 );
+    
+//     if (cell_1->tag.value == cell_2->tag.value) {
+
+//     switch ( cell_1->tag.value ) {
+//         case INTEGERTV:{
+//                 if ( nilp(cell_1->payload.integer.more) && nilp( cell_2->payload.integer.more)) {
+//                     result = cell_1->payload.integer.value > cell_2->payload.integer.value;
+//                 }
+//                 // else deal with comparing bignums...
+//             }
+//             break;
+//         case RATIOTV:
+//             result = lisp_ratio_to_real( cell_1) > ratio_to_real( cell_2);
+//             break;
+//         case REALTV:
+//             result = ( cell.payload.real.value == 0 );
+//             break;
+//     }
+//     }
+
+//     return result;
+    
+// }
+
 /**
  * does this `arg` point to a negative number?
  */
@@ -86,24 +115,35 @@ bool is_negative( struct cons_pointer arg ) {
     return result;
 }
 
+/**
+ * @brief if `arg` is a number, return the absolute value of that number, else
+ * `NIL`
+ * 
+ * @param arg a cons space object, probably a number.
+ * @return struct cons_pointer 
+ */
 struct cons_pointer absolute( struct cons_pointer arg ) {
     struct cons_pointer result = NIL;
     struct cons_space_object cell = pointer2cell( arg );
 
-    if ( is_negative( arg ) ) {
-        switch ( cell.tag.value ) {
-            case INTEGERTV:
-                result =
-                    make_integer( llabs( cell.payload.integer.value ),
-                                  cell.payload.integer.more );
-                break;
-            case RATIOTV:
-                result = make_ratio( absolute( cell.payload.ratio.dividend ),
-                                     cell.payload.ratio.divisor, false );
-                break;
-            case REALTV:
-                result = make_real( 0 - cell.payload.real.value );
-                break;
+    if ( numberp( arg))  {
+        if ( is_negative( arg ) ) {
+            switch ( cell.tag.value ) {
+                case INTEGERTV:
+                    result =
+                        make_integer( llabs( cell.payload.integer.value ),
+                                    cell.payload.integer.more );
+                    break;
+                case RATIOTV:
+                    result = make_ratio( absolute( cell.payload.ratio.dividend ),
+                                        cell.payload.ratio.divisor, false );
+                    break;
+                case REALTV:
+                    result = make_real( 0 - cell.payload.real.value );
+                    break;
+            }
+        } else {
+            result = arg;
         }
     }
 
diff --git a/src/arith/peano.h b/src/arith/peano.h
index 9e02a4d..c85a9d8 100644
--- a/src/arith/peano.h
+++ b/src/arith/peano.h
@@ -31,6 +31,19 @@
  */
 #define INTEGER_BIT_SHIFT (60)
 
+/**
+ * @brief return `true` if arg is `nil`,  else `false`. 
+ *
+ * Note that this doesn't really belong in `peano.h`, but after code cleanup it
+ * was the last thing remaining in either `boolean.c` or `boolean.h`, and it 
+ * wasn't worth keeping two files around for one one-line macro.
+ * 
+ * @param arg 
+ * @return true if the sole argument is `nil`.
+ * @return false otherwise.
+ */
+#define truthy(arg)(!nilp(arg))
+
 bool zerop( struct cons_pointer arg );
 
 struct cons_pointer negative( struct cons_pointer arg );
diff --git a/src/init.c b/src/init.c
index ade0c8b..6a8ae55 100644
--- a/src/init.c
+++ b/src/init.c
@@ -67,10 +67,14 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
     return result;
 }
 
+struct cons_pointer init_documentation_symbol = NIL;
 struct cons_pointer init_name_symbol = NIL;
 struct cons_pointer init_primitive_symbol = NIL;
 
 void maybe_bind_init_symbols(  ) {
+    if ( nilp( init_documentation_symbol)) {
+        init_documentation_symbol = c_string_to_lisp_keyword( L"documentation");
+    }
     if ( nilp( init_name_symbol ) ) {
         init_name_symbol = c_string_to_lisp_keyword( L"name" );
     }
@@ -83,6 +87,7 @@ void maybe_bind_init_symbols(  ) {
 }
 
 void free_init_symbols(  ) {
+    dec_ref( init_documentation_symbol);
     dec_ref( init_name_symbol );
     dec_ref( init_primitive_symbol );
 }
@@ -95,21 +100,25 @@ void free_init_symbols(  ) {
  * more readable and aid debugging generally.
  */
 struct cons_pointer bind_function( wchar_t *name,
+                                   wchar_t *doc,
                                    struct cons_pointer ( *executable )
                                     ( struct stack_frame *,
                                       struct cons_pointer,
                                       struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
+    struct cons_pointer d = c_string_to_lisp_string( doc);
+
     struct cons_pointer meta =
         make_cons( make_cons( init_primitive_symbol, TRUE ),
                    make_cons( make_cons( init_name_symbol, n ),
-                              NIL ) );
+                   make_cons( make_cons( init_documentation_symbol, d), NIL) ) );
 
     struct cons_pointer r =
         check_exception( deep_bind( n, make_function( meta, executable ) ),
                          "bind_function" );
 
     dec_ref( n );
+    dec_ref( d );
 
     return r;
 }
@@ -321,52 +330,82 @@ int main( int argc, char *argv[] ) {
     /*
      * primitive function operations
      */
-    bind_function( L"absolute", &lisp_absolute );
-    bind_function( L"add", &lisp_add );
-    bind_function( L"append", &lisp_append );
-    bind_function( L"apply", &lisp_apply );
-    bind_function( L"assoc", &lisp_assoc );
-    bind_function( L"car", &lisp_car );
-    bind_function( L"cdr", &lisp_cdr );
-    bind_function( L"close", &lisp_close );
-    bind_function( L"cons", &lisp_cons );
-    bind_function( L"divide", &lisp_divide );
-    bind_function( L"eq", &lisp_eq );
-    bind_function( L"equal", &lisp_equal );
-    bind_function( L"eval", &lisp_eval );
-    bind_function( L"exception", &lisp_exception );
-    bind_function( L"get-hash", &lisp_get_hash );
-    bind_function( L"hashmap", lisp_make_hashmap );
-    bind_function( L"inspect", &lisp_inspect );
-    bind_function( L"keys", &lisp_keys );
-    bind_function( L"list", &lisp_list );
-    bind_function( L"mapcar", &lisp_mapcar );
-    bind_function( L"meta", &lisp_metadata );
-    bind_function( L"metadata", &lisp_metadata );
-    bind_function( L"multiply", &lisp_multiply );
-    bind_function( L"negative?", &lisp_is_negative );
-    bind_function( L"oblist", &lisp_oblist );
-    bind_function( L"open", &lisp_open );
-    bind_function( L"print", &lisp_print );
-    bind_function( L"put!", lisp_hashmap_put );
-    bind_function( L"put-all!", &lisp_hashmap_put_all );
-    bind_function( L"ratio->real", &lisp_ratio_to_real );
-    bind_function( L"read", &lisp_read );
-    bind_function( L"read-char", &lisp_read_char );
-    bind_function( L"repl", &lisp_repl );
-    bind_function( L"reverse", &lisp_reverse );
-    bind_function( L"set", &lisp_set );
-    bind_function( L"slurp", &lisp_slurp );
-    bind_function( L"source", &lisp_source );
-    bind_function( L"subtract", &lisp_subtract );
-    bind_function( L"throw", &lisp_exception );
-    bind_function( L"time", &lisp_time );
-    bind_function( L"type", &lisp_type );
-    bind_function( L"+", &lisp_add );
-    bind_function( L"*", &lisp_multiply );
-    bind_function( L"-", &lisp_subtract );
-    bind_function( L"/", &lisp_divide );
-    bind_function( L"=", &lisp_equal );
+     /* TODO: docstrings should be moved to a header file, or even to an at-run-time resolution system. 
+      * HTTP from an address at journeyman? */
+    bind_function( L"absolute", 
+        L"`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.", 
+        &lisp_absolute );
+    bind_function( L"add", 
+        L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.", 
+        &lisp_add );
+    bind_function( L"and", 
+        L"`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.",
+        &lisp_and);
+    bind_function( L"append", L"`(append args...)`: If args are all collections, return the concatenation of those collections.", 
+        &lisp_append );
+    bind_function( L"apply", 
+        L"`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.", 
+        &lisp_apply );
+    bind_function( L"assoc", 
+        L"`(assoc key store)`: Return the value associated with this `key` in this `store`.",
+         &lisp_assoc );
+    bind_function( L"car", 
+        L"`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.", 
+        &lisp_car );
+    bind_function( L"cdr", 
+        L"`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.", 
+        &lisp_cdr );
+    bind_function( L"close", L"`(close stream)`: If `stream` is a stream, close that stream.", &lisp_close );
+    bind_function( L"cons", L"`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.", &lisp_cons );
+    bind_function( L"divide", 
+        L"`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.", 
+        &lisp_divide );
+    bind_function( L"eq", L"`(eq a b)`: Return `t` if `a` and `b` are the exact same object, else `nil`.", &lisp_eq );
+    bind_function( L"equal", L"`(eq a b)`: Return `t` if `a` and `b` have logically equivalent value, else `nil`.", &lisp_equal );
+    bind_function( L"eval", L"", &lisp_eval );
+    bind_function( L"exception", L"`(exception message)`: Return (throw) an exception with this `message`.", &lisp_exception );
+    bind_function( L"get-hash", L"`(get-hash arg)`: returns the natural number hash value of `arg`.", &lisp_get_hash );
+    bind_function( L"hashmap", 
+        L"`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.", 
+        lisp_make_hashmap );
+    bind_function( L"inspect", 
+        L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.", 
+        &lisp_inspect );
+    bind_function( L"keys", L"`(keys store)`: Return a list of all keys in this `store`.", &lisp_keys );
+    bind_function( L"list", L"`(list args...): Return a list of these `args`.", &lisp_list );
+    bind_function( L"mapcar", L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.", &lisp_mapcar );
+    bind_function( L"meta", L"`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.", &lisp_metadata );
+    bind_function( L"metadata", L"`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.", &lisp_metadata );
+    bind_function( L"multiply", L"`(* args...)` Multiply these `args`, all of which should be numbers.", &lisp_multiply );
+    bind_function( L"negative?", L"`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.", &lisp_is_negative );
+    bind_function( L"not", 
+        L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.",
+        &lisp_not);
+    bind_function( L"oblist", L"`(oblist)`: Return the current symbol bindings, as a map.", &lisp_oblist );
+    bind_function( L"open", L"`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.", &lisp_open );
+    bind_function( L"or", 
+        L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.",
+        &lisp_or);
+    bind_function( L"print", L"`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.", &lisp_print );
+    bind_function( L"put!", L"", lisp_hashmap_put );
+    bind_function( L"put-all!", L"", &lisp_hashmap_put_all );
+    bind_function( L"ratio->real", L"", &lisp_ratio_to_real );
+    bind_function( L"read", L"", &lisp_read );
+    bind_function( L"read-char", L"", &lisp_read_char );
+    bind_function( L"repl", L"", &lisp_repl );
+    bind_function( L"reverse", L"", &lisp_reverse );
+    bind_function( L"set", L"", &lisp_set );
+    bind_function( L"slurp", L"", &lisp_slurp );
+    bind_function( L"source", L"", &lisp_source );
+    bind_function( L"subtract", L"", &lisp_subtract );
+    bind_function( L"throw", L"", &lisp_exception );
+    bind_function( L"time", L"", &lisp_time );
+    bind_function( L"type", L"", &lisp_type );
+    bind_function( L"+", L"", &lisp_add );
+    bind_function( L"*", L"", &lisp_multiply );
+    bind_function( L"-", L"", &lisp_subtract );
+    bind_function( L"/", L"", &lisp_divide );
+    bind_function( L"=", L"", &lisp_equal );
     /*
      * primitive special forms
      */
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 16ad83b..cd49a3f 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -10,12 +10,15 @@
 #include 
 #include 
 
-#include "memory/conspage.h"
-#include "memory/consspaceobject.h"
 #include "arith/integer.h"
 #include "arith/peano.h"
 #include "arith/ratio.h"
 #include "debug.h"
+#include "memory/conspage.h"
+#include "memory/consspaceobject.h"
+#include "memory/vectorspace.h"
+#include "ops/equal.h"
+#include "ops/intern.h"
 
 /**
  * Shallow, and thus cheap, equality: true if these two objects are
@@ -240,6 +243,86 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
     return result;
 }
 
+/**
+ * @brief equality of two map-like things. 
+ *
+ * The list returned by `keys` on a map-like thing is not sorted, and is not 
+ * guaranteed always to come out in the same order. So equality is established
+ * if:
+ * 1. the length of the keys list is the same; and 
+ * 2. the value of each key in the keys list for map `a` is the same in map `a` 
+ *    and in map `b`.
+ *
+ * Private function, do not use outside this file, **WILL NOT** work 
+ * unless both arguments are VECPs.
+ * 
+ * @param a a pointer to a vector space object.
+ * @param b another pointer to a vector space object.
+ * @return true if the two objects have the same logical structure.
+ * @return false otherwise.
+ */
+bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
+    bool result=false;
+
+    struct cons_pointer keys_a = hashmap_keys( a);
+    
+    if ( c_length( keys_a) == c_length( hashmap_keys( b))) {
+        result = true;
+
+        for ( struct cons_pointer i = keys_a; !nilp( i); i = c_cdr( i)) {
+            struct cons_pointer key = c_car( i);
+            if ( !equal( hashmap_get( a, key),hashmap_get( b, key))) {
+                result = false; break;
+            }
+        }
+    }
+
+    return result;
+}
+
+/**
+ * @brief equality of two vector-space things. 
+ *
+ * Expensive, but we need to be able to check for equality of at least hashmaps
+ * and namespaces.
+ *
+ * Private function, do not use outside this file, not guaranteed to work 
+ * unless both arguments are VECPs pointing to map like things.
+ * 
+ * @param a a pointer to a vector space object.
+ * @param b another pointer to a vector space object.
+ * @return true if the two objects have the same logical structure.
+ * @return false otherwise.
+ */
+bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
+    bool result = false;
+
+    if ( eq( a, b)) {
+        result = true; // same 
+        /* there shouldn't ever be two separate VECP cells which point to the
+         * same address in vector space, so I don't believe it's worth checking
+         * for this.
+         */
+    } else if ( vectorp( a) && vectorp( b)) {
+        struct vector_space_object * va = pointer_to_vso( a);
+        struct vector_space_object * vb = pointer_to_vso( b);
+
+        /* what we're saying here is that a namespace is not equal to a map,
+         * even if they have identical logical structure. Is this right? */
+        if ( va->header.tag.value == vb->header.tag.value) {
+            switch ( va->header.tag.value) {
+                case HASHTV:
+                case NAMESPACETV:
+                    result = equal_map_map( a, b);
+                    break;
+            }
+        }
+    }
+    // else can't throw an exception from here but TODO: should log.
+
+    return result;
+}
+
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
@@ -319,6 +402,13 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     result = fabs( num_a - num_b ) < ( max / 1000000.0 );
                 }
                 break;
+            case VECTORPOINTTV:
+                if ( cell_b->tag.value == VECTORPOINTTV) {
+                    result = equal_vector_vector( a, b);
+                } else {
+                    result = false;
+                }
+                break;
             default:
                 result = false;
                 break;
@@ -329,8 +419,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
 
     /*
      * there's only supposed ever to be one T and one NIL cell, so each
-     * should be caught by eq; equality of vector-space objects is a whole
-     * other ball game so we won't deal with it now (and indeed may never).
+     * should be caught by eq.
+     *
      * I'm not certain what equality means for read and write streams, so
      * I'll ignore them, too, for now.
      */
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index bd2b398..4f51c3b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -24,19 +24,20 @@
 #include 
 #include 
 
-#include "memory/consspaceobject.h"
-#include "memory/conspage.h"
-#include "debug.h"
-#include "memory/dump.h"
-#include "ops/equal.h"
 #include "arith/integer.h"
-#include "ops/intern.h"
+#include "arith/peano.h"
+#include "debug.h"
 #include "io/io.h"
-#include "ops/lispops.h"
 #include "io/print.h"
 #include "io/read.h"
+#include "memory/conspage.h"
+#include "memory/consspaceobject.h"
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
+#include "memory/dump.h"
+#include "ops/equal.h"
+#include "ops/intern.h"
+#include "ops/lispops.h"
 
 /**
  * @brief the name of the symbol to which the prompt is bound;
@@ -74,7 +75,6 @@ struct cons_pointer eval_form( struct stack_frame *parent,
             /* things which evaluate to themselves */
         case EXCEPTIONTV:
         case FREETV:           // shouldn't happen, but anyway...
-            // FUNCTIONTV, LAMBDATV, NLAMBDATV, SPECIALTV ?
         case INTEGERTV:
         case KEYTV:
         case LOOPTV:           // don't think this should happen...
@@ -85,7 +85,6 @@ struct cons_pointer eval_form( struct stack_frame *parent,
         case STRINGTV:
         case TIMETV:
         case TRUETV:
-            // case VECTORPOINTTV: ?
         case WRITETV:
             break;
         default:
@@ -243,10 +242,10 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
 }
 
 void log_binding( struct cons_pointer name, struct cons_pointer val ) {
-    debug_print( L"\n\tBinding ", DEBUG_ALLOC );
-    debug_dump_object( name, DEBUG_ALLOC );
-    debug_print( L" to ", DEBUG_ALLOC );
-    debug_dump_object( val, DEBUG_ALLOC );
+    debug_print( L"\n\tBinding ", DEBUG_LAMBDA );
+    debug_dump_object( name, DEBUG_LAMBDA  );
+    debug_print( L" to ", DEBUG_LAMBDA  );
+    debug_dump_object( val, DEBUG_LAMBDA  );
 }
 
 /**
@@ -305,12 +304,15 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 
         debug_print( L"In lambda: evaluating ", DEBUG_LAMBDA );
         debug_print_object( sexpr, DEBUG_LAMBDA );
+        // debug_print( L"\t env is: ", DEBUG_LAMBDA );
+        // debug_print_object( new_env, DEBUG_LAMBDA );
         debug_println( DEBUG_LAMBDA );
 
         /* if a result is not the terminal result in the lambda, it's a
          * side effect, and needs to be GCed */
-        if ( !nilp( result ) )
-            dec_ref( result );
+        if ( !nilp( result ) ){
+            // dec_ref( result );
+        }
 
         result = eval_form( frame, frame_pointer, sexpr, new_env );
 
@@ -319,7 +321,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
         }
     }
 
-    dec_ref( new_env );
+    // dec_ref( new_env );
 
     debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA );
     debug_print_object( result, DEBUG_LAMBDA );
@@ -870,7 +872,12 @@ struct cons_pointer lisp_keys( struct stack_frame *frame,
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env ) {
-    return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
+    if ( frame->args == 2) {
+        return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
+    } else {
+        return throw_exception( c_string_to_lisp_string( L"Wrong number of args to `eq`."),
+            frame_pointer);
+    }
 }
 
 /**
@@ -886,7 +893,12 @@ struct cons_pointer lisp_eq( struct stack_frame *frame,
 struct cons_pointer
 lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
+    if ( frame->args == 2) {
+        return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
+    } else {    
+        return throw_exception( c_string_to_lisp_string( L"Wrong number of args to `equal`."),
+            frame_pointer);
+    }
 }
 
 /**
@@ -1507,6 +1519,14 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
     return result;
 }
 
+/**
+ * @brief construct and return a list of arbitrarily many arguments.
+ * 
+ * @param frame The stack frame.
+ * @param frame_pointer A pointer to the stack frame.
+ * @param env The evaluation environment.
+ * @return struct cons_pointer a pointer to the result
+ */
 struct cons_pointer lisp_list( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env ) {
@@ -1563,35 +1583,70 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 
 }
 
-// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
-//     struct cons_pointer result = b;
+/**
+ * @brief Boolean `and` of arbitrarily many arguments.
+ * 
+ * @param frame The stack frame.
+ * @param frame_pointer A pointer to the stack frame.
+ * @param env The evaluation environment.
+ * @return struct cons_pointer a pointer to the result
+ */
+struct cons_pointer lisp_and( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env ) {
+    bool accumulator = true;                            
+    struct cons_pointer result = frame->more;
 
-//     if ( nilp( b.tag.value)) {
-//         result = make_cons( a, b);
-//     } else {
-//         if ( ! nilp( a)) {
-//             if (a.tag.value == b.tag.value) {
+    for ( int a = 0; accumulator == true && a < args_in_frame; a++) {
+        accumulator = truthy( frame->arg[ a]);
+    }
 
-//                 struct cons_pointer tail = c_concat( c_cdr( a), b);
+    if ( accumulator && ! nilp( frame->more)) {
+        for ( struct cons_pointer rest = frame->more; accumulator == true && !nilp( rest); rest = c_cdr(rest)) {
+            accumulator = truthy( c_car( rest));
+        } 
+    }
 
-//                 switch ( a.tag.value) {
-//                     case CONSTV:
-//                         result = make_cons( c_car( a), tail);
-//                         break;
-//                     case KEYTV:
-//                     case STRINGTV:
-//                     case SYMBOLTV:
-//                         result = make_string_like_thing()
+    return accumulator ? TRUE : NIL;
+}
 
-//                 }
+/**
+ * @brief Boolean `or` of arbitrarily many arguments.
+ * 
+ * @param frame The stack frame.
+ * @param frame_pointer A pointer to the stack frame.
+ * @param env The evaluation environment.
+ * @return struct cons_pointer a pointer to the result
+ */
+struct cons_pointer lisp_or( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env ) {
+    bool accumulator = false;                            
+    struct cons_pointer result = frame->more;
 
-//             } else {
-//                 // throw an exception
-//             }
-//         }
-//     }
+    for ( int a = 0; accumulator == false && a < args_in_frame; a++) {
+        accumulator = truthy( frame->arg[ a]);
+    }
 
+    if ( ! accumulator && ! nilp( frame->more)) {
+        for ( struct cons_pointer rest = frame->more; accumulator == false && !nilp( rest); rest = c_cdr(rest)) {
+            accumulator = truthy( c_car( rest));
+        } 
+    }
 
+    return accumulator ? TRUE : NIL;
+}
 
-//     return result;
-// }
+/**
+ * @brief Logical inverese: if the first argument is `nil`, return `t`, else `nil`.
+ * 
+ * @param frame The stack frame.
+ * @param frame_pointer A pointer to the stack frame.
+ * @param env The evaluation environment.
+ * @return struct cons_pointer `t` if the first argument is `nil`, else `nil`.
+ */
+struct cons_pointer lisp_not( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env ) {
+    return nilp( frame->arg[0]) ? TRUE : NIL;
+}
\ No newline at end of file
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index ec84d61..55bdc6a 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -225,4 +225,17 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 struct cons_pointer lisp_try( struct stack_frame *frame,
                               struct cons_pointer frame_pointer,
                               struct cons_pointer env );
+
+
+struct cons_pointer lisp_and( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env );
+
+struct cons_pointer lisp_or( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env );
+
+struct cons_pointer lisp_not( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env );
 #endif

From d34d89121198d997a5d7a8b80f841e6edea56e94 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Tue, 24 Feb 2026 09:08:41 +0000
Subject: [PATCH 61/90] Fixed subtraction regression; added new subtraction
 unit test.

---
 lisp/documentation.lisp |   9 +-
 lisp/greaterp.lisp      |   4 +-
 lisp/member.lisp        |   2 +
 src/arith/integer.c     |   4 +-
 unit-tests/subtract.sh  | 190 ++++++++++++++++++++++++++++++++++++++++
 5 files changed, 203 insertions(+), 6 deletions(-)
 create mode 100644 unit-tests/subtract.sh

diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 7c20cf0..22bd9e7 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -1,4 +1,9 @@
-(set! documentation (lambda (name)
-    (:documentation  (meta name))))
+(set! documentation (lambda (object)
+    (cond ((= (type object) "LMDA") 
+            (let (d (nth 3 (source object)))
+                (cond ((string? d) d)
+                    (t (source object)))))
+        ((member (type object) '("FUNC" "SPFM"))
+            (:documentation (meta object))))))
 
 (set! doc documentation)
diff --git a/lisp/greaterp.lisp b/lisp/greaterp.lisp
index 04a48f9..2122ccd 100644
--- a/lisp/greaterp.lisp
+++ b/lisp/greaterp.lisp
@@ -1,3 +1,3 @@
 (set! > (lambda (a b)
-
-)
\ No newline at end of file
+    "`(> a b)`: Return `t` if `a` is a number greater than `b`, else `nil`."
+    (not (negative? (- a b)))))
\ No newline at end of file
diff --git a/lisp/member.lisp b/lisp/member.lisp
index 71f5dcf..4fc29cd 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -1,3 +1,5 @@
+(set! nil? (lambda (o) (= o nil)))
+
 (set! member (lambda
             (item collection)
             "Return `t` if this `item` is a member of this `collection`, else `nil`."
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 687ff3c..1884a00 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -257,9 +257,9 @@ struct cons_pointer add_integers( struct cons_pointer a,
             debug_print_128bit( rv, DEBUG_ARITH );
             debug_print( L"\n", DEBUG_ARITH );
 
-            if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT ) ) {
+            if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) { 
                 result =
-                    acquire_integer( ( int64_t ) ( rv & 0xffffffff ), NIL );
+                    acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
                 break;
             } else {
                 struct cons_pointer new = make_integer( 0, NIL );
diff --git a/unit-tests/subtract.sh b/unit-tests/subtract.sh
new file mode 100644
index 0000000..2c2e601
--- /dev/null
+++ b/unit-tests/subtract.sh
@@ -0,0 +1,190 @@
+#!/bin/bash
+
+# Tests for smallnum subtraction
+
+result=0
+
+
+echo -n "$0: (- 5 4)... "
+
+expected="1"
+actual=`echo "(- 5 4)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 5.0 4)... "
+
+expected="1"
+actual=`echo "(- 5.0 4)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 5 4.0)... "
+
+expected="1"
+actual=`echo "(- 5 4.0)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 5.01 4.0)... "
+
+expected="1.0100000000000000002082"
+actual=`echo "(- 5.01 4.0)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 5 4/5)... "
+
+expected="24/5"
+actual=`echo "(- 5 4/5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: max smallint (- 1152921504606846975 1)... "
+
+expected="1,152,921,504,606,846,974"
+actual=`echo "(- 1152921504606846975 1)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: max smallint (- 1152921504606846975 1152921504606846974)... "
+
+expected="1"
+actual=`echo "(- 1152921504606846975 1152921504606846974)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 4 5)... "
+
+expected="-1"
+actual=`echo "(- 4 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 4 5.0)... "
+
+expected="-1"
+actual=`echo "(- 4 5.0)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 4.0 5)... "
+
+expected="-1"
+actual=`echo "(- 4.0 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 4.0 5.01)... "
+
+expected="-1.0100000000000000002082"
+actual=`echo "(- 4.0 5.01)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: (- 4/5 5)... "
+
+expected="-3/5"
+actual=`echo "(- 4/5 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: max smallint (- 1 1152921504606846975)... "
+
+expected="-1,152,921,504,606,846,974"
+actual=`echo "(- 1 1152921504606846975)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: max smallint (- 1152921504606846974 1152921504606846975)... "
+
+expected="-1"
+actual=`echo "(- 1152921504606846974 1152921504606846975)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}

From 8c63272214936514950a61e66441c94856b2275f Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 25 Feb 2026 11:17:40 +0000
Subject: [PATCH 62/90] Fixed runaway recursion in `cond`. However, `let` is
 still segfaulting, and `member` does not work correctly.

---
 docs/state-of-play.md   | 105 +++++++++++++++++++++++++++++++
 lisp/documentation.lisp |  27 +++++---
 lisp/member.lisp        |  11 +++-
 src/debug.c             |  16 +++++
 src/debug.h             |   4 ++
 src/init.c              |  20 +++---
 src/memory/conspage.c   |   6 ++
 src/memory/conspage.h   |   2 +
 src/memory/stack.c      |  56 +++++++++++++----
 src/ops/intern.c        | 131 ++++++++++++++++++---------------------
 src/ops/lispops.c       | 134 +++++++++++++++++++++++-----------------
 unit-tests/add.sh       |   2 +-
 12 files changed, 358 insertions(+), 156 deletions(-)

diff --git a/docs/state-of-play.md b/docs/state-of-play.md
index fc94b76..6893091 100644
--- a/docs/state-of-play.md
+++ b/docs/state-of-play.md
@@ -1,5 +1,110 @@
 # State of Play
 
+## 20260224
+
+Found a bug in subtraction, which I hoped might be a clue into the bignum bug;
+but it proved just to be a careless bug in the small integer cache code (and
+therefore a new regression). Fixed this one, easily.
+
+In the process spotted a new bug in subtracting rationals, which I haven't yet
+looked at.
+
+Currently working on a bug which is either in `let` or `cond`, which is leading
+to non-terminating recursion...
+
+H'mmm, there are bugs in both.
+
+#### `let`
+
+The unit test for let is segfaulting. That's a new regression today, because in
+last night's buildv it doesn't segfault. I don't know what's wrong, but to be
+honest I haven't looked very hard because I'm trying to fix the bug in `cond`.
+
+#### `cond`
+
+The unit test for `cond` still passes, so the bug that I'm seeing is not 
+triggered by it. So it's not necessarily a new bug. What's happening? Well,
+`member` doesn't terminate.
+
+The definition is as follows:
+
+```lisp
+(set! nil? 
+    (lambda 
+        (o) 
+        "`(nil? object)`: Return `t` if object is `nil`, else `t`."
+        (= o nil)))
+
+(set! member 
+    (lambda
+        (item collection)
+        "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+        (cond
+            ((nil? collection) nil)
+            ((= item (car collection)) t)
+            (t (member item (cdr collection))))))
+```
+
+In the execution trace, with tracing of bind, eval and lambda enabled, I'm 
+seeing this loop on the stack:
+
+```
+Stack frame with 1 arguments:
+	Context:  <= (member item (cdr collection)) <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA"
+Arg 0:	CONS	count:          6	value: (member item (cdr collection))
+Stack frame with 3 arguments:
+	Context:  <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA" <= (member item (cdr collection))
+Arg 0:	CONS	count:          7	value: ((nil? collection) nil)
+Arg 1:	CONS	count:          7	value: ((= item (car collection)) t)
+Arg 2:	CONS	count:          7	value: (t (member item (cdr collection)))
+Stack frame with 1 arguments:
+	Context:  <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA" <= (member item (cdr collection)) <= ((nil? collection) nil)
+Arg 0:	CONS	count:          8	value: (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection))))
+Stack frame with 2 arguments:
+	Context:  <= "LMDA" <= (member item (cdr collection)) <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection))))
+Arg 0:	STRG	count:         19	value: "LMDA"
+Arg 1:	NIL 	count: 4294967295	value: nil
+Stack frame with 1 arguments:
+	Context:  <= (member item (cdr collection)) <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA"
+Arg 0:	CONS	count:          6	value: (member item (cdr collection))
+Stack frame with 3 arguments:
+	Context:  <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA" <= (member item (cdr collection))
+Arg 0:	CONS	count:          7	value: ((nil? collection) nil)
+Arg 1:	CONS	count:          7	value: ((= item (car collection)) t)
+Arg 2:	CONS	count:          7	value: (t (member item (cdr collection)))
+Stack frame with 1 arguments:
+	Context:  <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection)))) <= "LMDA" <= (member item (cdr collection)) <= ((nil? collection) nil)
+Arg 0:	CONS	count:          8	value: (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection))))
+Stack frame with 2 arguments:
+	Context:  <= "LMDA" <= (member item (cdr collection)) <= ((nil? collection) nil) <= (cond ((nil? collection) nil) ((= item (car collection)) t) (t (member item (cdr collection))))
+Arg 0:	STRG	count:         19	value: "LMDA"
+Arg 1:	NIL 	count: 4294967295	value: nil
+```
+
+This then just goes on, and on, and on. The longest instance I've got the trace of wound up more than a third of a million stack frames before I killed it. What appears to be happening is that the cond clause
+
+```lisp
+((nil? collection) nil)
+```
+
+Executes correctly and returns nil; but that instead of terminating the cond expression at that point it continues and executes the following two clauses, resulting in (infinite) recursion.
+
+This is bad.
+
+But what's worse is that the clause
+
+```lisp
+((= item (car collection)) t)
+```
+
+also doesn't terminate the `cond` expression, even when it should.
+
+And the reason? From the trace, it appears that clauses *never* succeed. But if that's true, how come the unit tests are passing?
+
+Problem for another day.
+
+I'm not going to commit today's work to git, because I don't want to commit something I know segfaults.
+
 ## 20260220
 
 ### State of the build
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 22bd9e7..872cd3d 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -1,9 +1,20 @@
-(set! documentation (lambda (object)
-    (cond ((= (type object) "LMDA") 
-            (let (d (nth 3 (source object)))
-                (cond ((string? d) d)
-                    (t (source object)))))
-        ((member (type object) '("FUNC" "SPFM"))
-            (:documentation (meta object))))))
+;; This version segfaults, I think due to a bug in `let`?
+;; (set! documentation (lambda (object)
+;;    (cond ((= (type object) "LMDA") 
+;;            (let ((d . (nth 3 (source object))))
+;;                (cond ((string? d) d)
+;;                    (t (source object)))))
+;;        ((member (type object) '("FUNC" "SPFM"))
+;;            (:documentation (meta object))))))
+;;
+;; (set! doc documentation)
 
-(set! doc documentation)
+;; This version returns nil even when documentation exists, but doesn't segfault.
+(set! documentation
+    (lambda (object)
+        "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
+        (cond ((and (member (type object) '("LMDA" "NLMD"))
+                    (string? (nth 3 (source object))))
+                (nth 3 (source object)))
+            ((member (type object) '("FUNC" "SPFM"))
+                (:documentation (meta object))))))
diff --git a/lisp/member.lisp b/lisp/member.lisp
index 4fc29cd..9d8a7a5 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -1,9 +1,14 @@
-(set! nil? (lambda (o) (= o nil)))
+(set! nil? (lambda 
+          (o) 
+          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
+          (= o nil)))
 
 (set! member (lambda
             (item collection)
-            "Return `t` if this `item` is a member of this `collection`, else `nil`."
+            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((nil? collection) nil)
               ((= item (car collection)) t)
-              (t (member item (cdr collection))))))
\ No newline at end of file
+              (t (member item (cdr collection))))))
+
+(member (type member) '("LMDA" "NLMD"))
diff --git a/src/debug.c b/src/debug.c
index d139f8c..6fa258a 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -143,3 +143,19 @@ void debug_dump_object( struct cons_pointer pointer, int level ) {
     }
 #endif
 }
+
+/**
+ * Standardise printing of binding trace messages.
+ */
+void debug_print_binding( struct cons_pointer key, struct cons_pointer val, bool deep, int level) {
+#ifdef DEBUG
+    // wchar_t * depth = (deep ? L"Deep" : L"Shallow");
+
+    debug_print( (deep ? L"Deep" : L"Shallow"), level);
+    debug_print( L" binding `", level);
+    debug_print_object( key, level);
+    debug_print( L"` to `", level);
+    debug_print_object( val, level);
+    debug_print( L"`\n", level);
+#endif
+}
\ No newline at end of file
diff --git a/src/debug.h b/src/debug.h
index 41c1618..1bf2c18 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -8,8 +8,11 @@
  */
 
 #include 
+#include 
 #include 
 
+#include "memory/consspaceobject.h"
+
 #ifndef __debug_print_h
 #define __debug_print_h
 
@@ -84,5 +87,6 @@ void debug_println( int level );
 void debug_printf( int level, wchar_t *format, ... );
 void debug_print_object( struct cons_pointer pointer, int level );
 void debug_dump_object( struct cons_pointer pointer, int level );
+void debug_print_binding( struct cons_pointer key, struct cons_pointer val, bool deep, int level);
 
 #endif
diff --git a/src/init.c b/src/init.c
index 6a8ae55..d8e72e7 100644
--- a/src/init.c
+++ b/src/init.c
@@ -20,23 +20,22 @@
 /* libcurl, used for io */
 #include 
 
+#include "arith/peano.h"
 #include "arith/ratio.h"
-#include "version.h"
+#include "debug.h"
+#include "io/fopen.h"
+#include "io/io.h"
+#include "io/print.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "memory/stack.h"
-#include "debug.h"
 #include "memory/hashmap.h"
+#include "memory/stack.h"
 #include "ops/intern.h"
-#include "io/io.h"
-#include "io/fopen.h"
 #include "ops/lispops.h"
 #include "ops/meta.h"
-#include "arith/peano.h"
-#include "io/print.h"
 #include "repl.h"
-#include "io/fopen.h"
 #include "time/psse_time.h"
+#include "version.h"
 
 /**
  * @brief If `pointer` is an exception, display that exception to stderr, 
@@ -84,6 +83,11 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
+    if ( nilp( privileged_string_memory_exhausted)) {
+        // we can't make this string when we need it, because memory is then 
+        // exhausted!
+        privileged_string_memory_exhausted = c_string_to_lisp_string( L"Memory exhausted." );
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 2b236dc..0cc6cc8 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -45,6 +45,12 @@ int initialised_cons_pages = 0;
  */
 struct cons_pointer freelist = NIL;
 
+/**
+ * The exception message printed when the world blows up, initialised in
+ * `maybe_bind_init_symbols()` in `init.c`, q.v.
+ */
+struct cons_pointer privileged_string_memory_exhausted;
+
 /**
  * An array of pointers to cons pages.
  */
diff --git a/src/memory/conspage.h b/src/memory/conspage.h
index 589f6bf..3bad3ae 100644
--- a/src/memory/conspage.h
+++ b/src/memory/conspage.h
@@ -49,6 +49,8 @@ struct cons_page {
     struct cons_space_object cell[CONSPAGESIZE];
 };
 
+extern struct cons_pointer privileged_string_memory_exhausted;
+
 extern struct cons_pointer freelist;
 
 extern struct cons_page *conspages[NCONSPAGES];
diff --git a/src/memory/stack.c b/src/memory/stack.c
index bca9fa0..d1a344e 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -17,14 +17,14 @@
 
 #include 
 
-#include "memory/consspaceobject.h"
-#include "memory/conspage.h"
 #include "debug.h"
-#include "memory/dump.h"
-#include "ops/lispops.h"
 #include "io/print.h"
+#include "memory/conspage.h"
+#include "memory/consspaceobject.h"
+#include "memory/dump.h"
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
+#include "ops/lispops.h"
 
 /**
  * set a register in a stack frame. Alwaye use this to do so,
@@ -122,7 +122,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
     if ( nilp( result ) ) {
         /* i.e. out of memory */
         result =
-            make_exception( c_string_to_lisp_string( L"Memory exhausted." ),
+            make_exception( privileged_string_memory_exhausted,
                             previous );
     } else {
         struct stack_frame *frame = get_stack_frame( result );
@@ -163,11 +163,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 frame->more = more;
                 inc_ref( more );
             }
-
         }
+        debug_print( L"make_stack_frame: returning\n", DEBUG_STACK );
+        debug_dump_object( result, DEBUG_STACK );
     }
-    debug_print( L"make_stack_frame: returning\n", DEBUG_STACK );
-    debug_dump_object( result, DEBUG_STACK );
 
     return result;
 }
@@ -235,6 +234,40 @@ void free_stack_frame( struct stack_frame *frame ) {
     debug_print( L"Leaving free_stack_frame\n", DEBUG_ALLOC );
 }
 
+struct cons_pointer frame_get_previous( struct cons_pointer frame_pointer) {
+    struct stack_frame *frame = get_stack_frame( frame_pointer );
+    struct cons_pointer result = NIL;
+
+    if ( frame != NULL ) {
+        result = frame->previous;
+    }
+
+    return result;
+}
+
+void dump_frame_context_fragment( URL_FILE *output, struct cons_pointer frame_pointer) {
+    struct stack_frame *frame = get_stack_frame( frame_pointer );
+
+    if ( frame != NULL ) {
+        url_fwprintf( output, L" <= ");
+        print( output, frame->arg[0]);
+    }
+}
+
+void dump_frame_context( URL_FILE *output, struct cons_pointer frame_pointer, int depth ) {
+    struct stack_frame *frame = get_stack_frame( frame_pointer );
+
+    if ( frame != NULL ) {
+        url_fwprintf( output, L"\tContext: ");
+
+        int i = 0;
+        for (struct cons_pointer cursor = frame_pointer; i++ < depth && !nilp( cursor); cursor = frame_get_previous( cursor)) {
+            dump_frame_context_fragment( output, cursor);
+        }
+        
+        url_fwprintf( output, L"\n");
+    }
+}
 
 /**
  * Dump a stackframe to this stream for debugging
@@ -247,12 +280,13 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
     if ( frame != NULL ) {
         url_fwprintf( output, L"Stack frame with %d arguments:\n",
                       frame->args );
+        dump_frame_context( output, frame_pointer, 4);
+
         for ( int arg = 0; arg < frame->args; arg++ ) {
             struct cons_space_object cell = pointer2cell( frame->arg[arg] );
 
-            url_fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ",
-                          arg, cell.tag.bytes[0], cell.tag.bytes[1],
-                          cell.tag.bytes[2], cell.tag.bytes[3], cell.count );
+            url_fwprintf( output, L"Arg %d:\t%4.4s\tcount: %10u\tvalue: ",
+                          arg, cell.tag.bytes, cell.count );
 
             print( output, frame->arg[arg] );
             url_fputws( L"\n", output );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 6ea8261..7ac9d08 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -328,53 +328,63 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store ) {
     struct cons_pointer result = NIL;
+    
+    if (!nilp( key)) {
+        if ( consp( store ) ) {
+            for ( struct cons_pointer next = store;
+                nilp( result ) && ( consp( next ) || hashmapp( next ) );
+                next = pointer2cell( next ).payload.cons.cdr ) {
+                if ( consp( next ) ) {
+// #ifdef DEBUG
+//                     debug_print( L"\nc_assoc; key is `", DEBUG_BIND );
+//                     debug_print_object( key, DEBUG_BIND );
+//                     debug_print( L"`\n", DEBUG_BIND );
+// #endif
 
-    debug_print( L"c_assoc; key is `", DEBUG_BIND );
-    debug_print_object( key, DEBUG_BIND );
-    debug_print( L"`\n", DEBUG_BIND );
+                    struct cons_pointer entry_ptr = c_car( next );
+                    struct cons_space_object entry = pointer2cell( entry_ptr );
 
-    if ( consp( store ) ) {
-        for ( struct cons_pointer next = store;
-              nilp( result ) && ( consp( next ) || hashmapp( next ) );
-              next = pointer2cell( next ).payload.cons.cdr ) {
-            if ( consp( next ) ) {
-                struct cons_pointer entry_ptr = c_car( next );
-                struct cons_space_object entry = pointer2cell( entry_ptr );
+                    switch ( entry.tag.value ) {
+                        case CONSTV:
+                            if ( equal( key, entry.payload.cons.car ) ) {
+                                result = entry.payload.cons.cdr;
+                            }
+                            break;
+                        case VECTORPOINTTV:
+                            result = hashmap_get( entry_ptr, key );
+                            break;
+                        default:
+                            throw_exception( c_append
+                                            ( c_string_to_lisp_string
+                                            ( L"Store entry is of unknown type: " ),
+                                            c_type( entry_ptr ) ), NIL );
+                    }
 
-                switch ( entry.tag.value ) {
-                    case CONSTV:
-                        if ( equal( key, entry.payload.cons.car ) ) {
-                            result = entry.payload.cons.cdr;
-                        }
-                        break;
-                    case VECTORPOINTTV:
-                        result = hashmap_get( entry_ptr, key );
-                        break;
-                    default:
-                        throw_exception( c_append
-                                         ( c_string_to_lisp_string
-                                           ( L"Store entry is of unknown type: " ),
-                                           c_type( entry_ptr ) ), NIL );
+// #ifdef DEBUG
+//                     debug_print( L"c_assoc `", DEBUG_BIND );
+//                     debug_print_object( key, DEBUG_BIND );
+//                     debug_print( L"` returning: ", DEBUG_BIND );
+//                     debug_print_object( result, DEBUG_BIND );
+//                     debug_println( DEBUG_BIND );
+// #endif
                 }
             }
+        } else if ( hashmapp( store ) ) {
+            result = hashmap_get( store, key );
+        } else if ( !nilp( store ) ) {
+// #ifdef DEBUG        
+//             debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
+//             debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
+//             debug_print( L"`\n", DEBUG_BIND );
+// #endif
+            result =
+                throw_exception( c_append
+                                ( c_string_to_lisp_string
+                                ( L"Store is of unknown type: " ),
+                                c_type( store ) ), NIL );
         }
-    } else if ( hashmapp( store ) ) {
-        result = hashmap_get( store, key );
-    } else if ( !nilp( store ) ) {
-        debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-        debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
-        debug_print( L"`\n", DEBUG_BIND );
-        result =
-            throw_exception( c_append
-                             ( c_string_to_lisp_string
-                               ( L"Store is of unknown type: " ),
-                               c_type( store ) ), NIL );
     }
 
-    debug_print( L"c_assoc returning ", DEBUG_BIND );
-    debug_print_object( result, DEBUG_BIND );
-    debug_println( DEBUG_BIND );
-
     return result;
 }
 
@@ -415,36 +425,22 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    debug_print( L"set: binding `", DEBUG_BIND );
-    debug_print_object( key, DEBUG_BIND );
-    debug_print( L"` to `", DEBUG_BIND );
-    debug_print_object( value, DEBUG_BIND );
-    debug_print( L"` in store ", DEBUG_BIND );
-    debug_dump_object( store, DEBUG_BIND );
-    debug_println( DEBUG_BIND );
+    bool deep = vectorpointp( store);
+    debug_print_binding( key, value, deep, DEBUG_BIND);
 
-    debug_printf( DEBUG_BIND, L"set: store is %4.4s",
-                  pointer2cell(store).tag.bytes );
-    if (strncmp(pointer2cell(store).tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
-        debug_printf( DEBUG_BIND, L" -> %4.4s\n",
+    if (deep) {
+        debug_printf( DEBUG_BIND, L"\t-> %4.4s\n",
                   pointer2cell(store).payload.vectorp.tag.bytes );
-    } else {
-        debug_println( DEBUG_BIND);
-    }
+    } 
 #endif
     if ( nilp( value ) ) {
         result = store;
     } else if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
-        debug_print( L"set: storing in hashmap\n", DEBUG_BIND );
         result = hashmap_put( store, key, value );
     }
 
-    debug_print( L"set returning ", DEBUG_BIND );
-    debug_print_object( result, DEBUG_BIND );
-    debug_println( DEBUG_BIND );
-
     return result;
 }
 
@@ -457,18 +453,13 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
 
     struct cons_pointer old = oblist;
 
-    debug_print( L"deep_bind: binding `", DEBUG_BIND );
-    debug_print_object( key, DEBUG_BIND );
-    debug_print( L"` to ", DEBUG_BIND );
-    debug_print_object( value, DEBUG_BIND );
-    debug_println( DEBUG_BIND );
-
     oblist = set( key, value, oblist );
 
-    if ( consp( oblist ) ) {
-        inc_ref( oblist );
-        dec_ref( old );
-    }
+    // The oblist is not now an assoc list, and I don't think it will be again.
+    // if ( consp( oblist ) ) {
+    //     inc_ref( oblist );
+    //     dec_ref( old );
+    // }
 
     debug_print( L"deep_bind returning ", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
@@ -480,7 +471,7 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
 /**
  * Ensure that a canonical copy of this key is bound in this environment, and
  * return that canonical copy. If there is currently no such binding, create one
- * with the value NIL.
+ * with the value TRUE.
  */
 struct cons_pointer
 intern( struct cons_pointer key, struct cons_pointer environment ) {
@@ -490,7 +481,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
         /*
          * not currently bound
          */
-        result = set( key, NIL, environment );
+        result = set( key, TRUE, environment );
     }
 
     return result;
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4f51c3b..4fbebcf 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -109,7 +109,9 @@ struct cons_pointer eval_form( struct stack_frame *parent,
             break;
     }
 
-    debug_print( L"eval_form returning: ", DEBUG_EVAL );
+    debug_print( L"eval_form ", DEBUG_EVAL );
+    debug_print_object( form, DEBUG_EVAL );
+    debug_print( L" returning: ", DEBUG_EVAL );
     debug_print_object( result, DEBUG_EVAL );
     debug_println( DEBUG_EVAL );
 
@@ -241,12 +243,6 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
     return make_nlambda( frame->arg[0], compose_body( frame ) );
 }
 
-void log_binding( struct cons_pointer name, struct cons_pointer val ) {
-    debug_print( L"\n\tBinding ", DEBUG_LAMBDA );
-    debug_dump_object( name, DEBUG_LAMBDA  );
-    debug_print( L" to ", DEBUG_LAMBDA  );
-    debug_dump_object( val, DEBUG_LAMBDA  );
-}
 
 /**
  * Evaluate a lambda or nlambda expression.
@@ -255,8 +251,10 @@ struct cons_pointer
 eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
              struct cons_pointer frame_pointer, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
+#ifdef DEBUG    
     debug_print( L"eval_lambda called\n", DEBUG_LAMBDA );
     debug_println( DEBUG_LAMBDA );
+#endif
 
     struct cons_pointer new_env = env;
     struct cons_pointer names = cell.payload.lambda.args;
@@ -270,11 +268,11 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
             struct cons_pointer val = frame->arg[i];
 
             new_env = set( name, val, new_env );
-            log_binding( name, val );
+            debug_print_binding( name, val, false, DEBUG_BIND );
 
             names = c_cdr( names );
         }
-        inc_ref( new_env );
+//        inc_ref( new_env );
 
         /* \todo if there's more than `args_in_frame` arguments, bind those too. */
     } else if ( symbolp( names ) ) {
@@ -295,7 +293,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
         }
 
         new_env = set( names, vals, new_env );
-        inc_ref( new_env );
+//        inc_ref( new_env );
     }
 
     while ( !nilp( body ) ) {
@@ -311,7 +309,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
         /* if a result is not the terminal result in the lambda, it's a
          * side effect, and needs to be GCed */
         if ( !nilp( result ) ){
-            // dec_ref( result );
+            dec_ref( result );
         }
 
         result = eval_form( frame, frame_pointer, sexpr, new_env );
@@ -1156,6 +1154,46 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
     return result;
 }
 
+/**
+ * @brief evaluate a single cond clause; if the test part succeeds return a 
+ * pair whose car is TRUE and whose cdr is the value of the action part 
+ */
+struct cons_pointer eval_cond_clause( struct cons_pointer clause, 
+    struct stack_frame *frame, struct cons_pointer frame_pointer, 
+    struct cons_pointer env) {
+    struct cons_pointer result = NIL;
+
+#ifdef DEBUG
+    debug_print( L"\n\tCond clause: ", DEBUG_EVAL );
+    debug_print_object( clause, DEBUG_EVAL );
+    debug_println( DEBUG_EVAL);
+#endif
+
+    if (consp(clause)) {
+        struct cons_pointer val = eval_form( frame, frame_pointer, c_car( clause ),
+                           env );
+
+        if (!nilp( val)) {
+            result = make_cons( TRUE, c_progn( frame, frame_pointer, c_cdr( clause ),
+                             env ));
+
+#ifdef DEBUG
+                debug_print(L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL);
+                debug_print_object( result, DEBUG_EVAL);
+                debug_println( DEBUG_EVAL);
+        } else {
+            debug_print(L"\n\t\tclause failed.\n", DEBUG_EVAL);
+#endif
+        }          
+    } else {
+        result = throw_exception( c_string_to_lisp_string
+                                    ( L"Arguments to `cond` must be lists" ),
+                                    frame_pointer );
+    }
+
+    return result;
+}
+
 /**
  * Special form: conditional. Each `clause` is expected to be a list; if the first
  * item in such a list evaluates to non-NIL, the remaining items in that list
@@ -1175,33 +1213,22 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
     struct cons_pointer result = NIL;
     bool done = false;
 
-    for ( int i = 0; i < args_in_frame && !done; i++ ) {
-        struct cons_pointer clause_pointer = frame->arg[i];
-        debug_print( L"Cond clause: ", DEBUG_EVAL );
-        debug_dump_object( clause_pointer, DEBUG_EVAL );
+    for ( int i = 0; (i < frame->args) && !done; i++ ) {
+        struct cons_pointer clause_pointer = fetch_arg( frame, i);
 
-        if ( consp( clause_pointer ) ) {
-            struct cons_space_object cell = pointer2cell( clause_pointer );
-            result =
-                eval_form( frame, frame_pointer, c_car( clause_pointer ),
-                           env );
+        result = eval_cond_clause( clause_pointer, frame, frame_pointer, env);
 
-            if ( !nilp( result ) ) {
-                result =
-                    c_progn( frame, frame_pointer, c_cdr( clause_pointer ),
-                             env );
-                done = true;
-            }
-        } else if ( nilp( clause_pointer ) ) {
+        if ( !nilp( result ) && truep( c_car( result)) ) {
+            result = c_cdr( result);
             done = true;
-        } else {
-            result = throw_exception( c_string_to_lisp_string
-                                      ( L"Arguments to `cond` must be lists" ),
-                                      frame_pointer );
-        }
+            break;
+        } 
     }
-    /* \todo if there are more than 8 clauses we need to continue into the
-     * remainder */
+#ifdef DEBUG
+    debug_print( L"\tCond returning: ", DEBUG_EVAL );
+    debug_print_object( result, DEBUG_EVAL );
+    debug_println( DEBUG_EVAL); 
+#endif
 
     return result;
 }
@@ -1540,6 +1567,8 @@ struct cons_pointer lisp_list( struct stack_frame *frame,
     return result;
 }
 
+
+
 /**
  * Special form: evaluate a series of forms in an environment in which
  * these bindings are bound.
@@ -1557,11 +1586,13 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
         struct cons_pointer symbol = c_car( pair );
 
         if ( symbolp( symbol ) ) {
+            struct cons_pointer val = eval_form( frame, frame_pointer, c_cdr( pair ),
+                                        bindings );
+
+            debug_print_binding( symbol, val, false, DEBUG_BIND);
+
             bindings =
-                make_cons( make_cons
-                           ( symbol,
-                             eval_form( frame, frame_pointer, c_cdr( pair ),
-                                        bindings ) ), bindings );
+                make_cons( make_cons( symbol, val ), bindings );
 
         } else {
             result =
@@ -1579,6 +1610,11 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
                        bindings );
     }
 
+    // release the local bindings as they go out of scope!
+    for (struct cons_pointer cursor = bindings; !eq( cursor, env); cursor = c_cdr(cursor)) {
+        dec_ref( cursor);
+    }
+
     return result;
 
 }
@@ -1597,16 +1633,10 @@ struct cons_pointer lisp_and( struct stack_frame *frame,
     bool accumulator = true;                            
     struct cons_pointer result = frame->more;
 
-    for ( int a = 0; accumulator == true && a < args_in_frame; a++) {
-        accumulator = truthy( frame->arg[ a]);
+    for ( int a = 0; accumulator == true && a < frame->args; a++) {
+        accumulator = truthy( fetch_arg( frame, a));
     }
-
-    if ( accumulator && ! nilp( frame->more)) {
-        for ( struct cons_pointer rest = frame->more; accumulator == true && !nilp( rest); rest = c_cdr(rest)) {
-            accumulator = truthy( c_car( rest));
-        } 
-    }
-
+#
     return accumulator ? TRUE : NIL;
 }
 
@@ -1624,14 +1654,8 @@ struct cons_pointer lisp_or( struct stack_frame *frame,
     bool accumulator = false;                            
     struct cons_pointer result = frame->more;
 
-    for ( int a = 0; accumulator == false && a < args_in_frame; a++) {
-        accumulator = truthy( frame->arg[ a]);
-    }
-
-    if ( ! accumulator && ! nilp( frame->more)) {
-        for ( struct cons_pointer rest = frame->more; accumulator == false && !nilp( rest); rest = c_cdr(rest)) {
-            accumulator = truthy( c_car( rest));
-        } 
+    for ( int a = 0; accumulator == false && a < frame->args; a++) {
+        accumulator = truthy( fetch_arg( frame, a));
     }
 
     return accumulator ? TRUE : NIL;
diff --git a/unit-tests/add.sh b/unit-tests/add.sh
index ca6f2a8..d4c1d26 100755
--- a/unit-tests/add.sh
+++ b/unit-tests/add.sh
@@ -86,7 +86,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=`echo "${result} + 1" | bc `
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

From 3665326c55b30dc485365926db0f6beff24aaa90 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 25 Feb 2026 15:24:02 +0000
Subject: [PATCH 63/90] Made `eq` and `equal` vararg functions, and appended
 `?` to their names as predicates.

---
 src/init.c         | 11 ++++----
 src/ops/equal.c    | 32 ++++------------------
 src/ops/lispops.c  | 68 ++++++++++++++++++++++++++++++++++++++--------
 src/ops/lispops.h  |  3 ++
 unit-tests/add.sh  |  2 +-
 unit-tests/cond.sh |  4 +--
 unit-tests/let.sh  | 40 +++++++++++++--------------
 7 files changed, 94 insertions(+), 66 deletions(-)

diff --git a/src/init.c b/src/init.c
index d8e72e7..13c939f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -361,11 +361,12 @@ int main( int argc, char *argv[] ) {
         &lisp_cdr );
     bind_function( L"close", L"`(close stream)`: If `stream` is a stream, close that stream.", &lisp_close );
     bind_function( L"cons", L"`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.", &lisp_cons );
+    bind_function( L"count", L"`(count s)`: Return the number of items in the sequence `s`.", &lisp_count);
     bind_function( L"divide", 
         L"`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.", 
         &lisp_divide );
-    bind_function( L"eq", L"`(eq a b)`: Return `t` if `a` and `b` are the exact same object, else `nil`.", &lisp_eq );
-    bind_function( L"equal", L"`(eq a b)`: Return `t` if `a` and `b` have logically equivalent value, else `nil`.", &lisp_equal );
+    bind_function( L"eq?", L"`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.", &lisp_eq );
+    bind_function( L"equal?", L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.", &lisp_equal );
     bind_function( L"eval", L"", &lisp_eval );
     bind_function( L"exception", L"`(exception message)`: Return (throw) an exception with this `message`.", &lisp_exception );
     bind_function( L"get-hash", L"`(get-hash arg)`: returns the natural number hash value of `arg`.", &lisp_get_hash );
@@ -393,7 +394,7 @@ int main( int argc, char *argv[] ) {
     bind_function( L"print", L"`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.", &lisp_print );
     bind_function( L"put!", L"", lisp_hashmap_put );
     bind_function( L"put-all!", L"", &lisp_hashmap_put_all );
-    bind_function( L"ratio->real", L"", &lisp_ratio_to_real );
+    bind_function( L"ratio->real", L"`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.", &lisp_ratio_to_real );
     bind_function( L"read", L"", &lisp_read );
     bind_function( L"read-char", L"", &lisp_read_char );
     bind_function( L"repl", L"", &lisp_repl );
@@ -405,11 +406,11 @@ int main( int argc, char *argv[] ) {
     bind_function( L"throw", L"", &lisp_exception );
     bind_function( L"time", L"", &lisp_time );
     bind_function( L"type", L"", &lisp_type );
-    bind_function( L"+", L"", &lisp_add );
+    bind_function( L"+", L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.", &lisp_add );
     bind_function( L"*", L"", &lisp_multiply );
     bind_function( L"-", L"", &lisp_subtract );
     bind_function( L"/", L"", &lisp_divide );
-    bind_function( L"=", L"", &lisp_equal );
+    bind_function( L"=", L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.", &lisp_equal );
     /*
      * primitive special forms
      */
diff --git a/src/ops/equal.c b/src/ops/equal.c
index cd49a3f..1ad2fdc 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -333,9 +333,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
     debug_print( L" = ", DEBUG_ARITH );
     debug_print_object( b, DEBUG_ARITH );
 
-    bool result = eq( a, b );
-
-    if ( !result && same_type( a, b ) ) {
+    bool result = false; 
+    
+    if ( eq( a, b )) {
+        result = true;
+    } else if ( !numberp( a ) && same_type( a, b ) ) {
         struct cons_space_object *cell_a = &pointer2cell( a );
         struct cons_space_object *cell_b = &pointer2cell( b );
 
@@ -378,30 +380,6 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                       || ( end_of_string( cell_a->payload.string.cdr )
                            && end_of_string( cell_b->payload.string.cdr ) ) );
                 break;
-            case INTEGERTV:
-                result =
-                    ( cell_a->payload.integer.value ==
-                      cell_b->payload.integer.value ) &&
-                    equal( cell_a->payload.integer.more,
-                           cell_b->payload.integer.more );
-                break;
-            case RATIOTV:
-                result = equal_ratio_ratio( a, b );
-                break;
-            case REALTV:
-                {
-                    double num_a = to_long_double( a );
-                    double num_b = to_long_double( b );
-                    double max = fabs( num_a ) > fabs( num_b )
-                        ? fabs( num_a )
-                        : fabs( num_b );
-
-                    /*
-                     * not more different than one part in a million - close enough
-                     */
-                    result = fabs( num_a - num_b ) < ( max / 1000000.0 );
-                }
-                break;
             case VECTORPOINTTV:
                 if ( cell_b->tag.value == VECTORPOINTTV) {
                     result = equal_vector_vector( a, b);
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4fbebcf..fc91e9c 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -870,12 +870,16 @@ struct cons_pointer lisp_keys( struct stack_frame *frame,
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env ) {
-    if ( frame->args == 2) {
-        return eq( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
-    } else {
-        return throw_exception( c_string_to_lisp_string( L"Wrong number of args to `eq`."),
-            frame_pointer);
-    }
+    struct cons_pointer result = TRUE;   
+
+    if ( frame->args > 1) {
+        for (int b = 1; ( truep( result )) && (b < frame->args); b++)
+        {
+            result = eq( frame->arg[0], fetch_arg( frame, b)) ? TRUE : NIL;
+        }
+    } 
+    
+    return result;
 }
 
 /**
@@ -891,12 +895,54 @@ struct cons_pointer lisp_eq( struct stack_frame *frame,
 struct cons_pointer
 lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    if ( frame->args == 2) {
-        return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
-    } else {    
-        return throw_exception( c_string_to_lisp_string( L"Wrong number of args to `equal`."),
-            frame_pointer);
+    struct cons_pointer result = TRUE;   
+
+    if ( frame->args > 1) {
+        for (int b = 1; ( truep( result )) && (b < frame->args); b++)
+        {
+            result = equal( frame->arg[0], fetch_arg( frame, b)) ? TRUE : NIL;
+        }
+    } 
+    
+    return result;
+}
+
+long int c_count (struct cons_pointer p) {
+    struct cons_space_object * cell = &pointer2cell( p);
+    int result = 0;
+
+    switch (cell->tag.value) {
+        case CONSTV:
+        case STRINGTV:
+        /* I think doctrine is that you cannot treat symbols or keywords as
+         * sequences, although internally, of course, they are. Integers are
+         * also internally sequences, but also should not be treated as such.
+         */
+        for (p; !nilp( p); p = c_cdr( p)) {
+            result ++;
+        }
     }
+
+    return result;
+}
+
+/**
+ * Function: return the number of top level forms in the object which is
+ * the first (and only) argument, if it is a sequence (which for current
+ * purposes means a list or a string)
+ *
+ * * (count l)
+ *
+ * @param frame my stack_frame.
+ * @param frame_pointer a pointer to my stack_frame.
+ * @param env my environment (ignored).
+ * @return the number of top level forms in a list, or characters in a
+ *         string, else 0.
+ */
+struct cons_pointer
+lisp_count( struct stack_frame *frame, struct cons_pointer frame_pointer,
+            struct cons_pointer env ) {
+    return acquire_integer( c_count( frame->arg[ 0]), NIL);
 }
 
 /**
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 55bdc6a..d29b3b8 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -149,6 +149,9 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 struct cons_pointer lisp_reverse( struct stack_frame *frame,
                                   struct cons_pointer frame_pointer,
                                   struct cons_pointer env );
+struct cons_pointer
+lisp_count( struct stack_frame *frame, struct cons_pointer frame_pointer,
+            struct cons_pointer env );
 
 /**
  * Function: Get the Lisp type of the single argument.
diff --git a/unit-tests/add.sh b/unit-tests/add.sh
index d4c1d26..aab4073 100755
--- a/unit-tests/add.sh
+++ b/unit-tests/add.sh
@@ -77,7 +77,7 @@ expected='6.25'
 actual=`echo "(+ 6.000000001 1/4)" |\
   target/psse 2> /dev/null |\
   sed -r '/^\s*$/d' |\
-  sed 's/0*$//' 
+  sed 's/0*$//'`
 
 outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
 
diff --git a/unit-tests/cond.sh b/unit-tests/cond.sh
index 86f0e9f..12552bd 100755
--- a/unit-tests/cond.sh
+++ b/unit-tests/cond.sh
@@ -5,7 +5,7 @@ result=0
 echo -n "$0: cond with one clause... "
 
 expected='5'
-actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(cond ((equal? 2 2) 5))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -18,7 +18,7 @@ fi
 echo -n "$0: cond with two clauses... "
 
 expected='"should"'
-actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(cond ((equal? 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index 037a96a..ad75185 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -2,28 +2,28 @@
 
 result=0
 
-echo -n "$0: let with two bindings, one form in body..."
-expected='11'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
+# echo -n "$0: let with two bindings, one form in body..."
+# expected='11'
+# actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
 
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=`echo "${result} + 1" | bc`
-fi
+# if [ "${expected}" = "${actual}" ]
+# then
+#     echo "OK"
+# else
+#     echo "Fail: expected '$expected', got '$actual'"
+#     result=`echo "${result} + 1" | bc`
+# fi
 
-echo -n "$0: let with two bindings, two forms in body..."
-expected='1'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
+# echo -n "$0: let with two bindings, two forms in body..."
+# expected='1'
+# actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
 
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=`echo "${result} + 1" | bc`
-fi
+# if [ "${expected}" = "${actual}" ]
+# then
+#     echo "OK"
+# else
+#     echo "Fail: expected '$expected', got '$actual'"
+#     result=`echo "${result} + 1" | bc`
+# fi
 
 exit ${result}
\ No newline at end of file

From 90e862cc5917dbcdc742814fa0389df4a11766b8 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 25 Feb 2026 20:13:57 +0000
Subject: [PATCH 64/90] `let` segfault bug "fixed". *But* I suspect there's
 memory leaking here.

---
 src/ops/lispops.c | 12 +++++++-----
 unit-tests/let.sh | 40 ++++++++++++++++++++--------------------
 2 files changed, 27 insertions(+), 25 deletions(-)

diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index fc91e9c..074566e 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1639,7 +1639,6 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 
             bindings =
                 make_cons( make_cons( symbol, val ), bindings );
-
         } else {
             result =
                 throw_exception( c_string_to_lisp_string
@@ -1649,6 +1648,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
         }
     }
 
+    debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND);
+
     /* i.e., no exception yet */
     for ( int form = 1; !exceptionp( result ) && form < frame->args; form++ ) {
         result =
@@ -1656,10 +1657,11 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
                        bindings );
     }
 
-    // release the local bindings as they go out of scope!
-    for (struct cons_pointer cursor = bindings; !eq( cursor, env); cursor = c_cdr(cursor)) {
-        dec_ref( cursor);
-    }
+    /* release the local bindings as they go out of scope! **BUT** 
+     * bindings were consed onto the front of env, so caution... */
+    // for (struct cons_pointer cursor = bindings; !eq( cursor, env); cursor = c_cdr(cursor)) {
+    //     dec_ref( cursor);
+    // }
 
     return result;
 
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index ad75185..037a96a 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -2,28 +2,28 @@
 
 result=0
 
-# echo -n "$0: let with two bindings, one form in body..."
-# expected='11'
-# actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
+echo -n "$0: let with two bindings, one form in body..."
+expected='11'
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
 
-# if [ "${expected}" = "${actual}" ]
-# then
-#     echo "OK"
-# else
-#     echo "Fail: expected '$expected', got '$actual'"
-#     result=`echo "${result} + 1" | bc`
-# fi
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
 
-# echo -n "$0: let with two bindings, two forms in body..."
-# expected='1'
-# actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
+echo -n "$0: let with two bindings, two forms in body..."
+expected='1'
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
 
-# if [ "${expected}" = "${actual}" ]
-# then
-#     echo "OK"
-# else
-#     echo "Fail: expected '$expected', got '$actual'"
-#     result=`echo "${result} + 1" | bc`
-# fi
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
 
 exit ${result}
\ No newline at end of file

From ffceda5edc572a49fc49d333d2c6bcf9803e64bf Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 25 Feb 2026 22:10:37 +0000
Subject: [PATCH 65/90] Greatly improved performance of `equal` for string like
 things.

---
 src/memory/consspaceobject.c |  2 +-
 src/ops/equal.c              | 47 ++++++++++++++++++++++++------------
 src/ops/equal.h              |  6 +++++
 3 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3f85ed6..0bd0b90 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -150,7 +150,7 @@ struct cons_pointer c_car( struct cons_pointer arg ) {
 
 /**
  * Implementation of cdr in C. If arg is not a sequence, or the current user is
- * not authorised to read it,does not error but returns nil.
+ * not authorised to read it, does not error but returns nil.
  */
 struct cons_pointer c_cdr( struct cons_pointer arg ) {
     struct cons_pointer result = NIL;
diff --git a/src/ops/equal.c b/src/ops/equal.c
index 1ad2fdc..fca8f61 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -9,6 +9,7 @@
 
 #include 
 #include 
+#include 
 
 #include "arith/integer.h"
 #include "arith/peano.h"
@@ -363,22 +364,38 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 /* TODO: it is not OK to do this on the stack since list-like 
                  * structures can be of indefinite extent. It *must* be done by 
                  * iteration (and even that is problematic) */
+                if (cell_a->payload.string.hash == cell_b->payload.string.hash) {
+                    wchar_t a_buff[ STRING_SHIPYARD_SIZE], b_buff[ STRING_SHIPYARD_SIZE];
+                    uint32_t tag = cell_a->tag.value;
+                    int i = 0;
+
+                    memset(a_buff,0,sizeof(a_buff));
+                    memset(b_buff,0,sizeof(b_buff));
+
+                    for (; (i < (STRING_SHIPYARD_SIZE - 1)) && !nilp( a) && !nilp( b); i++) {
+                        a_buff[i] = cell_a->payload.string.character;
+                        a = c_cdr(a);
+                        cell_a = &pointer2cell( a );
+
+                        b_buff[i] = cell_b->payload.string.character;
+                        b = c_cdr( b);
+                        cell_b = &pointer2cell( b); 
+                    }
+
 #ifdef DEBUG
-                 debug_print( L"Comparing '", DEBUG_ARITH);
-                 debug_print_object( a, DEBUG_ARITH);
-                 debug_print( L"' to '", DEBUG_ARITH);
-                 debug_print_object( b, DEBUG_ARITH);
+                    debug_print( L"Comparing '", DEBUG_LAMBDA);
+                    debug_print( a_buff, DEBUG_LAMBDA);
+                    debug_print( L"' to '", DEBUG_LAMBDA);
+                    debug_print( b_buff, DEBUG_LAMBDA);
+                    debug_print( L"'\n", DEBUG_LAMBDA);
 #endif
-                result =
-                    cell_a->payload.string.hash == cell_b->payload.string.hash
-                    && cell_a->payload.string.character ==
-                    cell_b->payload.string.character
-                    &&
-                    ( equal
-                      ( cell_a->payload.string.cdr,
-                        cell_b->payload.string.cdr )
-                      || ( end_of_string( cell_a->payload.string.cdr )
-                           && end_of_string( cell_b->payload.string.cdr ) ) );
+
+                    /* OK, now we have wchar string buffers loaded from the objects. We 
+                     * may not have exhausted either string, so the buffers being equal
+                     * isn't sufficient. So we recurse at least once. */
+
+                    result = (wcsncmp( a_buff, b_buff, i) == 0) && equal( c_cdr(a), c_cdr(b));
+                }
                 break;
             case VECTORPOINTTV:
                 if ( cell_b->tag.value == VECTORPOINTTV) {
@@ -403,7 +420,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
-    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
+    debug_printf( DEBUG_LAMBDA, L"\nequal returning %d\n", result );
 
     return result;
 }
diff --git a/src/ops/equal.h b/src/ops/equal.h
index 1f27104..061eb94 100644
--- a/src/ops/equal.h
+++ b/src/ops/equal.h
@@ -15,6 +15,12 @@
 #ifndef __equal_h
 #define __equal_h
 
+/** 
+ * size of buffer for assembling strings. Likely to be useful to
+ * read, too.
+ */
+#define STRING_SHIPYARD_SIZE 1024
+
 /**
  * Shallow, and thus cheap, equality: true if these two objects are 
  * the same object, else false.

From af21e506efbf22884d5eb30fb1cbb504afe43a51 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Wed, 25 Feb 2026 22:16:14 +0000
Subject: [PATCH 66/90] Whoops! Had the wrong debug tag on debug calls in
 equal.c

---
 src/ops/equal.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/ops/equal.c b/src/ops/equal.c
index fca8f61..cdfabbf 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -383,11 +383,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     }
 
 #ifdef DEBUG
-                    debug_print( L"Comparing '", DEBUG_LAMBDA);
-                    debug_print( a_buff, DEBUG_LAMBDA);
-                    debug_print( L"' to '", DEBUG_LAMBDA);
-                    debug_print( b_buff, DEBUG_LAMBDA);
-                    debug_print( L"'\n", DEBUG_LAMBDA);
+                    debug_print( L"Comparing '", DEBUG_ARITH);
+                    debug_print( a_buff, DEBUG_ARITH);
+                    debug_print( L"' to '", DEBUG_ARITH);
+                    debug_print( b_buff, DEBUG_ARITH);
+                    debug_print( L"'\n", DEBUG_ARITH);
 #endif
 
                     /* OK, now we have wchar string buffers loaded from the objects. We 
@@ -420,7 +420,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
-    debug_printf( DEBUG_LAMBDA, L"\nequal returning %d\n", result );
+    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
 
     return result;
 }

From dd90b84241dd3e0e832384683fd55941e66fe492 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 26 Feb 2026 00:06:19 +0000
Subject: [PATCH 67/90] Work on documentation

---
 docs/Home.md                                  | 48 ++++++++++++++-
 docs/Roadmap.md                               | 58 +++++++++++++++++++
 docs/{state-of-play.md => State-of-play.md}   | 11 ++++
 ...logy-of-the-hardware-of-the-deep-future.md |  8 ++-
 4 files changed, 120 insertions(+), 5 deletions(-)
 create mode 100644 docs/Roadmap.md
 rename docs/{state-of-play.md => State-of-play.md} (99%)

diff --git a/docs/Home.md b/docs/Home.md
index b0ffb0b..8ca58cb 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -8,7 +8,11 @@ Work towards the implementation of a software system like that described in [Pos
 
 ## State of Play
 
-You can read about the current [state of play](md_home_2simon_2workspace_2post-scarcity_2docs_2state-of-play.html).
+You can read about the current [state of play](State-of-play.md).
+
+## Roadmap
+
+There is now a [roadmap](Roadmap.md) for the project.
 
 ## AWFUL WARNING 1
 
@@ -17,8 +21,8 @@ This does not work. It isn't likely to work any time soon. If you want to learn
 What it sets out to be is a Lisp-like system which:
 
 * Can make use (albeit not, at least at first, very efficiently) of machines with at least [Zettabytes](http://highscalability.com/blog/2012/9/11/how-big-is-a-petabyte-exabyte-zettabyte-or-a-yottabyte.html) of RAM;
-* Can make reasonable use of machines with at least tens of thousands of processors;
-* Can concurrently support significant numbers of concurrent users, all doing different things, without them ever interfering with one another;
+* Can make reasonable use of machines with at least billions of processors;
+* Can concurrently support significant numbers of users, all doing different things, without them ever interfering with one another;
 * Can ensure that users cannot escalate privilege;
 * Can ensure users private data remains private.
 
@@ -32,3 +36,41 @@ When Linus Torvalds sat down in his bedroom to write Linux, he had something usa
 
 This project is necessarily experimental and exploratory. I write code, it reveals new problems, I think about them, and I mutate the design. This documentation does not always keep up with the developing source code.
 
+## Building
+
+The substrate of this system is written in plain old fashioned C and built with a Makefile. I regret this decision; I think either Zig or Rust would have been better places to start; but neither of them were sufficiently well developed to support what I wanted to do when I did start.
+
+To build, you need a C compiler; I use GCC, others may work. You need a make utility; I use GNU Make. You need [libcurl](https://curl.se/libcurl/).
+
+With these dependencies in place, clone the repository from [here](https://git.journeyman.cc/simon/post-scarcity/), and run `make` in the resulting project directory. If all goes well you will find and executable, `psse`, in the target directory.
+
+## In use
+
+### Invoking
+
+When invoking the system, the following invokation arguments may be passed:
+```
+        -d      Dump memory to standard out at end of run (copious!);
+        -h      Print this message and exit;
+        -p      Show a prompt (default is no prompt);
+        -v LEVEL
+                Set verbosity to the specified level (0...512)
+                Where bits are interpreted as follows:
+                1       ALLOC;
+                2       ARITH;
+                4       BIND;
+                8       BOOTSTRAP;
+                16      EVAL;
+                32      INPUT/OUTPUT;
+                64      LAMBDA;
+                128     REPL;
+                256     STACK.
+```
+
+Note that any verbosity level produces a great deal of output, and although standardising the output to make it more legible is something I'm continually working on, it's still hard to read the output. It is printed to stderr, so can be redirected to a file for later analysis, which is the best plan.
+
+### Functions and symbols
+
+The following functions and keys are provided as of release 0.0.6:
+
+```
diff --git a/docs/Roadmap.md b/docs/Roadmap.md
new file mode 100644
index 0000000..a64909e
--- /dev/null
+++ b/docs/Roadmap.md
@@ -0,0 +1,58 @@
+# Roadmap
+
+With the release of 0.0.6 close, it's time to look at a plan for the future development of the project.
+
+I have an almost-working Lisp interpreter, which, as an interpreter, has many of the features of the language I want. It runs in one thread on one processor.
+
+Given how experimental this all is, I don't think I need it to be a polished interpreter, and polished it isn't. Lots of things are broken.
+
+* garbage collection is pretty broken, and I'n beginning to doubt my whole garbage collection strategy;
+* bignums are horribly broken;
+* there's something very broken in shallow-bound symbols, and that matters and wil have to be fixed;
+* there are undoubtedly many other bugs I don't know about.
+
+However, while I will fix bugs where I can, it's good enough for other people to play with if they're mad enough, and it's time to move on.
+
+## Next major milestones
+
+### Simulated hypercube
+
+There is really no point to this whole project while it remains a single thread running on a single processor. Until I can pass off computation to peer neighbours, I can't begin to understand what the right strategies are for when to do so.
+
+`cond` is explicitly sequential, since later clauses should not be executed at all if earlier ones succeed. `progn` is sort of implicitly sequential, since it's the value of the last form in the sequence which will be returned.
+
+For `mapcar`, the right strategy might be to partition the list argument between each of the idle neighbours, and then reassemble the results that come bask.
+
+For most other things, my hunch is that you pass args which are not self-evaluating to idle neighbours, keeping (at least) one on the originating node to work on while they're busy.
+
+But before that can happen, we need a router on each node which can monitor concurrent traffic on six bidirectional links. I think at least initially what gets written across those links is just S-expressions.
+
+I think a working simulated hypercube is the key milestone for version 0.0.7.
+
+### Sysout, sysin, and system persistance
+
+Doctrine is that the post scarcity computing environment doesn't have a file system, but nevertheless we need some way of making an image of a working system so that, after a catastrophic crash or a power outage, it can be brought back up to a known good state. This also really needs to be in 0.0.7. 
+
+### Better command line experience
+
+The current command line experience is embarrasingly poor. Recallable input history, input line editing, and a proper structure editor are all things that I will need for my comfort.
+
+### Users, groups and ACLs
+
+Allowing multiple users to work together within the same post scarcity computing environment while retaining security and privacy is a major goal. So working out ways for users to sign on and be authenticated, and to configure their own environment, and to set up their own access control lists on objects they create, needs to be another nearish term goal. Probably 0.0.8.
+
+### Homogeneities, regularities, slots, migration, permeability
+
+There are a lot of good ideas about the categorisation and organisation of data which are sketched in my original [Post scarcity software](Post-scarcity-software.md) essay which I've never really developed further because I didn't have the right software environment for them, which now I shall have. It would be good to build them.
+
+### Compiler
+
+I do want this system to have a compiler. I do want compiled functions to be the default. And I do want to understand how to write my own compiler for a system like this. But until I know what the processor architecture of the system I'm targetting is, worrying too much about a compiler seems premature.
+
+### Graphical User Interface
+
+Ultimately I want a graphical user interface at least as fluid and flexible as what we had on Interlisp machines 40 years ago. It's not a near term goal there.
+
+### Real hardware
+
+This machine would be **very** expensive to build, and there's no way I'm ever going to afford more than a sixty-four node machine. But it would be nice to have software which would run effectively on a four billion node machine, if one could ever be built. I think that has to be the target for version 1.0.0.
\ No newline at end of file
diff --git a/docs/state-of-play.md b/docs/State-of-play.md
similarity index 99%
rename from docs/state-of-play.md
rename to docs/State-of-play.md
index 6893091..f6dfec4 100644
--- a/docs/state-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,16 @@
 # State of Play
 
+## 20260225
+
+A productive day!
+
+I awoke with a plan to fix `cond`. This morning, I execoted it, and it worked.
+This afternoon, I fixed `let`. And this evening, I greatly improved `equal`.
+
+The bug in `member` is still unresolved.
+
+We're getting very close to the release of 0.0.6.
+
 ## 20260224
 
 Found a bug in subtraction, which I hoped might be a clue into the bignum bug;
diff --git a/docs/Topology-of-the-hardware-of-the-deep-future.md b/docs/Topology-of-the-hardware-of-the-deep-future.md
index c7af777..0cdc541 100644
--- a/docs/Topology-of-the-hardware-of-the-deep-future.md
+++ b/docs/Topology-of-the-hardware-of-the-deep-future.md
@@ -1,4 +1,8 @@
-![HAL 9000 - a vision of the hardware of the deep future](https://vignette4.wikia.nocookie.net/2001/images/5/59/Hal_console.jpg/revision/latest?cb=20090823025755)In thinking about how to write a software architecture that won't quickly become obsolescent, I find that I'm thinking increasingly about the hardware on which it will run.
+# On the topology of the hardware of the deep future
+
+![HAL 9000 - a vision of the hardware of the deep future](https://vignette4.wikia.nocookie.net/2001/images/5/59/Hal_console.jpg/revision/latest?cb=20090823025755)
+
+In thinking about how to write a software architecture that won't quickly become obsolescent, I find that I'm thinking increasingly about the hardware on which it will run.
 
 In [Post Scarcity Hardware](Post-scarcity-hardware.html) I envisaged a single privileged node which managed main memory. Since then I've come to thing that this is a brittle design which will lead to bottle necks, and that each cons page will be managed by a separate node. So there needs to be a hardware architecture which provides the shortest possible paths between nodes.
 
@@ -14,7 +18,7 @@ If you take a square grid and place a processor at every intersection, it has at
 
 So far so good. Now, let's take square grids and stack them. This gives each node at most six proximal neighbours. We form a cube, and the longest distance between two nodes is `3x`. We can link the nodes on the left of the cube to the corresponding nodes on the right and form a (thick walled) cylinder, and the longest distance between two nodes is `2.5x`. Now join the nodes at the top of the cube to the corresponding nodes at the bottom, and we have a thick walled torus. The maximum distance between is now `2x`.
 
-Let's stop for a moment and think about the difference between logical and physical topology. Suppose we have a printed circuit board with 100 processors on it in a regular grid. We probably could physically bend the circuit board to form a cylinder, but there's no need to do so. We achieve exactly the same connection architecture simply by using wires to connect the left side to the right. And if we use wires to connect those at the top with those at the bottom, we've formed a logical torus even though the board is still flat.
+Let's stop for a moment and think about the difference between logical and physical topology. Suppose we have a printed circuit board with 199 processors on it in a regular grid. We probably could physically bend the circuit board to form a cylinder, but there's no need to do so. We achieve exactly the same connection architecture simply by using wires to connect the left side to the right. And if we use wires to connect those at the top with those at the bottom, we've formed a logical torus even though the board is still flat.
 
 It doesn't even need to be a square board. We could have each processor on a separate board in a rack, with each board having four connectors probably all along the same edge, and use patch wires to connect the boards together into a logical torus.
 

From f21f763f942d515bd1129d3f9a309ff27b3bae6d Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 26 Feb 2026 12:12:57 +0000
Subject: [PATCH 68/90] Work on documentation.

---
 docs/Home.md    | 70 ++++++++++++++++++++++++++++++++++++++++++++++---
 docs/Roadmap.md |  2 +-
 2 files changed, 68 insertions(+), 4 deletions(-)

diff --git a/docs/Home.md b/docs/Home.md
index 8ca58cb..ec470e5 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -46,9 +46,11 @@ With these dependencies in place, clone the repository from [here](https://git.j
 
 ## In use
 
+What works just now is a not very good, not very efficient Lisp interpreter which does not conform to any existing Lisp standard. You can start a REPL, and you can write and evaluate functions. You can't yet save or load your functions. It's interesting mainly because of its architecture, and where it's intended to go, rather than where it is now.
+
 ### Invoking
 
-When invoking the system, the following invokation arguments may be passed:
+When invoking the system, the following invocation arguments may be passed:
 ```
         -d      Dump memory to standard out at end of run (copious!);
         -h      Print this message and exit;
@@ -71,6 +73,68 @@ Note that any verbosity level produces a great deal of output, and although stan
 
 ### Functions and symbols
 
-The following functions and keys are provided as of release 0.0.6:
+The following functions are provided as of release 0.0.6:
+
+| Symbol | Type | Documentation |
+| ------ | ---- | ------------- |
+| * | FUNC | `(* args...)` Multiplies these `args`, all of which should be numbers, and return the product. |
+| + | FUNC | `(+ args...)`: If `args` are all numbers, returns the sum of those numbers. |
+| - | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
+| / | FUNC | `(/ a b)`: Divides `a` by `b` and returns the result. Expects both arguments to be numbers. |
+| = | FUNC | `(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`. |
+| absolute | FUNC | `(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`. |
+| add | FUNC | `(+ args...)`: If `args` are all numbers, return the sum of those numbers. |
+| and | FUNC | `(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`. |
+| append | FUNC | `(append args...)`: If `args` are all sequences, return the concatenation of those sequences. |
+| apply | FUNC | `(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value. |
+| assoc | FUNC | `(assoc key store)`: Return the value associated with this `key` in this `store`. |
+| car | FUNC | `(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence. |
+| cdr | FUNC | `(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed. |
+| close | FUNC | `(close stream)`: If `stream` is a stream, close that stream. |
+| cond | SPFM | null |
+| cons | FUNC | `(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`. |
+| count | FUNC | `(count s)`: Return the number of items in the sequence `s`. |
+| divide | FUNC | `(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`. |
+| eq? | FUNC | `(eq? args...)`: Return `t` if all args are the exact same object, else `nil`. |
+| equal? | FUNC | `(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`. |
+| eval | FUNC | `(eval form)`: Evaluates `form` and returns the result. |
+| exception | FUNC | `(exception message)`: Return (throw) an exception with this `message`. |
+| get-hash | FUNC | `(get-hash arg)`: Returns the natural number hash value of `arg`. This is the default hash function used by hashmaps and namespaces, but obviously others can be supplied. |
+| hashmap | FUNC | `(hashmap n-buckets hashfn store write-acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`, and protected by the write access control list `write-acl`. All arguments are optional. The intended difference between a namespace and a hashmap is that a namespace has a write acl and a hashmap doesn't (is not writable), but currently (0.0.6) this functionality is not yet written. |
+| inspect | FUNC | `(inspect object ouput-stream)`: Print details of this `object` to this `output-stream`, or `*out*` if no `output-stream` is specified. |
+| keys | FUNC | `(keys store)`: Return a list of all keys in this `store`. |
+| lambda | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ funtion. |
+| let | SPFM | `(let bindings forms)`: Bind these `bindings`, which should be specified as an association list, into the local environment and evaluate these forms sequentially in that context, returning the value of the last. |
+| list | FUNC | `(list args...)`: Return a list of these `args`. |
+| mapcar | FUNC | `(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results. |
+| meta | FUNC | `(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`. |
+| metadata | FUNC | `(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`. |
+| multiply | FUNC | `(multiply args...)` Multiply these `args`, all of which should be numbers, and return the product. |
+| negative? | FUNC | `(negative? n)`: Return `t` if `n` is a negative number, else `nil`. |
+| nlambda | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
+| not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. |
+| nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
+| oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. |
+| open | FUNC | `(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing. |
+| or | FUNC | `(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`. |
+| print | FUNC | `(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`. |
+| progn | SPFM | `(progn forms...)`: Evaluate these `forms` sequentially, and return the value of the last. |
+| put! | FUNC | `(put! store key value)`: Stores a value in a namespace; currently (0.0.6), also stores a value in a hashmap, but in future if the `store` is a hashmap then `put!` will return a clone of that hashmap with this `key value` pair added.  Expects `store` to be a hashmap or namespace; `key` to be a symbol or a keyword; `value` to be  any value. |
+| put-all! | FUNC | `(put-all! store1 store2)`: If `store1` is a namespace and is writable, copies all key-value pairs from `store2` into `store1`. At present (0.0.6) it does this for hashmaps as well, but in future if `store1` is a hashmap or an namespace which the user does not have permission to write, will return a copy of `store1` with all the key-value pairs from `store2` added. `store1` must be a hashmap or a namespace; `store2` may be either of those or an association list. |
+| quote | SPFM | `(quote form)`: Returns `form`, unevaluated. More normally expressed `'form`, where the quote mark is a reader macro which is expanded to `(quote form)`. |
+| ratio->real | FUNC | `(ratio->real r)`: If `r` is a rational number, return the real number equivalent. |
+| read | FUNC | `(read stream)`: read one complete lisp form and return it. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment. |
+| read-char | FUNC | `(read-char stream)`: Return the next character from the stream indicated by `stream`. |
+| repl | FUNC | `(repl prompt input output)`: Starts a new read-eval-print-loop. All arguments are optional. If `prompt` is present, it will be used as the prompt. If `input` is present and is a readable stream, takes input from that stream. If `output` is present and is a writable stream, prints output to that stream. |
+| reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
+| set | FUNC | null |
+| set! | SPFM | null |
+| slurp | FUNC | null |
+| source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
+| subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
+| throw | FUNC | null |
+| time | FUNC | `(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch. |
+| try | SPFM | null |
+| type | FUNC | `(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change. |
+| λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ funtion. |
 
-```
diff --git a/docs/Roadmap.md b/docs/Roadmap.md
index a64909e..7cd654b 100644
--- a/docs/Roadmap.md
+++ b/docs/Roadmap.md
@@ -35,7 +35,7 @@ Doctrine is that the post scarcity computing environment doesn't have a file sys
 
 ### Better command line experience
 
-The current command line experience is embarrasingly poor. Recallable input history, input line editing, and a proper structure editor are all things that I will need for my comfort.
+The current command line experience is embarrassingly poor. Recallable input history, input line editing, and a proper structure editor are all things that I will need for my comfort.
 
 ### Users, groups and ACLs
 

From b720211b7b3bcd866be24d3105444191d55f96d9 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 26 Feb 2026 21:14:39 +0000
Subject: [PATCH 69/90] Made the string returned by `c_type` null-character
 terminated. Fixes #6.

This is probably the wrong fix; probably I should have fixed read_string
so that it did not create null-character terminated strings, but it will
do for now. Probably will revisit.
---
 docs/Home.md                 |   4 +-
 lisp/scratchpad.lisp         |   4 +
 src/init.c                   |   2 +-
 src/io/io.c                  |   2 +-
 src/memory/consspaceobject.c |  16 ++-
 unit-tests/equal.sh          | 206 +++++++++++++++++++++++++++++++++++
 6 files changed, 225 insertions(+), 9 deletions(-)
 create mode 100644 unit-tests/equal.sh

diff --git a/docs/Home.md b/docs/Home.md
index ec470e5..e76a525 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -115,7 +115,7 @@ The following functions are provided as of release 0.0.6:
 | not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. |
 | nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
 | oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. |
-| open | FUNC | `(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing. |
+| open | FUNC | `(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading. |
 | or | FUNC | `(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`. |
 | print | FUNC | `(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`. |
 | progn | SPFM | `(progn forms...)`: Evaluate these `forms` sequentially, and return the value of the last. |
@@ -129,7 +129,7 @@ The following functions are provided as of release 0.0.6:
 | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
 | set | FUNC | null |
 | set! | SPFM | null |
-| slurp | FUNC | null |
+| slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. |
 | source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | throw | FUNC | null |
diff --git a/lisp/scratchpad.lisp b/lisp/scratchpad.lisp
index 0474099..4d82164 100644
--- a/lisp/scratchpad.lisp
+++ b/lisp/scratchpad.lisp
@@ -46,3 +46,7 @@
 
 "This blows up: 10^37, which is a three cell bignum."
 (inspect (set! final (+ z z z z z z z z z z)))
+
+(mapcar (lambda (n) (list (:name (meta n)) (:documentation (meta n)))) (keys (oblist)))
+
+((keys "`(keys store)`: Return a list of all keys in this `store`.") (set nil) (let nil) (quote nil) (nil nil) (read nil) (nil nil) (nil nil) (oblist "`(oblist)`: Return the current symbol bindings, as a map.") (cons "`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.") (source nil) (cond nil) (nil nil) (eq? "`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.") (close "`(close stream)`: If `stream` is a stream, close that stream.") (meta "`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (nil nil) (not "`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.") (mapcar "`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.") (negative? "`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.") (open "`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.") (subtract nil) (nil nil) (nil nil) (nil nil) (or "`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.") (nil nil) (and "`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.") (count "`(count s)`: Return the number of items in the sequence `s`.") (eval nil) (nλ nil) (nil nil) (nil nil) (nil nil) (nil nil) (cdr "`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.") (equal? "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (set! nil) (nil nil) (nil nil) (reverse nil) (slurp nil) (try nil) (assoc "`(assoc key store)`: Return the value associated with this `key` in this `store`.") (nil nil) (add "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (list "`(list args...): Return a list of these `args`.") (time nil) (car "`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.") (nil nil) (nil nil) (nil nil) (absolute "`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.") (append "`(append args...)`: If args are all collections, return the concatenation of those collections.") (apply "`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.") (divide "`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.") (exception "`(exception message)`: Return (throw) an exception with this `message`.") (get-hash "`(get-hash arg)`: returns the natural number hash value of `arg`.") (hashmap "`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.") (inspect "`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.") (metadata "`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (multiply "`(* args...)` Multiply these `args`, all of which should be numbers.") (print "`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.") (put! nil) (put-all! nil) (ratio->real "`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.") (read-char nil) (repl nil) (throw nil) (type nil) (+ "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (* nil) (- nil) (/ nil) (= "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (lambda nil) (λ nil) (nlambda nil) (progn nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil))
diff --git a/src/init.c b/src/init.c
index 13c939f..aec65c7 100644
--- a/src/init.c
+++ b/src/init.c
@@ -387,7 +387,7 @@ int main( int argc, char *argv[] ) {
         L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.",
         &lisp_not);
     bind_function( L"oblist", L"`(oblist)`: Return the current symbol bindings, as a map.", &lisp_oblist );
-    bind_function( L"open", L"`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.", &lisp_open );
+    bind_function( L"open", L"`(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading.", &lisp_open );
     bind_function( L"or", 
         L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.",
         &lisp_or);
diff --git a/src/io/io.c b/src/io/io.c
index aa960f0..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -420,7 +420,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
 
 /**
  * Function: return a stream open on the URL indicated by the first argument;
- * if a second argument is present and is non-nil, open it for reading. At
+ * if a second argument is present and is non-nil, open it for writing. At
  * present, further arguments are ignored and there is no mechanism to open
  * to append, or error if the URL is faulty or indicates an unavailable
  * resource.
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 0bd0b90..d0ece0f 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -114,11 +114,15 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
 struct cons_pointer c_type( struct cons_pointer pointer ) {
-    struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( pointer );
+    /* Strings read by `read` have the null character termination. This means 
+     * that for the same printable string, the hashcode is different from 
+     * strings made with NIL termination. The question is which should be 
+     * fixed, and actually that's probably strings read by `read`. However,
+     * for now, it was easier to add a null character here. */
+    struct cons_pointer result = make_string( (wchar_t) 0, NIL);
+    struct cons_space_object * cell = &pointer2cell( pointer );
 
-    if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) ==
-         0 ) {
+    if ( cell->tag.value == VECTORPOINTTV ) {
         struct vector_space_object *vec = pointer_to_vso( pointer );
 
         for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
@@ -127,7 +131,7 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
         }
     } else {
         for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-            result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
+            result = make_string( ( wchar_t ) cell->tag.bytes[i], result );
         }
     }
 
@@ -333,6 +337,8 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
         cell->payload.string.cdr = tail;
 
         cell->payload.string.hash = calculate_hash( c, tail );
+        debug_dump_object( pointer, DEBUG_ALLOC);
+        debug_println( DEBUG_ALLOC);
     } else {
         // \todo should throw an exception!
         debug_printf( DEBUG_ALLOC,
diff --git a/unit-tests/equal.sh b/unit-tests/equal.sh
new file mode 100644
index 0000000..815988b
--- /dev/null
+++ b/unit-tests/equal.sh
@@ -0,0 +1,206 @@
+#!/bin/bash
+
+# Tests for equality.
+
+result=0
+
+echo -n "$0: integers... "
+
+expected="t"
+actual=`echo "(= 5 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different integers... "
+
+expected="nil"
+actual=`echo "(= 4 5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: reals... "
+
+expected="t"
+actual=`echo "(= 5.001 5.001)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: different reals... "
+
+expected="nil"
+actual=`echo "(= 5.001 5.002)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: ratios... "
+
+expected="t"
+actual=`echo "(= 4/5 4/5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: equivalent ratios... "
+
+expected="t"
+actual=`echo "(= 4/5 12/15)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+
+echo -n "$0: different ratios... "
+
+expected="nil"
+actual=`echo "(= 4/5 5/5)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: atoms... "
+
+expected="t"
+actual=`echo "(= 'foo 'foo)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different atoms... "
+
+expected="nil"
+actual=`echo "(= 'foo 'bar)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: keywords... "
+
+expected="t"
+actual=`echo "(= :foo :foo)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different keywords... "
+
+expected="nil"
+actual=`echo "(= :foo :bar)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: strings... "
+
+expected="t"
+actual=`echo '(= "foo" "foo")' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different strings... "
+
+expected="nil"
+actual=`echo '(= "foo" "bar")' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: maps... "
+
+expected="t"
+actual=`echo '(= {:foo 1 :bar 2} {:bar 2 :foo 1})' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: different maps... "
+
+expected="nil"
+actual=`echo '(= {:foo 1 :bar 2} {:bar 1 :foo 2})' | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}

From 1900bca706ee750964636716e4204dde2712e7f1 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 27 Feb 2026 02:43:21 +0000
Subject: [PATCH 70/90] Very, very nearly ready for 0.0.6. Too tired to press
 the burron tonight.

---
 CHANGELOG.md                    |   1 +
 README.md                       | 396 +-------------------------------
 docs/Home.md                    |  12 +-
 lisp/defun.lisp                 |  10 +-
 lisp/documentation.lisp         |  35 ++-
 lisp/member.lisp                |   6 +-
 notes/mad-software.md           |   6 +-
 src/arith/integer.c             |   4 +-
 src/arith/peano.c               |  26 ++-
 src/arith/ratio.c               |  28 +--
 src/arith/ratio.h               |   3 +-
 src/debug.c                     |  17 +-
 src/debug.h                     |   3 +-
 src/init.c                      | 280 ++++++++++++++--------
 src/io/io.c                     |   4 +-
 src/io/print.c                  |  97 +++++++-
 src/io/print.h                  |   8 +
 src/io/read.c                   |   2 +-
 src/memory/conspage.c           |   8 +-
 src/memory/consspaceobject.c    |  35 ++-
 src/memory/dump.c               |   8 +-
 src/memory/dump.h               |   2 +
 src/memory/stack.c              |  29 +--
 src/memory/vectorspace.c        |   5 +-
 src/ops/equal.c                 |  76 +++---
 src/ops/intern.c                |  35 +--
 src/ops/lispops.c               | 214 +++++++----------
 src/ops/lispops.h               |  15 +-
 unit-tests/eval-quote-symbol.sh |   2 +-
 29 files changed, 567 insertions(+), 800 deletions(-)
 create mode 120000 CHANGELOG.md
 mode change 100644 => 120000 README.md

diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 120000
index 0000000..7a7656e
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1 @@
+docs/CHANGELOG.md
\ No newline at end of file
diff --git a/README.md b/README.md
deleted file mode 100644
index 8ea4dc4..0000000
--- a/README.md
+++ /dev/null
@@ -1,395 +0,0 @@
-# Post Scarcity Software System, version 0
-
-tl,dr: look at the [wiki](wiki).
-
-## State of play
-
-### Version 0.0.5
-
-Has working Lisp interpreter, more or less complete, with functions and symbols as defined under [#bindings-currently-available](Bindings currently available) below. Features include hash maps.
-
-#### Known bugs
-
-At the time of writing, big number arithmetic is completely failing. It has worked in the past, but it doesn't now.
-
-There are ludicrous memory leaks. Essentially the garbage collection strategy isn't yet really working. However, if we are to implement the hypercube architecture in future, a mark and sweep garbage collector will not work, so it's important to get the reference counter working properly.
-
-#### Unknown bugs
-
-There are certainly MANY unknown bugs. Please report those you find.
-
-#### Not yet implemented
-
-1. There is as yet no **compiler**, and indeed it isn't yet certain what a compiler would even mean. Do all nodes in a machine necessarily share the same processor architecture?
-2. There's the beginnings of a narrative about how **namespaces** are going to work, but as yet they aren't really implemented.
-3. There is as yet no implementation of the concept of **users**. Access Control Lists exist but are not used. Related, there's no concept of a **session**.
-4. There is as yet no **multiprocessor architecture**, not even a simulated one. As it is intended that threading will be implemented by handing off parts of a computation to peer processors, this means there no **threads** either.
-5. There's no **user interface** beyond a REPL. There isn't even an **editor**, or **history**.
-6. **Printing to strings** does not work.
-7. The **exception system**, while it does exist, needs to be radically rethought.
-
-### Version 0.0.4
-
-Has working rational number arithmetic, as well as integer and real number arithmetic. The stack is now in vector space, but vector space is not yet properly garbage collected. `defun` does not yet work, so although Lisp functions can be defined the syntax is pretty clunky. So you *can* start to do things with this, but you should probably wait for at least a 0.1.0 release!
-
-## Introduction
-
-Long ago when the world was young, I worked on Xerox Dandelion and Daybreak machines which ran Interlisp-D, and Acorn Cambridge Workstation and Archimedes machines which ran Cambridge Lisp (derived from Portable Standard Lisp). At the same time, Lisp Machines Inc, Symbolics, Thinking Machines, Texas Instruments and probably various other companies I've either forgotten or didn't know about built other varieties of dedicated Lisp machines which ran Lisp right down to the metal, with no operating system under them. Those machines were not only far superior to any other contemporary machines; they were also far superior to any machines we've built since. But they were expensive, and UNIX machines with the same raw compute power became very much cheaper; and so they died.
-
-But in the meantime hardware has become vastly more powerful while software has hardly advanced at all. We don't have software which will run efficiently on the machines of the future, we don't have tools to build it, and it often seems to me we're not even thinking about it.
-
-Ten years ago I wrote [an essay](http://blog.journeyman.cc/2006/02/post-scarcity-software.html) on what software would look like if we treated our computers as though their power was unlimited (which, compared to what we had at the start of my career, it pretty much is); two years ago I wrote about the [hardware architecture](http://blog.journeyman.cc/2014/10/post-scarcity-hardware.html) which might in future support that hardware.
-
-What I'm trying to do now is write a detailed low level specification of the underpinnings of the software system, and begin a trial implementation. Version 0 will run as a user-space program on UNIX, but very much with the intention that a later version will run on top of either a micro-kernel or perhaps even just a BIOS. However I've no real plans to build post scarcity hardware - I lack the skills. What I'm aiming for is to be able to run on 64 bit, multiple processor hardware.
-
-Although I describe it as a 'Lisp environment', for reasons explained in Post Scarcity Software that doesn't mean you will program it in Lisp. It means that the underlying representation of things in the system is Lispy, not Unixy.
-
-## Bindings currently available
-
-The following symbols are bound in the bootstrap layer. It is anticipated that
-
-1. Most of the functions will be overridden by versions of the same function written in Lisp; but
-2. these implementations will remain available in the namespace `/:bootstrap`.
-
-### Values
-
-Note that symbols delimited by asterisks, as in `*in*`, invite rebinding; it is expected, for example, that users will want to rebind input and output streams in their current environment. Rebinding some other symbols, for example `nil`, is unwise.
-
-#### nil
-
-The canonical empty list.
-
-#### t
-
-The canonical true value.
-
-#### \*in\*
-
-The input stream.
-
-#### \*out\*
-
-The output stream.
-
-#### \*log\*
-
-The logging stream (equivalent to `stderr`).
-
-#### \*sink\*
-
-The sink stream (equivalent to `/dev/null`).
-
-####  \*prompt\*
-
-The REPL prompt.
-
-### Functions
-
-#### (absolute *n*)
-
-Return the absolute value of a number.
-
-#### (add *n1* *n2* ...), (+ *n1* *n2* ...)
-
-Return the result of adding together all the (assumed numeric) arguments supplied.
-
-#### (append *s1* *s2* ...)
-
-Return a new sequence comprising all the elements of *s1* followed by all the elements of *s2* and so on for an indefinite number of arguments. All arguments must be sequences of the same type.  
-
-#### (apply *f* *s*)
-
-Apply the function *f* to the arguments that form the sequence *s*, and return the result.
-
-#### (assoc *key* *store*)
-
-Return the value associated with *key* in *store*. *key* may be an object of any type, but keywords, symbols and strings are handled most efficiently. *store* may be an [*association list*](#Association_list), or may be a hashmap.
-
-#### (car *s*)
-
-Return the first element of the sequence *s*.
-
-#### (cdr *s*)
-
-Return a sequence of all the elements of the sequence *s* except the first.
-
-#### (close *stream*)
-
-Closes the indicates stream. Returns `nil`.
-
-#### (cons *a* *b*)
-
-Returns a new pair comprising *a* and *b*. If *b* is a list, this has the effect of creating a new list with the element *a* prepended to all the elements of *b*. If *b* is `nil`, this has the effect creating a new list with *a* as the sole element. Otherwise, it just creates a pair.
-
-#### (divide *n1* *n2*), (/ *n1* *n2*)
-
-Divides the number *n1* by the number *n2*. If *n1* and *n2* are both integers, it's likely that the result will be a rational number.
-
-#### (eq *o1* *o2*)
-
-Returns true (`t`) if *o1* and *o2* are identically the same object, else `nil`.
-
-#### (equal *o1* *o2*), (= *o1* *o2*)
-
-Returns true (`t`) if *o1* and *o2* are structurally identical to one another, else `nil`.
-
-#### (exception *message*)
-
-Throws (returns) an exception, with the specified *message*. Note that this doesn't really work at all well, and that it is extremely likely this signature will change.
-
-#### (get-hash *key* *hashmap*)
-
-Like 'assoc', but the store must be a hashmap. Deprecated.
-
-#### (hashmap *n* *f* *store*)
-
-Create a hashmap with *n* buckets, using *f* as its hashing function, and initialised with the key/value pairs from *store*. All arguments are optional; if none are passed, will create an empty hashmap with 32 keys and the default hashing function.
-
-#### (inspect *o*)
-
-Prints detailed structure of the object *o*. Primarily for debugging.
-
-#### (keys *store*)
-
-Returns a list of the keys in *store*, which may be either an [*association list*](#Association_list), or a hashmap.
-
-#### (let *bindings* *form*...)
-
-Evaluates each of the *forms* in an environment to which ally of these *bindings* have been added. *bindings* must be an [*association list*](#Association_list), and, additionally, all keys in *bindings* must be symbols. Values in the association list will be evaluated before being bound, and this is done sequentially, as in the behaviour of Common Lisp `let*` rather than of Common Lisp `let`.
-
-#### (list *o*...)
-
-Returns a list of the values of all of its arguments in sequence.
-
-#### (mapcar *f* *s*)
-
-Applies the function *f* to each element of the sequence *s*, and returns a new sequence of the results.
-
-#### (meta *o*), (metadata *o*)
-
-Returns metadata on *o*.
-
-#### (multiply *n1* *n2* ...), (\*  *n1* *n2* ...)
-
-Returns the product of multiplying together all of its numeric arguments.
-
-#### (negative? n1)
-
-Returns `t` if its argument is a negative number, else `nil`.
-
-#### (oblist)
-
-Returns a sequence of all the names bound in the root of the naming system.
-
-#### (open *url* *read?*)
-
-Opens a stream to the specified *url*. If a second argument is present and is non-`nil`, the stream is opened for reading; otherwise, it's opened for writing.
-
-#### (print *o* [*stream*])
-
-Prints the print-name of object *o* to the output stream which is the value of *stream*, or to the value of \*out\* in the current environment if no *stream* is provided.
-
-#### (put! *map* *key* *value*)
-
-Puts *value* as the value of *key* in hashmap *map*, destructively modifying it, and returns the map. Note that in future this will work only if the current user has write access to the specified map.
-
-#### (put-all! *map* *assoc*)
-
-Puts each (+key* . *value*) pair from the association list *assoc* into this *map*, destructively modifying it, and returns the map. Note that in future this will work only if the current user has write access to the specified map.
-
-#### (read [*stream*])
-
-Reads a single Lisp form from the input stream which is the value of *stream*, or from the value of \*in\* in the current environment if no *stream* is provided.
-
-#### (read-char [*stream*])
-
-Return the next character from the stream indicated by *stream*, or from the value of \*in\* in the current environment if no *stream* is provided; further arguments are ignored.
-
-#### (repl [*prompt* *input* *output*))
-
-Initiate a new Read/Eval/Print loop with this *prompt*, reading from this *input* stream and writing to this *output* stream. All arguments are optional and default sensibly if omitted. TODO: doesn't actually work yet.
-
-#### (reverse *seq*)
-
-Return a new sequence of the same type as *seq*, containing the same elements but in the reverse order.
-
-#### (slurp *in*)
-
-Reads all available characters on input stream *in* into a string, and returns the string.
-
-#### (source *fn*)
-
-Should return the source code of the function or special form *fn*, but as we don't yet
-have a compiler, doesn't.
-
-#### (subtract *n1* *n2*), (- *n1* *n2*)
-
-Subtracts the numeric value *n2* from the numeric value *n1*, and returns the difference.
-
-#### (throw *message*)
-
-Throws an exception, with the payload *message*. While *message* is at present most usefully a string, it doesn't have to be. Returns the exception, but as exceptions are handled specially by `eval`, it is returned to the catch block of the nearest `try` expression on the stack.
-
-#### (time [*milliseconds-since-epoch*])
-
-Returns a time object whose value is the specified number of *milliseconds-since-epoch*, where the Post Scarcity Software Environment epoch is 14 billion years prior to the UN*X epoch. If *milliseconds-since-epoch* is not specified, returns a time object representing the UTC time when the function was executed.
-
-#### (type *o*)
-
-Returns a string representing the type -- actually the tag value -- of the object *o*.
-
-### Special forms
-
-#### (cond (test value) ...)
-
-Evaluates a series of *(test value)* clauses in turn until a test returns non-nil, when the corresponding value is returned and further tests are not evaluated. This is the same syntax as Common Lisp's `cond` implementation, and different from Clojure's.
-
-It's conventional in Lisp to have a final clause in a `cond` block with the test `t`; however, since we have keywords which are always truthy, it would be equally valid to use `:else` or `:default` as final fallback tests.
-
-#### (lambda (arg ...) form ...), (λ (arg ...) form ...)
-
-Returns an anonymous fuction which evaluates each of the *form*s sequentially in an environment in which the specified *arg*s are bound, and returns the value of the last such form.
-
-#### (let ((*var* . *val*) ...) form ...)
-
-Evaluates each of these *form*s sequentially in an environment in which each *var* is bound to the respective *val* in the bindings specified, and returns the value of the last form.
-
-#### (nlambda (arg ...) form ...), (nλ (arg ...) form ...)
-
-Returns an anonymous special form which evaluates each of the *form*s sequentially in an environment in which the specified *arg*s are bound, and returns the value of the last such form.
-
-#### (progn *f* ...)
-
-Evaluates each of the forms which are its arguments in turn and returns the value of the last.
-
-#### (quote *o*), '*o*
-
-Returns *o*, unevaluated.
-
-#### (set! *name* *value* [*namespace*])
-
-Sets (destructively modifies) the value of *name* this *value* in the root namespace. The *namespace* argument is currently ignored but in future is anticipated to be a path specification of a namespace to be modified.
-
-#### (try (*form* ...) (*handler* ...))
-
-Attempt to evaluate, sequentially, each of the *form*s in the first sequence, and return the value of the last of them; however, if any of them cause an exception to be thrown, then evaluate sequentially each of the *handler*s in the second sequence.
-
-It is recommended that you structure this as follows:
-
-`lisp
-  (try
-    (:body
-      (print "hello")
-      (/ 1 'a)
-      (print "goodbye"))
-    (:catch
-      (print "Well, that failed.")
-      5))
-`
-
-Here, `:body` and `:catch` are syntactic sugar which will not affect the final value. 
-
-### Type values
-
-The following types are known. Further types can be defined, and ultimately it should be possible to define further types in Lisp, but these are what you have to be going on with. Note that where this documentation differs from `memory/consspaceobject.h`, this documentation is *wrong*.
-
-#### CONS
-
-An ordinary cons cell: that is to say, a pair.
-
-#### EXEP
-
-An exception
-
-#### FREE
-
-An unallocated memory cell. User programs should never see this.
-
-#### FUNC
-
-A primitive or compiled Lisp function \-- one whose arguments are pre-evaluated.
-
-#### HASH
-
-A hash map (in vector space)
-
-#### INTR
-
-An arbitrarily large integer number.
-
-#### KEYW
-
-A keyword - an interned, self-evaluating string.
-
-#### LMBA
-
-A lambda cell. Lambdas are the interpretable (source) versions of functions.
-
-#### LOOP
-
-Internal to the workings of the ••loop** function. User functions should never see this.
-
-#### NIL 
-
-The special cons cell at address {0,0} whose **car** and **cdr** both point to itself. The canonical empty set. Generally, treated as being indicative of falsity.
-
-#### NLMD
-
-An nlambda cell. NLambdas are the interpretable (source) versions of special forms.
-
-#### RTIO
-
-A rational number, stored as pointers two integers representing dividend and divisor respectively.
-
-#### READ
-
-An open read stream.
-
-#### REAL
-
-A real number, represented internally as an IEEE 754-2008 `binary64`.
-
-#### SPFM
-
-A compiled or primitive special form - one whose arguments are not pre-evaluated but passed as provided.
-
-#### STAK
-
-A stack frame. In vector space. 
-
-#### STRG
-
-A string of [UTF-32](https://en.wikipedia.org/wiki/UTF-32) characters, stored as a linked list. Self evaluating.
-
-#### SYMB
-
-A symbol is just like a string except not self-evaluating. Later, there may be some restrictions on what characters are legal in a symbol, but at present there are not.
-
-#### TIME
-
-A time stamp. The epoch for the Post Scarcity Software Environment is 14 billion years before the UN*X epoch, and is chosen as being a reasonable estimate for the birth of the universe, and thus of the start of time.
-
-#### TRUE
-
-The special cell at address {0,1} which is canonically different from NIL.
-
-#### VECP
-
-A pointer to an object in vector space. User functions shouldn't see this, they should see the type of the vector-space object indicated.
-
-#### VECT
-
-A vector of objects. In vector space.
-
-#### WRIT
-
-An open write stream.
-
-
-
-## License
-
-Copyright © 2017 [Simon Brooke](mailto:simon@journeyman.cc)
-
-Distributed under the terms of the
-[GNU General Public License v2](http://www.gnu.org/licenses/gpl-2.0.html)
diff --git a/README.md b/README.md
new file mode 120000
index 0000000..88165ce
--- /dev/null
+++ b/README.md
@@ -0,0 +1 @@
+docs/Home.md
\ No newline at end of file
diff --git a/docs/Home.md b/docs/Home.md
index e76a525..f9019a6 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -91,7 +91,7 @@ The following functions are provided as of release 0.0.6:
 | car | FUNC | `(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence. |
 | cdr | FUNC | `(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed. |
 | close | FUNC | `(close stream)`: If `stream` is a stream, close that stream. |
-| cond | SPFM | null |
+| cond | SPFM | `(cond clauses...)`: Conditional evaluation, `clauses` is a sequence of lists of forms such that if evaluating the first form in any clause returns non-`nil`, the subsequent forms in that clause will be evaluated and the value of the last returned; but any subsequent clauses will not be evaluated. |
 | cons | FUNC | `(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`. |
 | count | FUNC | `(count s)`: Return the number of items in the sequence `s`. |
 | divide | FUNC | `(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`. |
@@ -103,7 +103,7 @@ The following functions are provided as of release 0.0.6:
 | hashmap | FUNC | `(hashmap n-buckets hashfn store write-acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`, and protected by the write access control list `write-acl`. All arguments are optional. The intended difference between a namespace and a hashmap is that a namespace has a write acl and a hashmap doesn't (is not writable), but currently (0.0.6) this functionality is not yet written. |
 | inspect | FUNC | `(inspect object ouput-stream)`: Print details of this `object` to this `output-stream`, or `*out*` if no `output-stream` is specified. |
 | keys | FUNC | `(keys store)`: Return a list of all keys in this `store`. |
-| lambda | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ funtion. |
+| lambda | SPFM | `(lambda arg-list forms...)`: Construct an interpretable λ funtion. |
 | let | SPFM | `(let bindings forms)`: Bind these `bindings`, which should be specified as an association list, into the local environment and evaluate these forms sequentially in that context, returning the value of the last. |
 | list | FUNC | `(list args...)`: Return a list of these `args`. |
 | mapcar | FUNC | `(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results. |
@@ -120,15 +120,15 @@ The following functions are provided as of release 0.0.6:
 | print | FUNC | `(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`. |
 | progn | SPFM | `(progn forms...)`: Evaluate these `forms` sequentially, and return the value of the last. |
 | put! | FUNC | `(put! store key value)`: Stores a value in a namespace; currently (0.0.6), also stores a value in a hashmap, but in future if the `store` is a hashmap then `put!` will return a clone of that hashmap with this `key value` pair added.  Expects `store` to be a hashmap or namespace; `key` to be a symbol or a keyword; `value` to be  any value. |
-| put-all! | FUNC | `(put-all! store1 store2)`: If `store1` is a namespace and is writable, copies all key-value pairs from `store2` into `store1`. At present (0.0.6) it does this for hashmaps as well, but in future if `store1` is a hashmap or an namespace which the user does not have permission to write, will return a copy of `store1` with all the key-value pairs from `store2` added. `store1` must be a hashmap or a namespace; `store2` may be either of those or an association list. |
-| quote | SPFM | `(quote form)`: Returns `form`, unevaluated. More normally expressed `'form`, where the quote mark is a reader macro which is expanded to `(quote form)`. |
+| put-all! | FUNC | `(put-all! dest source)`: If `dest` is a namespace and is writable, copies all key-value pairs from `source` into `dest`. At present (0.0.6) it does this for hashmaps as well, but in future if `dest` is a hashmap or a namespace which the user does not have permission to write, will return a copy of `dest` with all the key-value pairs from `source` added. `dest` must be a hashmap or a namespace; `source` may be either of those or an association list. |
+| quote | SPFM | `(quote form)`: Returns `form`, unevaluated. More idiomatically expressed `'form`, where the quote mark is a reader macro which is expanded to `(quote form)`. |
 | ratio->real | FUNC | `(ratio->real r)`: If `r` is a rational number, return the real number equivalent. |
 | read | FUNC | `(read stream)`: read one complete lisp form and return it. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment. |
-| read-char | FUNC | `(read-char stream)`: Return the next character from the stream indicated by `stream`. |
+| read-char | FUNC | `(read-char stream)`: Return the next character. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment. |
 | repl | FUNC | `(repl prompt input output)`: Starts a new read-eval-print-loop. All arguments are optional. If `prompt` is present, it will be used as the prompt. If `input` is present and is a readable stream, takes input from that stream. If `output` is present and is a writable stream, prints output to that stream. |
 | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
 | set | FUNC | null |
-| set! | SPFM | null |
+| set! | SPFM | `(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace. |
 | slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. |
 | source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
diff --git a/lisp/defun.lisp b/lisp/defun.lisp
index 5c61e1b..3382985 100644
--- a/lisp/defun.lisp
+++ b/lisp/defun.lisp
@@ -2,13 +2,7 @@
 
 (set! defun!
       (nlambda
-       form
-       (cond ((symbol? (car form))
-              (set (car form) (apply 'lambda (cdr form))))
-         (t nil))))
-
-(set! defun!
-      (nlambda
+      "`(defun name arg-list forms...)`: Define an interpreted Lambda function with this `name` and this `arg-list`, whose body is comprised of these `forms`."
        form
        (eval (list 'set! (car form) (cons 'lambda (cdr form))))))
 
@@ -20,7 +14,7 @@
        (cond (symbol? (car form))
          (set! (car form) (apply nlambda (cdr form))))))
 
-(defsp! cube (x) ((* x x x)))
+(defun! cube (x) (* x x x))
 
 (set! p 5)
 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 872cd3d..33fd1e5 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -1,20 +1,17 @@
-;; This version segfaults, I think due to a bug in `let`?
-;; (set! documentation (lambda (object)
-;;    (cond ((= (type object) "LMDA") 
-;;            (let ((d . (nth 3 (source object))))
-;;                (cond ((string? d) d)
-;;                    (t (source object)))))
-;;        ((member (type object) '("FUNC" "SPFM"))
-;;            (:documentation (meta object))))))
-;;
-;; (set! doc documentation)
+;; This function depends on:
+;; `member` (from file `member.lisp`)
+;; `nth` (from `nth.lisp`)
+;; `string?` (from `types.lisp`)
+
+(set! documentation (lambda (object)
+    "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
+   (cond ((member? (type object) '("FUNC" "SPFM"))
+            (:documentation (meta object)))
+        ((member? (type object) '("LMDA" "NLMD")) 
+           (let ((d . (nth 3 (source object))))
+               (cond ((string? d) d)
+                   (t (source object)))))
+        (t object))))
+
+(set! doc documentation)
 
-;; This version returns nil even when documentation exists, but doesn't segfault.
-(set! documentation
-    (lambda (object)
-        "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
-        (cond ((and (member (type object) '("LMDA" "NLMD"))
-                    (string? (nth 3 (source object))))
-                (nth 3 (source object)))
-            ((member (type object) '("FUNC" "SPFM"))
-                (:documentation (meta object))))))
diff --git a/lisp/member.lisp b/lisp/member.lisp
index 9d8a7a5..dfb12af 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -3,12 +3,12 @@
           "`(nil? object)`: Return `t` if object is `nil`, else `t`."
           (= o nil)))
 
-(set! member (lambda
+(set! member? (lambda
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((nil? collection) nil)
               ((= item (car collection)) t)
-              (t (member item (cdr collection))))))
+              (t (member? item (cdr collection))))))
 
-(member (type member) '("LMDA" "NLMD"))
+;; (member? (type member?) '("LMDA" "NLMD"))
diff --git a/notes/mad-software.md b/notes/mad-software.md
index bbe8092..73ab807 100644
--- a/notes/mad-software.md
+++ b/notes/mad-software.md
@@ -6,9 +6,9 @@ I have blogged a lot in the past about madness and about software, but I don't t
 
 I first wrote about [post scarcity software](https://blog.journeyman.cc/2006/02/post-scarcity-software.html) thirteen years ago. It was a thought about how software environments should be designed if were weren't held back by the cruft of the past, by tradition and by a lack, frankly, of anything much in the way of new creative thought. And seeing that the core of the system I described is a Lisp, which is to say it builds on a software architecture which is exactly as old as I am, perhaps it is infected by my take on tradition and my own lack of creativity, but let's, for the purposes of this essay, assume not.
 
-I started actually writing the [post scarcity software environment](https://github.com/simon-brooke/post-scarcity) on the second of January 2017, which is to say two years ago. It's been an extremely low priority task, because I don't have enough faith in either my vision or my skill to think that it will ever be of use to anyone. Nevertheless, it does now actually work, in as much as you can write software in it. It's not at all easy yet, and I wouldn't recommend anyone try, but you can check out the master branch from Github, compile it, and it works.
-
-As my mental health has deteriorated, I have been working on it more over the past couple of months, partly because I have lost faith in my ability to deliver the more practical projects I've been working on, and partly because doing something which is genuinely intellectually hard helps subdue the chaos in my mind.
+I started actually writing the [post scarcity software environment](https://github.com/simon-brooke/post-scarcity) on the second of January 2017, which is to say two years ago. It's been an extremely low priority task, because I don't have enough faith in either my vision or my skill to think that it will ever be of use to anyone. Nevertheless, it does now actually work, in as much as you can write software in it. It's not at all easy yet, and I wouldn't recommend anyone try, but you can check out the master branch from Github, compile it, and it wo
+As my mental health has deteriorated, I have been working on it more over the past couple of months, partly because I have lost faith in my ability to deliver the more practical projects I've been working on, and partly because doing something which is genuinely intellectually hard helprks.
+s subdue the chaos in my mind.
 
 Having said that, it is hard and I am not sharp, and so progress is slow. I started work on big number arithmetic a three weeks ago, and where I'm up to at this point is:
 
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 1884a00..a3174ac 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -257,9 +257,9 @@ struct cons_pointer add_integers( struct cons_pointer a,
             debug_print_128bit( rv, DEBUG_ARITH );
             debug_print( L"\n", DEBUG_ARITH );
 
-            if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) { 
+            if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) {
                 result =
-                    acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
+                    acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
                 break;
             } else {
                 struct cons_pointer new = make_integer( 0, NIL );
diff --git a/src/arith/peano.c b/src/arith/peano.c
index 7e3dfc6..995ce0f 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -69,7 +69,7 @@ bool zerop( struct cons_pointer arg ) {
 //     bool result = false;
 //     struct cons_space_object * cell_1 = & pointer2cell( arg_1 );
 //     struct cons_space_object * cell_2 = & pointer2cell( arg_2 );
-    
+
 //     if (cell_1->tag.value == cell_2->tag.value) {
 
 //     switch ( cell_1->tag.value ) {
@@ -90,7 +90,7 @@ bool zerop( struct cons_pointer arg ) {
 //     }
 
 //     return result;
-    
+
 // }
 
 /**
@@ -126,17 +126,18 @@ struct cons_pointer absolute( struct cons_pointer arg ) {
     struct cons_pointer result = NIL;
     struct cons_space_object cell = pointer2cell( arg );
 
-    if ( numberp( arg))  {
+    if ( numberp( arg ) ) {
         if ( is_negative( arg ) ) {
             switch ( cell.tag.value ) {
                 case INTEGERTV:
                     result =
                         make_integer( llabs( cell.payload.integer.value ),
-                                    cell.payload.integer.more );
+                                      cell.payload.integer.more );
                     break;
                 case RATIOTV:
-                    result = make_ratio( absolute( cell.payload.ratio.dividend ),
-                                        cell.payload.ratio.divisor, false );
+                    result =
+                        make_ratio( absolute( cell.payload.ratio.dividend ),
+                                    cell.payload.ratio.divisor, false );
                     break;
                 case REALTV:
                     result = make_real( 0 - cell.payload.real.value );
@@ -606,7 +607,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 case RATIOTV:{
                         struct cons_pointer tmp = make_ratio( arg1,
                                                               make_integer( 1,
-                                                                            NIL ), false );
+                                                                            NIL ),
+                                                              false );
                         inc_ref( tmp );
                         result = subtract_ratio_ratio( tmp, arg2 );
                         dec_ref( tmp );
@@ -632,7 +634,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 case INTEGERTV:{
                         struct cons_pointer tmp = make_ratio( arg2,
                                                               make_integer( 1,
-                                                                            NIL ), false );
+                                                                            NIL ),
+                                                              false );
                         inc_ref( tmp );
                         result = subtract_ratio_ratio( arg1, tmp );
                         dec_ref( tmp );
@@ -711,8 +714,7 @@ struct cons_pointer lisp_divide( struct
                     break;
                 case INTEGERTV:{
                         result =
-                            make_ratio( frame->arg[0],
-                                        frame->arg[1], true);
+                            make_ratio( frame->arg[0], frame->arg[1], true );
                     }
                     break;
                 case RATIOTV:{
@@ -744,8 +746,8 @@ struct cons_pointer lisp_divide( struct
                 case INTEGERTV:{
                         struct cons_pointer one = make_integer( 1, NIL );
                         struct cons_pointer ratio =
-                            make_ratio( frame->arg[1], one, false);
-                         result = divide_ratio_ratio( frame->arg[0], ratio );
+                            make_ratio( frame->arg[1], one, false );
+                        result = divide_ratio_ratio( frame->arg[0], ratio );
                         dec_ref( ratio );
                         dec_ref( one );
                     }
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index cf67e88..1c20a4f 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -72,7 +72,8 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
                                   ddrv, drrv, ddrv / gcd, drrv / gcd );
                     result =
                         make_ratio( acquire_integer( ddrv / gcd, NIL ),
-                                    acquire_integer( drrv / gcd, NIL ), false);
+                                    acquire_integer( drrv / gcd, NIL ),
+                                    false );
                 }
             }
         }
@@ -182,8 +183,8 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer arg1,
     // TODO: this now has to work if `arg1` is an integer
     struct cons_pointer i =
         make_ratio( pointer2cell( arg2 ).payload.ratio.divisor,
-                    pointer2cell( arg2 ).payload.ratio.dividend, false ), result =
-        multiply_ratio_ratio( arg1, i );
+                    pointer2cell( arg2 ).payload.ratio.dividend, false ),
+        result = multiply_ratio_ratio( arg1, i );
 
     dec_ref( i );
 
@@ -228,7 +229,7 @@ struct cons_pointer multiply_ratio_ratio( struct
         struct cons_pointer dividend = acquire_integer( ddrv, NIL );
         struct cons_pointer divisor = acquire_integer( drrv, NIL );
         result = make_ratio( dividend, divisor, true );
-        
+
         release_integer( dividend );
         release_integer( divisor );
     } else {
@@ -310,13 +311,12 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
  * @exception if either `dividend` or `divisor` is not an integer.
  */
 struct cons_pointer make_ratio( struct cons_pointer dividend,
-                                struct cons_pointer divisor,
-                                bool simplify ) {
-    debug_print( L"make_ratio: dividend = ", DEBUG_ALLOC);
-    debug_print_object( dividend, DEBUG_ALLOC);
-    debug_print( L"; divisor = ", DEBUG_ALLOC);
-    debug_print_object( divisor, DEBUG_ALLOC);
-    debug_printf( DEBUG_ALLOC, L"; simplify = %d\n", simplify);
+                                struct cons_pointer divisor, bool simplify ) {
+    debug_print( L"make_ratio: dividend = ", DEBUG_ALLOC );
+    debug_print_object( dividend, DEBUG_ALLOC );
+    debug_print( L"; divisor = ", DEBUG_ALLOC );
+    debug_print_object( divisor, DEBUG_ALLOC );
+    debug_printf( DEBUG_ALLOC, L"; simplify = %d\n", simplify );
 
     struct cons_pointer result;
     if ( integerp( dividend ) && integerp( divisor ) ) {
@@ -327,7 +327,7 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         cell->payload.ratio.dividend = dividend;
         cell->payload.ratio.divisor = divisor;
 
-        if ( simplify) {
+        if ( simplify ) {
             result = simplify_ratio( unsimplified );
             if ( !eq( result, unsimplified ) ) {
                 dec_ref( unsimplified );
@@ -341,9 +341,9 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
-    debug_print( L" => ", DEBUG_ALLOC);
+    debug_print( L" => ", DEBUG_ALLOC );
     debug_print_object( result, DEBUG_ALLOC );
-    debug_println( DEBUG_ALLOC);
+    debug_println( DEBUG_ALLOC );
 
     return result;
 }
diff --git a/src/arith/ratio.h b/src/arith/ratio.h
index 4ef0d24..2e39754 100644
--- a/src/arith/ratio.h
+++ b/src/arith/ratio.h
@@ -32,8 +32,7 @@ struct cons_pointer subtract_ratio_ratio( struct cons_pointer arg1,
                                           struct cons_pointer arg2 );
 
 struct cons_pointer make_ratio( struct cons_pointer dividend,
-                                struct cons_pointer divisor,
-                                bool simplify );
+                                struct cons_pointer divisor, bool simplify );
 
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b );
 
diff --git a/src/debug.c b/src/debug.c
index 6fa258a..1b895c2 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -147,15 +147,16 @@ void debug_dump_object( struct cons_pointer pointer, int level ) {
 /**
  * Standardise printing of binding trace messages.
  */
-void debug_print_binding( struct cons_pointer key, struct cons_pointer val, bool deep, int level) {
+void debug_print_binding( struct cons_pointer key, struct cons_pointer val,
+                          bool deep, int level ) {
 #ifdef DEBUG
     // wchar_t * depth = (deep ? L"Deep" : L"Shallow");
 
-    debug_print( (deep ? L"Deep" : L"Shallow"), level);
-    debug_print( L" binding `", level);
-    debug_print_object( key, level);
-    debug_print( L"` to `", level);
-    debug_print_object( val, level);
-    debug_print( L"`\n", level);
+    debug_print( ( deep ? L"Deep" : L"Shallow" ), level );
+    debug_print( L" binding `", level );
+    debug_print_object( key, level );
+    debug_print( L"` to `", level );
+    debug_print_object( val, level );
+    debug_print( L"`\n", level );
 #endif
-}
\ No newline at end of file
+}
diff --git a/src/debug.h b/src/debug.h
index 1bf2c18..ef3799d 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -87,6 +87,7 @@ void debug_println( int level );
 void debug_printf( int level, wchar_t *format, ... );
 void debug_print_object( struct cons_pointer pointer, int level );
 void debug_dump_object( struct cons_pointer pointer, int level );
-void debug_print_binding( struct cons_pointer key, struct cons_pointer val, bool deep, int level);
+void debug_print_binding( struct cons_pointer key, struct cons_pointer val,
+                          bool deep, int level );
 
 #endif
diff --git a/src/init.c b/src/init.c
index aec65c7..f1301ee 100644
--- a/src/init.c
+++ b/src/init.c
@@ -71,8 +71,9 @@ struct cons_pointer init_name_symbol = NIL;
 struct cons_pointer init_primitive_symbol = NIL;
 
 void maybe_bind_init_symbols(  ) {
-    if ( nilp( init_documentation_symbol)) {
-        init_documentation_symbol = c_string_to_lisp_keyword( L"documentation");
+    if ( nilp( init_documentation_symbol ) ) {
+        init_documentation_symbol =
+            c_string_to_lisp_keyword( L"documentation" );
     }
     if ( nilp( init_name_symbol ) ) {
         init_name_symbol = c_string_to_lisp_keyword( L"name" );
@@ -83,15 +84,16 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
-    if ( nilp( privileged_string_memory_exhausted)) {
+    if ( nilp( privileged_string_memory_exhausted ) ) {
         // we can't make this string when we need it, because memory is then 
         // exhausted!
-        privileged_string_memory_exhausted = c_string_to_lisp_string( L"Memory exhausted." );
+        privileged_string_memory_exhausted =
+            c_string_to_lisp_string( L"Memory exhausted." );
     }
 }
 
 void free_init_symbols(  ) {
-    dec_ref( init_documentation_symbol);
+    dec_ref( init_documentation_symbol );
     dec_ref( init_name_symbol );
     dec_ref( init_primitive_symbol );
 }
@@ -110,12 +112,14 @@ struct cons_pointer bind_function( wchar_t *name,
                                       struct cons_pointer,
                                       struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
-    struct cons_pointer d = c_string_to_lisp_string( doc);
+    struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
         make_cons( make_cons( init_primitive_symbol, TRUE ),
                    make_cons( make_cons( init_name_symbol, n ),
-                   make_cons( make_cons( init_documentation_symbol, d), NIL) ) );
+                              make_cons( make_cons
+                                         ( init_documentation_symbol, d ),
+                                         NIL ) ) );
 
     struct cons_pointer r =
         check_exception( deep_bind( n, make_function( meta, executable ) ),
@@ -132,20 +136,26 @@ struct cons_pointer bind_function( wchar_t *name,
  * this `name` in the `oblist`.
  */
 struct cons_pointer bind_special( wchar_t *name,
+                                  wchar_t *doc,
                                   struct cons_pointer ( *executable )
                                    ( struct stack_frame *, struct cons_pointer,
                                      struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
+    struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
         make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n ), NIL ) );
+                   make_cons( make_cons( init_name_symbol, n ),
+                              make_cons( make_cons
+                                         ( init_documentation_symbol, d ),
+                                         NIL ) ) );
 
     struct cons_pointer r =
         check_exception( deep_bind( n, make_special( meta, executable ) ),
                          "bind_special" );
 
     dec_ref( n );
+    dec_ref( d );
 
     return r;
 }
@@ -334,96 +344,179 @@ int main( int argc, char *argv[] ) {
     /*
      * primitive function operations
      */
-     /* TODO: docstrings should be moved to a header file, or even to an at-run-time resolution system. 
-      * HTTP from an address at journeyman? */
-    bind_function( L"absolute", 
-        L"`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.", 
-        &lisp_absolute );
-    bind_function( L"add", 
-        L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.", 
-        &lisp_add );
-    bind_function( L"and", 
-        L"`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.",
-        &lisp_and);
-    bind_function( L"append", L"`(append args...)`: If args are all collections, return the concatenation of those collections.", 
-        &lisp_append );
-    bind_function( L"apply", 
-        L"`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.", 
-        &lisp_apply );
-    bind_function( L"assoc", 
-        L"`(assoc key store)`: Return the value associated with this `key` in this `store`.",
-         &lisp_assoc );
-    bind_function( L"car", 
-        L"`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.", 
-        &lisp_car );
-    bind_function( L"cdr", 
-        L"`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.", 
-        &lisp_cdr );
-    bind_function( L"close", L"`(close stream)`: If `stream` is a stream, close that stream.", &lisp_close );
-    bind_function( L"cons", L"`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.", &lisp_cons );
-    bind_function( L"count", L"`(count s)`: Return the number of items in the sequence `s`.", &lisp_count);
-    bind_function( L"divide", 
-        L"`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.", 
-        &lisp_divide );
-    bind_function( L"eq?", L"`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.", &lisp_eq );
-    bind_function( L"equal?", L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.", &lisp_equal );
+    /* TODO: docstrings should be moved to a header file, or even to an at-run-time resolution system. 
+     * HTTP from an address at journeyman? */
+    bind_function( L"absolute",
+                   L"`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.",
+                   &lisp_absolute );
+    bind_function( L"add",
+                   L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.",
+                   &lisp_add );
+    bind_function( L"and",
+                   L"`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.",
+                   &lisp_and );
+    bind_function( L"append",
+                   L"`(append args...)`: If args are all collections, return the concatenation of those collections.",
+                   &lisp_append );
+    bind_function( L"apply",
+                   L"`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.",
+                   &lisp_apply );
+    bind_function( L"assoc",
+                   L"`(assoc key store)`: Return the value associated with this `key` in this `store`.",
+                   &lisp_assoc );
+    bind_function( L"car",
+                   L"`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.",
+                   &lisp_car );
+    bind_function( L"cdr",
+                   L"`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.",
+                   &lisp_cdr );
+    bind_function( L"close",
+                   L"`(close stream)`: If `stream` is a stream, close that stream.",
+                   &lisp_close );
+    bind_function( L"cons",
+                   L"`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.",
+                   &lisp_cons );
+    bind_function( L"count",
+                   L"`(count s)`: Return the number of items in the sequence `s`.",
+                   &lisp_count );
+    bind_function( L"divide",
+                   L"`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.",
+                   &lisp_divide );
+    bind_function( L"eq?",
+                   L"`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.",
+                   &lisp_eq );
+    bind_function( L"equal?",
+                   L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.",
+                   &lisp_equal );
     bind_function( L"eval", L"", &lisp_eval );
-    bind_function( L"exception", L"`(exception message)`: Return (throw) an exception with this `message`.", &lisp_exception );
-    bind_function( L"get-hash", L"`(get-hash arg)`: returns the natural number hash value of `arg`.", &lisp_get_hash );
-    bind_function( L"hashmap", 
-        L"`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.", 
-        lisp_make_hashmap );
-    bind_function( L"inspect", 
-        L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.", 
-        &lisp_inspect );
-    bind_function( L"keys", L"`(keys store)`: Return a list of all keys in this `store`.", &lisp_keys );
-    bind_function( L"list", L"`(list args...): Return a list of these `args`.", &lisp_list );
-    bind_function( L"mapcar", L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.", &lisp_mapcar );
-    bind_function( L"meta", L"`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.", &lisp_metadata );
-    bind_function( L"metadata", L"`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.", &lisp_metadata );
-    bind_function( L"multiply", L"`(* args...)` Multiply these `args`, all of which should be numbers.", &lisp_multiply );
-    bind_function( L"negative?", L"`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.", &lisp_is_negative );
-    bind_function( L"not", 
-        L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.",
-        &lisp_not);
-    bind_function( L"oblist", L"`(oblist)`: Return the current symbol bindings, as a map.", &lisp_oblist );
-    bind_function( L"open", L"`(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading.", &lisp_open );
-    bind_function( L"or", 
-        L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.",
-        &lisp_or);
-    bind_function( L"print", L"`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.", &lisp_print );
+    bind_function( L"exception",
+                   L"`(exception message)`: Return (throw) an exception with this `message`.",
+                   &lisp_exception );
+    bind_function( L"get-hash",
+                   L"`(get-hash arg)`: returns the natural number hash value of `arg`.",
+                   &lisp_get_hash );
+    bind_function( L"hashmap",
+                   L"`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.",
+                   lisp_make_hashmap );
+    bind_function( L"inspect",
+                   L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.",
+                   &lisp_inspect );
+    bind_function( L"keys",
+                   L"`(keys store)`: Return a list of all keys in this `store`.",
+                   &lisp_keys );
+    bind_function( L"list", L"`(list args...): Return a list of these `args`.",
+                   &lisp_list );
+    bind_function( L"mapcar",
+                   L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.",
+                   &lisp_mapcar );
+    bind_function( L"meta",
+                   L"`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.",
+                   &lisp_metadata );
+    bind_function( L"metadata",
+                   L"`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.",
+                   &lisp_metadata );
+    bind_function( L"multiply",
+                   L"`(* args...)` Multiply these `args`, all of which should be numbers.",
+                   &lisp_multiply );
+    bind_function( L"negative?",
+                   L"`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.",
+                   &lisp_is_negative );
+    bind_function( L"not",
+                   L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.",
+                   &lisp_not );
+    bind_function( L"oblist",
+                   L"`(oblist)`: Return the current symbol bindings, as a map.",
+                   &lisp_oblist );
+    bind_function( L"open",
+                   L"`(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading.",
+                   &lisp_open );
+    bind_function( L"or",
+                   L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.",
+                   &lisp_or );
+    bind_function( L"print",
+                   L"`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.",
+                   &lisp_print );
+    bind_function( L"println",
+                   L"`(println stream)`: Print a new line character to `stream`, if specified, else to `*out*`.",
+                   &lisp_print );
     bind_function( L"put!", L"", lisp_hashmap_put );
-    bind_function( L"put-all!", L"", &lisp_hashmap_put_all );
-    bind_function( L"ratio->real", L"`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.", &lisp_ratio_to_real );
-    bind_function( L"read", L"", &lisp_read );
-    bind_function( L"read-char", L"", &lisp_read_char );
-    bind_function( L"repl", L"", &lisp_repl );
-    bind_function( L"reverse", L"", &lisp_reverse );
+    bind_function( L"put-all!",
+                   L"`(put-all! dest source)`: If `dest` is a namespace and is writable, copies all key-value pairs from `source` into `dest`.",
+                   &lisp_hashmap_put_all );
+    bind_function( L"ratio->real",
+                   L"`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.",
+                   &lisp_ratio_to_real );
+    bind_function( L"read",
+                   L"`(read stream)`: read one complete lisp form and return it. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment.",
+                   &lisp_read );
+    bind_function( L"read-char",
+                   L"`(read-char stream)`: Return the next character. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment.",
+                   &lisp_read_char );
+    bind_function( L"repl",
+                   L"`(repl prompt input output)`: Starts a new read-eval-print-loop. All arguments are optional.",
+                   &lisp_repl );
+    bind_function( L"reverse",
+                   L"`(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order.",
+                   &lisp_reverse );
     bind_function( L"set", L"", &lisp_set );
-    bind_function( L"slurp", L"", &lisp_slurp );
-    bind_function( L"source", L"", &lisp_source );
-    bind_function( L"subtract", L"", &lisp_subtract );
+    bind_function( L"slurp",
+                   L"`(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string.",
+                   &lisp_slurp );
+    bind_function( L"source",
+                   L"`(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil.",
+                   &lisp_source );
+    bind_function( L"subtract",
+                   L"`(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers.",
+                   &lisp_subtract );
     bind_function( L"throw", L"", &lisp_exception );
-    bind_function( L"time", L"", &lisp_time );
-    bind_function( L"type", L"", &lisp_type );
-    bind_function( L"+", L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.", &lisp_add );
-    bind_function( L"*", L"", &lisp_multiply );
-    bind_function( L"-", L"", &lisp_subtract );
-    bind_function( L"/", L"", &lisp_divide );
-    bind_function( L"=", L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.", &lisp_equal );
+    bind_function( L"time",
+                   L"`(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch.",
+                   &lisp_time );
+    bind_function( L"type",
+                   L"`(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change.",
+                   &lisp_type );
+    bind_function( L"+",
+                   L"`(+ args...)`: If `args` are all numbers, return the sum of those numbers.",
+                   &lisp_add );
+    bind_function( L"*",
+                   L"`(* args...)` Multiply these `args`, all of which should be numbers.",
+                   &lisp_multiply );
+    bind_function( L"-",
+                   L"`(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers.",
+                   &lisp_subtract );
+    bind_function( L"/",
+                   L"`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.",
+                   &lisp_divide );
+    bind_function( L"=",
+                   L"`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.",
+                   &lisp_equal );
     /*
      * primitive special forms
      */
-    bind_special( L"cond", &lisp_cond );
-    bind_special( L"lambda", &lisp_lambda );
-    bind_special( L"\u03bb", &lisp_lambda );  // λ
-    bind_special( L"let", &lisp_let );
-    bind_special( L"nlambda", &lisp_nlambda );
-    bind_special( L"n\u03bb", &lisp_nlambda );
-    bind_special( L"progn", &lisp_progn );
-    bind_special( L"quote", &lisp_quote );
-    bind_special( L"set!", &lisp_set_shriek );
-    bind_special( L"try", &lisp_try );
+    bind_special( L"cond",
+                  L"`(cond clauses...)`: Conditional evaluation, `clauses` is a sequence of lists of forms such that if evaluating the first form in any clause returns non-`nil`, the subsequent forms in that clause will be evaluated and the value of the last returned; but any subsequent clauses will not be evaluated.",
+                  &lisp_cond );
+    bind_special( L"lambda",
+                  L"`(lambda arg-list forms...)`: Construct an interpretable λ funtion.",
+                  &lisp_lambda );
+    bind_special( L"\u03bb", L"", &lisp_lambda ); // λ
+    bind_special( L"let",
+                  L"`(let bindings forms)`: Bind these `bindings`, which should be specified as an association list, into the local environment and evaluate these forms sequentially in that context, returning the value of the last.",
+                  &lisp_let );
+    bind_special( L"nlambda",
+                  L"`(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated.",
+                  &lisp_nlambda );
+    bind_special( L"n\u03bb", L"`(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated.", &lisp_nlambda );  // nλ
+    bind_special( L"progn",
+                  L"`(progn forms...)` Evaluate `forms` sequentially, and return the value of the last.",
+                  &lisp_progn );
+    bind_special( L"quote",
+                  L"`(quote form)`: Returns `form`, unevaluated. More idiomatically expressed `'form`, where the quote mark is a reader macro which is expanded to `(quote form)`.",
+                  &lisp_quote );
+    bind_special( L"set!",
+                  L"`(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace.",
+                  &lisp_set_shriek );
+    bind_special( L"try", L"", &lisp_try );
     debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP );
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
 
@@ -432,8 +525,9 @@ int main( int argc, char *argv[] ) {
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
 
     debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
-    while ( (pointer2cell(oblist)).count > 0) {
-        fprintf( stderr, "Dangling refs on oblist: %d\n", (pointer2cell(oblist)).count );
+    while ( ( pointer2cell( oblist ) ).count > 0 ) {
+        fprintf( stderr, "Dangling refs on oblist: %d\n",
+                 ( pointer2cell( oblist ) ).count );
         dec_ref( oblist );
     }
 
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/io/print.c b/src/io/print.c
index 5922b2b..fdd6ed4 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -17,15 +17,17 @@
 #include 
 #include 
 
+#include "arith/integer.h"
+#include "debug.h"
+#include "io/io.h"
+#include "io/print.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
 #include "memory/hashmap.h"
-#include "arith/integer.h"
-#include "ops/intern.h"
 #include "memory/stack.h"
-#include "io/print.h"
-#include "time/psse_time.h"
 #include "memory/vectorspace.h"
+#include "ops/intern.h"
+#include "time/psse_time.h"
 
 /**
  * print all the characters in the symbol or string indicated by `pointer`
@@ -117,7 +119,7 @@ void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
             print_map( output, pointer );
             break;
         case STACKFRAMETV:
-            dump_stack_trace( output, pointer);
+            dump_stack_trace( output, pointer );
             break;
             // \todo: others.
         default:
@@ -251,7 +253,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
             url_fwprintf( output, L"', output );
             break;
         case TRUETV:
@@ -269,12 +271,95 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) {
             fwprintf( stderr,
                       L"Error: Unrecognised tag value %d (%4.4s)\n",
                       cell.tag.value, &cell.tag.bytes[0] );
+            // dump_object( stderr, pointer);
             break;
     }
 
     return pointer;
 }
 
+/**
+ * Function; print one complete lisp expression and return NIL. If write-stream is specified and
+ * is a write stream, then print to that stream, else  the stream which is the value of
+ * `*out*` in the environment.
+ *
+ * * (print expr)
+ * * (print expr write-stream)
+ *
+ * @param frame my stack_frame.
+ * @param frame_pointer a pointer to my stack_frame.
+ * @param env my environment (from which the stream may be extracted).
+ * @return NIL.
+ */
+struct cons_pointer
+lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
+            struct cons_pointer env ) {
+    debug_print( L"Entering print\n", DEBUG_IO );
+    struct cons_pointer result = NIL;
+    URL_FILE *output;
+    struct cons_pointer out_stream = writep( frame->arg[1] ) ?
+        frame->arg[1] : get_default_stream( false, env );
+
+    if ( writep( out_stream ) ) {
+        debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
+        debug_dump_object( out_stream, DEBUG_IO );
+        output = pointer2cell( out_stream ).payload.stream.stream;
+        inc_ref( out_stream );
+    } else {
+        output = file_to_url_file( stderr );
+    }
+
+    debug_print( L"lisp_print: about to print\n", DEBUG_IO );
+    debug_dump_object( frame->arg[0], DEBUG_IO );
+
+    result = print( output, frame->arg[0] );
+
+    debug_print( L"lisp_print returning\n", DEBUG_IO );
+    debug_dump_object( result, DEBUG_IO );
+
+    if ( writep( out_stream ) ) {
+        dec_ref( out_stream );
+    } else {
+        free( output );
+    }
+
+    return result;
+}
+
 void println( URL_FILE *output ) {
     url_fputws( L"\n", output );
 }
+
+/**
+ * @brief `(prinln out-stream)`: Print a new line character to `out-stream`, if
+ * it is specified and is an output stream, else to `*out*`.
+ * 
+ * @param frame 
+ * @param frame_pointer 
+ * @param env 
+ * @return `nil`
+ */
+struct cons_pointer
+lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
+              struct cons_pointer env ) {
+    URL_FILE *output;
+    struct cons_pointer out_stream = writep( frame->arg[1] ) ?
+        frame->arg[1] : get_default_stream( false, env );
+
+    if ( writep( out_stream ) ) {
+        output = pointer2cell( out_stream ).payload.stream.stream;
+        inc_ref( out_stream );
+    } else {
+        output = file_to_url_file( stderr );
+    }
+
+    println( output );
+
+    if ( writep( out_stream ) ) {
+        dec_ref( out_stream );
+    } else {
+        free( output );
+    }
+
+    return NIL;
+}
diff --git a/src/io/print.h b/src/io/print.h
index b72513c..bde68fb 100644
--- a/src/io/print.h
+++ b/src/io/print.h
@@ -19,4 +19,12 @@
 struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer );
 void println( URL_FILE * output );
 
+struct cons_pointer lisp_print( struct stack_frame *frame,
+                                struct cons_pointer frame_pointer,
+                                struct cons_pointer env );
+struct cons_pointer lisp_println( struct stack_frame *frame,
+                                  struct cons_pointer frame_pointer,
+                                  struct cons_pointer env );
+
+
 #endif
diff --git a/src/io/read.c b/src/io/read.c
index c103274..9ca49f0 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -370,7 +370,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
                                                                ( to_long_double
                                                                  ( base ),
                                                                  places_of_decimals ),
-                                                               NIL ), true);
+                                                               NIL ), true );
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 0cc6cc8..d7d5cd0 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -132,11 +132,11 @@ void dump_pages( URL_FILE *output ) {
         url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
 
         for ( int j = 0; j < CONSPAGESIZE; j++ ) {
-            struct cons_pointer pointer = ( struct cons_pointer ) { i, j};
-            if (!freep( pointer)) {
+            struct cons_pointer pointer = ( struct cons_pointer ) { i, j };
+            if ( !freep( pointer ) ) {
                 dump_object( output, ( struct cons_pointer ) {
-                            i, j
-                            } );
+                             i, j
+                             } );
             }
         }
     }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index d0ece0f..3793709 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -65,11 +65,16 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
     if ( cell->count < MAXREFERENCE ) {
         cell->count++;
 #ifdef DEBUG
-        debug_printf( DEBUG_ALLOC, L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
-        if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
-            debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
+        debug_printf( DEBUG_ALLOC,
+                      L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d",
+                      ( ( char * ) cell->tag.bytes ), pointer.page,
+                      pointer.offset, cell->count );
+        if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
+            debug_printf( DEBUG_ALLOC,
+                          L"; pointer to vector object of type %4.4s.\n",
+                          ( ( char * ) ( cell->payload.vectorp.tag.bytes ) ) );
         } else {
-            debug_println( DEBUG_ALLOC);
+            debug_println( DEBUG_ALLOC );
         }
 #endif
     }
@@ -91,11 +96,17 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
     if ( cell->count > 0 && cell->count != UINT32_MAX ) {
         cell->count--;
 #ifdef DEBUG
-        debug_printf( DEBUG_ALLOC, L"\nDecremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
-        if ( strncmp( (char *)cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
-            debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
+        debug_printf( DEBUG_ALLOC,
+                      L"\nDecremented cell of type %4.4s at page %d, offset %d to count %d",
+                      ( ( char * ) cell->tag.bytes ), pointer.page,
+                      pointer.offset, cell->count );
+        if ( strncmp( ( char * ) cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH )
+             == 0 ) {
+            debug_printf( DEBUG_ALLOC,
+                          L"; pointer to vector object of type %4.4s.\n",
+                          ( ( char * ) ( cell->payload.vectorp.tag.bytes ) ) );
         } else {
-            debug_println( DEBUG_ALLOC);
+            debug_println( DEBUG_ALLOC );
         }
 #endif
 
@@ -119,8 +130,8 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
      * strings made with NIL termination. The question is which should be 
      * fixed, and actually that's probably strings read by `read`. However,
      * for now, it was easier to add a null character here. */
-    struct cons_pointer result = make_string( (wchar_t) 0, NIL);
-    struct cons_space_object * cell = &pointer2cell( pointer );
+    struct cons_pointer result = make_string( ( wchar_t ) 0, NIL );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
     if ( cell->tag.value == VECTORPOINTTV ) {
         struct vector_space_object *vec = pointer_to_vso( pointer );
@@ -337,8 +348,8 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
         cell->payload.string.cdr = tail;
 
         cell->payload.string.hash = calculate_hash( c, tail );
-        debug_dump_object( pointer, DEBUG_ALLOC);
-        debug_println( DEBUG_ALLOC);
+        debug_dump_object( pointer, DEBUG_ALLOC );
+        debug_println( DEBUG_ALLOC );
     } else {
         // \todo should throw an exception!
         debug_printf( DEBUG_ALLOC,
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/dump.h b/src/memory/dump.h
index f8ef75f..0a69626 100644
--- a/src/memory/dump.h
+++ b/src/memory/dump.h
@@ -19,6 +19,8 @@
 #ifndef __dump_h
 #define __dump_h
 
+void dump_string_cell( URL_FILE * output, wchar_t *prefix,
+                       struct cons_pointer pointer );
 
 void dump_object( URL_FILE * output, struct cons_pointer pointer );
 
diff --git a/src/memory/stack.c b/src/memory/stack.c
index d1a344e..b6833c9 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -122,8 +122,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
     if ( nilp( result ) ) {
         /* i.e. out of memory */
         result =
-            make_exception( privileged_string_memory_exhausted,
-                            previous );
+            make_exception( privileged_string_memory_exhausted, previous );
     } else {
         struct stack_frame *frame = get_stack_frame( result );
 
@@ -234,7 +233,7 @@ void free_stack_frame( struct stack_frame *frame ) {
     debug_print( L"Leaving free_stack_frame\n", DEBUG_ALLOC );
 }
 
-struct cons_pointer frame_get_previous( struct cons_pointer frame_pointer) {
+struct cons_pointer frame_get_previous( struct cons_pointer frame_pointer ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
     struct cons_pointer result = NIL;
 
@@ -245,27 +244,31 @@ struct cons_pointer frame_get_previous( struct cons_pointer frame_pointer) {
     return result;
 }
 
-void dump_frame_context_fragment( URL_FILE *output, struct cons_pointer frame_pointer) {
+void dump_frame_context_fragment( URL_FILE *output,
+                                  struct cons_pointer frame_pointer ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
 
     if ( frame != NULL ) {
-        url_fwprintf( output, L" <= ");
-        print( output, frame->arg[0]);
+        url_fwprintf( output, L" <= " );
+        print( output, frame->arg[0] );
     }
 }
 
-void dump_frame_context( URL_FILE *output, struct cons_pointer frame_pointer, int depth ) {
+void dump_frame_context( URL_FILE *output, struct cons_pointer frame_pointer,
+                         int depth ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
 
     if ( frame != NULL ) {
-        url_fwprintf( output, L"\tContext: ");
+        url_fwprintf( output, L"\tContext: " );
 
         int i = 0;
-        for (struct cons_pointer cursor = frame_pointer; i++ < depth && !nilp( cursor); cursor = frame_get_previous( cursor)) {
-            dump_frame_context_fragment( output, cursor);
+        for ( struct cons_pointer cursor = frame_pointer;
+              i++ < depth && !nilp( cursor );
+              cursor = frame_get_previous( cursor ) ) {
+            dump_frame_context_fragment( output, cursor );
         }
-        
-        url_fwprintf( output, L"\n");
+
+        url_fwprintf( output, L"\n" );
     }
 }
 
@@ -280,7 +283,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
     if ( frame != NULL ) {
         url_fwprintf( output, L"Stack frame with %d arguments:\n",
                       frame->args );
-        dump_frame_context( output, frame_pointer, 4);
+        dump_frame_context( output, frame_pointer, 4 );
 
         for ( int arg = 0; arg < frame->args; arg++ ) {
             struct cons_space_object cell = pointer2cell( frame->arg[arg] );
diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c
index c209109..26a23d9 100644
--- a/src/memory/vectorspace.c
+++ b/src/memory/vectorspace.c
@@ -126,8 +126,9 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
 void free_vso( struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
 
-    debug_printf( DEBUG_ALLOC, L"About to free vector-space object of type %s at 0x%lx\n",
-                  (char *) cell.payload.vectorp.tag.bytes,
+    debug_printf( DEBUG_ALLOC,
+                  L"About to free vector-space object of type %s at 0x%lx\n",
+                  ( char * ) cell.payload.vectorp.tag.bytes,
                   cell.payload.vectorp.address );
     struct vector_space_object *vso = cell.payload.vectorp.address;
 
diff --git a/src/ops/equal.c b/src/ops/equal.c
index cdfabbf..b4412fb 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -263,17 +263,18 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
  * @return false otherwise.
  */
 bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
-    bool result=false;
+    bool result = false;
 
-    struct cons_pointer keys_a = hashmap_keys( a);
-    
-    if ( c_length( keys_a) == c_length( hashmap_keys( b))) {
+    struct cons_pointer keys_a = hashmap_keys( a );
+
+    if ( c_length( keys_a ) == c_length( hashmap_keys( b ) ) ) {
         result = true;
 
-        for ( struct cons_pointer i = keys_a; !nilp( i); i = c_cdr( i)) {
-            struct cons_pointer key = c_car( i);
-            if ( !equal( hashmap_get( a, key),hashmap_get( b, key))) {
-                result = false; break;
+        for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
+            struct cons_pointer key = c_car( i );
+            if ( !equal( hashmap_get( a, key ), hashmap_get( b, key ) ) ) {
+                result = false;
+                break;
             }
         }
     }
@@ -298,23 +299,23 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
 bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
     bool result = false;
 
-    if ( eq( a, b)) {
-        result = true; // same 
+    if ( eq( a, b ) ) {
+        result = true;          // same 
         /* there shouldn't ever be two separate VECP cells which point to the
          * same address in vector space, so I don't believe it's worth checking
          * for this.
          */
-    } else if ( vectorp( a) && vectorp( b)) {
-        struct vector_space_object * va = pointer_to_vso( a);
-        struct vector_space_object * vb = pointer_to_vso( b);
+    } else if ( vectorp( a ) && vectorp( b ) ) {
+        struct vector_space_object *va = pointer_to_vso( a );
+        struct vector_space_object *vb = pointer_to_vso( b );
 
         /* what we're saying here is that a namespace is not equal to a map,
          * even if they have identical logical structure. Is this right? */
-        if ( va->header.tag.value == vb->header.tag.value) {
-            switch ( va->header.tag.value) {
+        if ( va->header.tag.value == vb->header.tag.value ) {
+            switch ( va->header.tag.value ) {
                 case HASHTV:
                 case NAMESPACETV:
-                    result = equal_map_map( a, b);
+                    result = equal_map_map( a, b );
                     break;
             }
         }
@@ -334,9 +335,9 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
     debug_print( L" = ", DEBUG_ARITH );
     debug_print_object( b, DEBUG_ARITH );
 
-    bool result = false; 
-    
-    if ( eq( a, b )) {
+    bool result = false;
+
+    if ( eq( a, b ) ) {
         result = true;
     } else if ( !numberp( a ) && same_type( a, b ) ) {
         struct cons_space_object *cell_a = &pointer2cell( a );
@@ -364,42 +365,47 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                 /* TODO: it is not OK to do this on the stack since list-like 
                  * structures can be of indefinite extent. It *must* be done by 
                  * iteration (and even that is problematic) */
-                if (cell_a->payload.string.hash == cell_b->payload.string.hash) {
-                    wchar_t a_buff[ STRING_SHIPYARD_SIZE], b_buff[ STRING_SHIPYARD_SIZE];
+                if ( cell_a->payload.string.hash ==
+                     cell_b->payload.string.hash ) {
+                    wchar_t a_buff[STRING_SHIPYARD_SIZE],
+                        b_buff[STRING_SHIPYARD_SIZE];
                     uint32_t tag = cell_a->tag.value;
                     int i = 0;
 
-                    memset(a_buff,0,sizeof(a_buff));
-                    memset(b_buff,0,sizeof(b_buff));
+                    memset( a_buff, 0, sizeof( a_buff ) );
+                    memset( b_buff, 0, sizeof( b_buff ) );
 
-                    for (; (i < (STRING_SHIPYARD_SIZE - 1)) && !nilp( a) && !nilp( b); i++) {
+                    for ( ;
+                          ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
+                          && !nilp( b ); i++ ) {
                         a_buff[i] = cell_a->payload.string.character;
-                        a = c_cdr(a);
+                        a = c_cdr( a );
                         cell_a = &pointer2cell( a );
 
                         b_buff[i] = cell_b->payload.string.character;
-                        b = c_cdr( b);
-                        cell_b = &pointer2cell( b); 
+                        b = c_cdr( b );
+                        cell_b = &pointer2cell( b );
                     }
 
 #ifdef DEBUG
-                    debug_print( L"Comparing '", DEBUG_ARITH);
-                    debug_print( a_buff, DEBUG_ARITH);
-                    debug_print( L"' to '", DEBUG_ARITH);
-                    debug_print( b_buff, DEBUG_ARITH);
-                    debug_print( L"'\n", DEBUG_ARITH);
+                    debug_print( L"Comparing '", DEBUG_ARITH );
+                    debug_print( a_buff, DEBUG_ARITH );
+                    debug_print( L"' to '", DEBUG_ARITH );
+                    debug_print( b_buff, DEBUG_ARITH );
+                    debug_print( L"'\n", DEBUG_ARITH );
 #endif
 
                     /* OK, now we have wchar string buffers loaded from the objects. We 
                      * may not have exhausted either string, so the buffers being equal
                      * isn't sufficient. So we recurse at least once. */
 
-                    result = (wcsncmp( a_buff, b_buff, i) == 0) && equal( c_cdr(a), c_cdr(b));
+                    result = ( wcsncmp( a_buff, b_buff, i ) == 0 )
+                        && equal( c_cdr( a ), c_cdr( b ) );
                 }
                 break;
             case VECTORPOINTTV:
-                if ( cell_b->tag.value == VECTORPOINTTV) {
-                    result = equal_vector_vector( a, b);
+                if ( cell_b->tag.value == VECTORPOINTTV ) {
+                    result = equal_vector_vector( a, b );
                 } else {
                     result = false;
                 }
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 7ac9d08..e064ac4 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -310,7 +310,8 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         debug_print( L"`", DEBUG_BIND );
         debug_print_object( key, DEBUG_BIND );
         debug_print( L"` is a ", DEBUG_BIND );
-        debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
+        debug_printf( DEBUG_BIND, L"%4.4s",
+                      ( char * ) pointer2cell( key ).tag.bytes );
         debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
     }
 
@@ -328,12 +329,12 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store ) {
     struct cons_pointer result = NIL;
-    
-    if (!nilp( key)) {
+
+    if ( !nilp( key ) ) {
         if ( consp( store ) ) {
             for ( struct cons_pointer next = store;
-                nilp( result ) && ( consp( next ) || hashmapp( next ) );
-                next = pointer2cell( next ).payload.cons.cdr ) {
+                  nilp( result ) && ( consp( next ) || hashmapp( next ) );
+                  next = pointer2cell( next ).payload.cons.cdr ) {
                 if ( consp( next ) ) {
 // #ifdef DEBUG
 //                     debug_print( L"\nc_assoc; key is `", DEBUG_BIND );
@@ -355,9 +356,9 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             break;
                         default:
                             throw_exception( c_append
-                                            ( c_string_to_lisp_string
-                                            ( L"Store entry is of unknown type: " ),
-                                            c_type( entry_ptr ) ), NIL );
+                                             ( c_string_to_lisp_string
+                                               ( L"Store entry is of unknown type: " ),
+                                               c_type( entry_ptr ) ), NIL );
                     }
 
 // #ifdef DEBUG
@@ -379,9 +380,9 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 // #endif
             result =
                 throw_exception( c_append
-                                ( c_string_to_lisp_string
-                                ( L"Store is of unknown type: " ),
-                                c_type( store ) ), NIL );
+                                 ( c_string_to_lisp_string
+                                   ( L"Store is of unknown type: " ),
+                                   c_type( store ) ), NIL );
         }
     }
 
@@ -410,7 +411,7 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
 
         map->payload.hashmap.buckets[bucket_no] =
             make_cons( make_cons( key, val ),
-                                map->payload.hashmap.buckets[bucket_no] );
+                       map->payload.hashmap.buckets[bucket_no] );
     }
 
     return mapp;
@@ -425,13 +426,13 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = vectorpointp( store);
-    debug_print_binding( key, value, deep, DEBUG_BIND);
+    bool deep = vectorpointp( store );
+    debug_print_binding( key, value, deep, DEBUG_BIND );
 
-    if (deep) {
+    if ( deep ) {
         debug_printf( DEBUG_BIND, L"\t-> %4.4s\n",
-                  pointer2cell(store).payload.vectorp.tag.bytes );
-    } 
+                      pointer2cell( store ).payload.vectorp.tag.bytes );
+    }
 #endif
     if ( nilp( value ) ) {
         result = store;
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 074566e..7333c3f 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -251,7 +251,7 @@ struct cons_pointer
 eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
              struct cons_pointer frame_pointer, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-#ifdef DEBUG    
+#ifdef DEBUG
     debug_print( L"eval_lambda called\n", DEBUG_LAMBDA );
     debug_println( DEBUG_LAMBDA );
 #endif
@@ -308,7 +308,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 
         /* if a result is not the terminal result in the lambda, it's a
          * side effect, and needs to be GCed */
-        if ( !nilp( result ) ){
+        if ( !nilp( result ) ) {
             dec_ref( result );
         }
 
@@ -446,9 +446,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.special.
-                              executable ) ( get_stack_frame( next_pointer ),
-                                             next_pointer, env );
+                            ( *fn_cell.payload.
+                              special.executable ) ( get_stack_frame
+                                                     ( next_pointer ),
+                                                     next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -870,15 +871,14 @@ struct cons_pointer lisp_keys( struct stack_frame *frame,
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env ) {
-    struct cons_pointer result = TRUE;   
+    struct cons_pointer result = TRUE;
 
-    if ( frame->args > 1) {
-        for (int b = 1; ( truep( result )) && (b < frame->args); b++)
-        {
-            result = eq( frame->arg[0], fetch_arg( frame, b)) ? TRUE : NIL;
+    if ( frame->args > 1 ) {
+        for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
+            result = eq( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
         }
-    } 
-    
+    }
+
     return result;
 }
 
@@ -895,32 +895,32 @@ struct cons_pointer lisp_eq( struct stack_frame *frame,
 struct cons_pointer
 lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    struct cons_pointer result = TRUE;   
+    struct cons_pointer result = TRUE;
 
-    if ( frame->args > 1) {
-        for (int b = 1; ( truep( result )) && (b < frame->args); b++)
-        {
-            result = equal( frame->arg[0], fetch_arg( frame, b)) ? TRUE : NIL;
+    if ( frame->args > 1 ) {
+        for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
+            result =
+                equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
         }
-    } 
-    
+    }
+
     return result;
 }
 
-long int c_count (struct cons_pointer p) {
-    struct cons_space_object * cell = &pointer2cell( p);
+long int c_count( struct cons_pointer p ) {
+    struct cons_space_object *cell = &pointer2cell( p );
     int result = 0;
 
-    switch (cell->tag.value) {
+    switch ( cell->tag.value ) {
         case CONSTV:
         case STRINGTV:
-        /* I think doctrine is that you cannot treat symbols or keywords as
-         * sequences, although internally, of course, they are. Integers are
-         * also internally sequences, but also should not be treated as such.
-         */
-        for (p; !nilp( p); p = c_cdr( p)) {
-            result ++;
-        }
+            /* I think doctrine is that you cannot treat symbols or keywords as
+             * sequences, although internally, of course, they are. Integers are
+             * also internally sequences, but also should not be treated as such.
+             */
+            for ( p; !nilp( p ); p = c_cdr( p ) ) {
+                result++;
+            }
     }
 
     return result;
@@ -942,7 +942,7 @@ long int c_count (struct cons_pointer p) {
 struct cons_pointer
 lisp_count( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    return acquire_integer( c_count( frame->arg[ 0]), NIL);
+    return acquire_integer( c_count( frame->arg[0] ), NIL );
 }
 
 /**
@@ -1079,54 +1079,6 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame,
     return result;
 }
 
-/**
- * Function; print one complete lisp expression and return NIL. If write-stream is specified and
- * is a write stream, then print to that stream, else  the stream which is the value of
- * `*out*` in the environment.
- *
- * * (print expr)
- * * (print expr write-stream)
- *
- * @param frame my stack_frame.
- * @param frame_pointer a pointer to my stack_frame.
- * @param env my environment (from which the stream may be extracted).
- * @return NIL.
- */
-struct cons_pointer
-lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
-            struct cons_pointer env ) {
-    debug_print( L"Entering print\n", DEBUG_IO );
-    struct cons_pointer result = NIL;
-    URL_FILE *output;
-    struct cons_pointer out_stream = writep( frame->arg[1] ) ?
-        frame->arg[1] : get_default_stream( false, env );
-
-    if ( writep( out_stream ) ) {
-        debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
-        debug_dump_object( out_stream, DEBUG_IO );
-        output = pointer2cell( out_stream ).payload.stream.stream;
-        inc_ref( out_stream );
-    } else {
-        output = file_to_url_file( stderr );
-    }
-
-    debug_print( L"lisp_print: about to print\n", DEBUG_IO );
-    debug_dump_object( frame->arg[0], DEBUG_IO );
-
-    result = print( output, frame->arg[0] );
-
-    debug_print( L"lisp_print returning\n", DEBUG_IO );
-    debug_dump_object( result, DEBUG_IO );
-
-    if ( writep( out_stream ) ) {
-        dec_ref( out_stream );
-    } else {
-        free( output );
-    }
-
-    return result;
-}
-
 
 /**
  * Function: get the Lisp type of the single argument.
@@ -1204,37 +1156,41 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * @brief evaluate a single cond clause; if the test part succeeds return a 
  * pair whose car is TRUE and whose cdr is the value of the action part 
  */
-struct cons_pointer eval_cond_clause( struct cons_pointer clause, 
-    struct stack_frame *frame, struct cons_pointer frame_pointer, 
-    struct cons_pointer env) {
+struct cons_pointer eval_cond_clause( struct cons_pointer clause,
+                                      struct stack_frame *frame,
+                                      struct cons_pointer frame_pointer,
+                                      struct cons_pointer env ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
     debug_print( L"\n\tCond clause: ", DEBUG_EVAL );
     debug_print_object( clause, DEBUG_EVAL );
-    debug_println( DEBUG_EVAL);
+    debug_println( DEBUG_EVAL );
 #endif
 
-    if (consp(clause)) {
-        struct cons_pointer val = eval_form( frame, frame_pointer, c_car( clause ),
-                           env );
+    if ( consp( clause ) ) {
+        struct cons_pointer val =
+            eval_form( frame, frame_pointer, c_car( clause ),
+                       env );
 
-        if (!nilp( val)) {
-            result = make_cons( TRUE, c_progn( frame, frame_pointer, c_cdr( clause ),
-                             env ));
+        if ( !nilp( val ) ) {
+            result =
+                make_cons( TRUE,
+                           c_progn( frame, frame_pointer, c_cdr( clause ),
+                                    env ) );
 
 #ifdef DEBUG
-                debug_print(L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL);
-                debug_print_object( result, DEBUG_EVAL);
-                debug_println( DEBUG_EVAL);
+            debug_print( L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL );
+            debug_print_object( result, DEBUG_EVAL );
+            debug_println( DEBUG_EVAL );
         } else {
-            debug_print(L"\n\t\tclause failed.\n", DEBUG_EVAL);
+            debug_print( L"\n\t\tclause failed.\n", DEBUG_EVAL );
 #endif
-        }          
+        }
     } else {
         result = throw_exception( c_string_to_lisp_string
-                                    ( L"Arguments to `cond` must be lists" ),
-                                    frame_pointer );
+                                  ( L"Arguments to `cond` must be lists" ),
+                                  frame_pointer );
     }
 
     return result;
@@ -1259,21 +1215,21 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
     struct cons_pointer result = NIL;
     bool done = false;
 
-    for ( int i = 0; (i < frame->args) && !done; i++ ) {
-        struct cons_pointer clause_pointer = fetch_arg( frame, i);
+    for ( int i = 0; ( i < frame->args ) && !done; i++ ) {
+        struct cons_pointer clause_pointer = fetch_arg( frame, i );
 
-        result = eval_cond_clause( clause_pointer, frame, frame_pointer, env);
+        result = eval_cond_clause( clause_pointer, frame, frame_pointer, env );
 
-        if ( !nilp( result ) && truep( c_car( result)) ) {
-            result = c_cdr( result);
+        if ( !nilp( result ) && truep( c_car( result ) ) ) {
+            result = c_cdr( result );
             done = true;
             break;
-        } 
+        }
     }
 #ifdef DEBUG
     debug_print( L"\tCond returning: ", DEBUG_EVAL );
     debug_print_object( result, DEBUG_EVAL );
-    debug_println( DEBUG_EVAL); 
+    debug_println( DEBUG_EVAL );
 #endif
 
     return result;
@@ -1330,7 +1286,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1426,7 +1383,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
         if ( exceptionp( expr )
              && url_feof( pointer2cell( input ).payload.stream.stream ) ) {
             /* suppress printing end of stream exception */
-            dec_ref( expr);
+            dec_ref( expr );
             break;
         }
 
@@ -1513,13 +1470,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }
@@ -1632,13 +1590,13 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
         struct cons_pointer symbol = c_car( pair );
 
         if ( symbolp( symbol ) ) {
-            struct cons_pointer val = eval_form( frame, frame_pointer, c_cdr( pair ),
-                                        bindings );
+            struct cons_pointer val =
+                eval_form( frame, frame_pointer, c_cdr( pair ),
+                           bindings );
 
-            debug_print_binding( symbol, val, false, DEBUG_BIND);
+            debug_print_binding( symbol, val, false, DEBUG_BIND );
 
-            bindings =
-                make_cons( make_cons( symbol, val ), bindings );
+            bindings = make_cons( make_cons( symbol, val ), bindings );
         } else {
             result =
                 throw_exception( c_string_to_lisp_string
@@ -1648,7 +1606,7 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
         }
     }
 
-    debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND);
+    debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND );
 
     /* i.e., no exception yet */
     for ( int form = 1; !exceptionp( result ) && form < frame->args; form++ ) {
@@ -1676,13 +1634,13 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
  * @return struct cons_pointer a pointer to the result
  */
 struct cons_pointer lisp_and( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env ) {
-    bool accumulator = true;                            
+                              struct cons_pointer frame_pointer,
+                              struct cons_pointer env ) {
+    bool accumulator = true;
     struct cons_pointer result = frame->more;
 
-    for ( int a = 0; accumulator == true && a < frame->args; a++) {
-        accumulator = truthy( fetch_arg( frame, a));
+    for ( int a = 0; accumulator == true && a < frame->args; a++ ) {
+        accumulator = truthy( fetch_arg( frame, a ) );
     }
 #
     return accumulator ? TRUE : NIL;
@@ -1697,13 +1655,13 @@ struct cons_pointer lisp_and( struct stack_frame *frame,
  * @return struct cons_pointer a pointer to the result
  */
 struct cons_pointer lisp_or( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env ) {
-    bool accumulator = false;                            
+                             struct cons_pointer frame_pointer,
+                             struct cons_pointer env ) {
+    bool accumulator = false;
     struct cons_pointer result = frame->more;
 
-    for ( int a = 0; accumulator == false && a < frame->args; a++) {
-        accumulator = truthy( fetch_arg( frame, a));
+    for ( int a = 0; accumulator == false && a < frame->args; a++ ) {
+        accumulator = truthy( fetch_arg( frame, a ) );
     }
 
     return accumulator ? TRUE : NIL;
@@ -1718,7 +1676,7 @@ struct cons_pointer lisp_or( struct stack_frame *frame,
  * @return struct cons_pointer `t` if the first argument is `nil`, else `nil`.
  */
 struct cons_pointer lisp_not( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env ) {
-    return nilp( frame->arg[0]) ? TRUE : NIL;
-}
\ No newline at end of file
+                              struct cons_pointer frame_pointer,
+                              struct cons_pointer env ) {
+    return nilp( frame->arg[0] ) ? TRUE : NIL;
+}
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index d29b3b8..aea8772 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -137,9 +137,6 @@ struct cons_pointer lisp_eq( struct stack_frame *frame,
 struct cons_pointer lisp_equal( struct stack_frame *frame,
                                 struct cons_pointer frame_pointer,
                                 struct cons_pointer env );
-struct cons_pointer lisp_print( struct stack_frame *frame,
-                                struct cons_pointer frame_pointer,
-                                struct cons_pointer env );
 struct cons_pointer lisp_read( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env );
@@ -231,14 +228,14 @@ struct cons_pointer lisp_try( struct stack_frame *frame,
 
 
 struct cons_pointer lisp_and( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env );
+                              struct cons_pointer frame_pointer,
+                              struct cons_pointer env );
 
 struct cons_pointer lisp_or( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env );
+                             struct cons_pointer frame_pointer,
+                             struct cons_pointer env );
 
 struct cons_pointer lisp_not( struct stack_frame *frame,
-                               struct cons_pointer frame_pointer,
-                               struct cons_pointer env );
+                              struct cons_pointer frame_pointer,
+                              struct cons_pointer env );
 #endif
diff --git a/unit-tests/eval-quote-symbol.sh b/unit-tests/eval-quote-symbol.sh
index 1f25241..5072fb5 100755
--- a/unit-tests/eval-quote-symbol.sh
+++ b/unit-tests/eval-quote-symbol.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-expected=''
+expected=''
 actual=`echo "(eval 'cond)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]

From 145a0fe5a747a23ab8853dff904fe83e00ad3799 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 27 Feb 2026 04:03:08 +0000
Subject: [PATCH 71/90] Updated the state of play.

---
 docs/State-of-play.md     | 13 +++++++++++++
 lisp/not-working-yet.lisp |  6 ------
 2 files changed, 13 insertions(+), 6 deletions(-)
 delete mode 100644 lisp/not-working-yet.lisp

diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index f6dfec4..61cfa0c 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,18 @@
 # State of Play
 
+## 20260226
+
+The bug in `member` turned out to be because when a symbol is read by the reader, 
+it has a null character appended as its last character, after all the visibly 
+printing characters. When the type string is being generated, it doesn't. I've
+fudged this for now by giving the type strings an appended null character, but
+the right solution is almost certainly to not add the null character in either 
+case — i.e. revert today's 'fix' and instead fix the reader.
+
+I've also done a lot of documentation, and I've found the courage to do some 
+investigation on the bignum bug. However, I've workeg until 04:00, which is
+neither sane nor healthy, so I shall stop.
+
 ## 20260225
 
 A productive day!
diff --git a/lisp/not-working-yet.lisp b/lisp/not-working-yet.lisp
deleted file mode 100644
index 0f3a8c2..0000000
--- a/lisp/not-working-yet.lisp
+++ /dev/null
@@ -1,6 +0,0 @@
-(set! or (lambda values
-                 "True if any of `values` are non-nil."
-                 (cond
-                   ((nil? values) nil)
-                   ((car values) t)
-                   (t (eval (cons 'or (cdr values)))))))

From 72548097cf9362e0c1f29559e81403267940a8c0 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 28 Feb 2026 11:21:11 +0000
Subject: [PATCH 72/90] Rewriting intern. This is badly broken, but I think on
 the road to better.

---
 src/init.c                   |  3 ++
 src/memory/consspaceobject.c |  2 +-
 src/ops/equal.c              |  3 +-
 src/ops/intern.c             | 97 +++++++++++++++++++++++-------------
 src/ops/intern.h             |  3 ++
 src/ops/lispops.c            | 33 ++++++++++--
 src/ops/lispops.h            |  3 ++
 7 files changed, 103 insertions(+), 41 deletions(-)

diff --git a/src/init.c b/src/init.c
index f1301ee..5febcbc 100644
--- a/src/init.c
+++ b/src/init.c
@@ -401,6 +401,9 @@ int main( int argc, char *argv[] ) {
     bind_function( L"inspect",
                    L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.",
                    &lisp_inspect );
+    bind_function( L"interned?",
+                   L"`(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.",
+                   &lisp_internedp );
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3793709..8c4c5c0 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -388,7 +388,7 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
         result = make_string_like_thing( c, tail, tag );
 
         if ( tag == KEYTV ) {
-            struct cons_pointer r = internedp( result, oblist );
+            struct cons_pointer r = interned( result, oblist );
 
             if ( nilp( r ) ) {
                 intern( result, oblist );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index b4412fb..ea813a9 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -375,8 +375,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     memset( a_buff, 0, sizeof( a_buff ) );
                     memset( b_buff, 0, sizeof( b_buff ) );
 
-                    for ( ;
-                          ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
+                    for ( ; ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
                           && !nilp( b ); i++ ) {
                         a_buff[i] = cell_a->payload.string.character;
                         a = c_cdr( a );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index e064ac4..39e121f 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -270,54 +270,81 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
 // (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
 
 /**
- * Implementation of interned? in C. The final implementation if interned? will
- * deal with stores which can be association lists or hashtables or hybrids of
- * the two, but that will almost certainly be implemented in lisp.
- *
  * If this key is lexically identical to a key in this store, return the key
  * from the store (so that later when we want to retrieve a value, an eq test
  * will work); otherwise return NIL.
  */
-struct cons_pointer
-internedp( struct cons_pointer key, struct cons_pointer store ) {
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        // TODO: I see what I was doing here and it would be the right thing to 
-        // do for stores which are old-fashioned assoc lists, but it will not work
-        // for my new hybrid stores.
-        // for ( struct cons_pointer next = store;
-        //       nilp( result ) && consp( next );
-        //       next = pointer2cell( next ).payload.cons.cdr ) {
-        //     struct cons_space_object entry =
-        //         pointer2cell( pointer2cell( next ).payload.cons.car );
+        struct cons_space_object *cell = &pointer2cell( store );
 
-        //     debug_print( L"Internedp: checking whether `", DEBUG_BIND );
-        //     debug_print_object( key, DEBUG_BIND );
-        //     debug_print( L"` equals `", DEBUG_BIND );
-        //     debug_print_object( entry.payload.cons.car, DEBUG_BIND );
-        //     debug_print( L"`\n", DEBUG_BIND );
+        switch ( cell->tag.value ) {
+            case CONSTV:
+                for ( struct cons_pointer next = store;
+                      nilp( result ) && consp( next );
+                      next = c_cdr( next) ) {
+                    if ( !nilp( next ) ) {
+                        // struct cons_space_object entry =
+                        //     pointer2cell( c_car( next) );
 
-        //     if ( equal( key, entry.payload.cons.car ) ) {
-        //         result = entry.payload.cons.car;
-        //     }
-        if ( !nilp( c_assoc( key, store ) ) ) {
-            result = key;
-        } else if ( equal( key, privileged_symbol_nil ) ) {
-            result = privileged_symbol_nil;
+                        if ( equal( key, c_car(next) ) ) {
+                            result = key;
+                        }
+                    }
+                }
+                break;
+            case VECTORPOINTTV:
+                if ( hashmapp( store ) || namespacep( store ) ) {
+                    // get the right hash bucket and recursively call interned on that.
+                    struct vector_space_object *map = pointer_to_vso( store );
+                    uint32_t bucket_no =
+                        get_hash( key ) % map->payload.hashmap.n_buckets;
+
+                    result =
+                        interned( key,
+                                  map->payload.hashmap.buckets[bucket_no] );
+                } else {
+                    result =
+                        throw_exception( make_cons
+                                         ( c_string_to_lisp_string
+                                           ( L"Unexpected store type: " ),
+                                           c_type( store ) ), NIL );
+                }
+                break;
+            default:
+                result =
+                    throw_exception( make_cons
+                                     ( c_string_to_lisp_string
+                                       ( L"Unexpected store type: " ),
+                                       c_type( store ) ), NIL );
+                break;
         }
     } else {
-        debug_print( L"`", DEBUG_BIND );
-        debug_print_object( key, DEBUG_BIND );
-        debug_print( L"` is a ", DEBUG_BIND );
-        debug_printf( DEBUG_BIND, L"%4.4s",
-                      ( char * ) pointer2cell( key ).tag.bytes );
-        debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
+        result =
+            throw_exception( make_cons
+                             ( c_string_to_lisp_string
+                               ( L"Unexpected key type: " ), c_type( key ) ),
+                             NIL );
     }
 
     return result;
 }
 
+/**
+ * @brief Implementation of `interned?` in C: predicate wrapped around interned.
+ * 
+ * @param key the key to search for.
+ * @param store the store to search in.
+ * @return struct cons_pointer `t` if the key was found, else `nil`.
+ */
+struct cons_pointer internedp( struct cons_pointer key,
+                               struct cons_pointer store ) {
+    return nilp( interned( key, store ) ) ? NIL : TRUE;
+}
+
 /**
  * Implementation of assoc in C. Like interned?, the final implementation will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -370,7 +397,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 // #endif
                 }
             }
-        } else if ( hashmapp( store ) ) {
+        } else if ( hashmapp( store ) || namespacep( store ) ) {
             result = hashmap_get( store, key );
         } else if ( !nilp( store ) ) {
 // #ifdef DEBUG        
@@ -426,7 +453,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = vectorpointp( store );
+    bool deep = eq( store, oblist);
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -480,7 +507,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound
+         * not currently bound. TODO: should this bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/intern.h b/src/ops/intern.h
index bc22bf7..4043e66 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -49,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer environment );
+
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 7333c3f..be4227b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -517,8 +517,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
         case SYMBOLTV:
             {
-                struct cons_pointer canonical =
-                    internedp( frame->arg[0], env );
+                struct cons_pointer canonical = interned( frame->arg[0], env );
                 if ( nilp( canonical ) ) {
                     struct cons_pointer message =
                         make_cons( c_string_to_lisp_string
@@ -835,7 +834,35 @@ struct cons_pointer lisp_length( struct stack_frame *frame,
 struct cons_pointer
 lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    return c_assoc( frame->arg[0], frame->arg[1] );
+    return c_assoc( frame->arg[0],
+                    nilp( frame->arg[1] ) ? oblist : frame->arg[1] );
+}
+
+/**
+ * @brief `(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.
+ * 
+ * @param frame 
+ * @param frame_pointer 
+ * @param env 
+ * @return struct cons_pointer 
+ */
+struct cons_pointer
+lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                struct cons_pointer env ) {
+    struct cons_pointer result = internedp( frame->arg[0],
+                                            nilp( frame->
+                                                  arg[1] ) ? oblist : frame->
+                                            arg[1] );
+
+    if ( exceptionp( result ) ) {
+        struct cons_pointer old = result;
+        struct cons_space_object *cell = &( pointer2cell( result ) );
+        result =
+            throw_exception( cell->payload.exception.payload, frame_pointer );
+        dec_ref( old );
+    }
+
+    return result;
 }
 
 struct cons_pointer c_keys( struct cons_pointer store ) {
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index aea8772..06407c2 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -131,6 +131,9 @@ struct cons_pointer lisp_cdr( struct stack_frame *frame,
 struct cons_pointer lisp_inspect( struct stack_frame *frame,
                                   struct cons_pointer frame_pointer,
                                   struct cons_pointer env );
+struct cons_pointer lisp_internedp( struct stack_frame *frame,
+                                    struct cons_pointer frame_pointer,
+                                    struct cons_pointer env );
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env );

From 54f6f023c63035567ca88e89ab398d0a970f1b67 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 28 Feb 2026 12:24:59 +0000
Subject: [PATCH 73/90] More debugging output. Getting desperate!

---
 src/io/io.c       |  4 ++--
 src/memory/dump.c |  8 ++++----
 src/ops/intern.c  | 39 ++++++++++++++++++++-------------------
 src/ops/lispops.c | 24 ++++++++++--------------
 4 files changed, 36 insertions(+), 39 deletions(-)

diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 39e121f..5a81fb3 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -278,19 +278,22 @@ struct cons_pointer interned( struct cons_pointer key,
                               struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
+    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     if ( symbolp( key ) || keywordp( key ) ) {
         struct cons_space_object *cell = &pointer2cell( store );
 
         switch ( cell->tag.value ) {
             case CONSTV:
                 for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next );
-                      next = c_cdr( next) ) {
+                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
                     if ( !nilp( next ) ) {
                         // struct cons_space_object entry =
                         //     pointer2cell( c_car( next) );
 
-                        if ( equal( key, c_car(next) ) ) {
+                        if ( equal( key, c_car( next ) ) ) {
                             result = key;
                         }
                     }
@@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key,
                              NIL );
     }
 
+    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     return result;
 }
 
@@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
+    debug_print(L"hashmap_put:\n", DEBUG_BIND);
+    debug_dump_object( mapp, DEBUG_BIND);
+
     return mapp;
 }
 
-    /**
-     * Return a new key/value store containing all the key/value pairs in this
-     * store with this key/value pair added to the front.
-     */
+/**
+ * If this store is modifiable, add this key value pair to it. Otherwise,
+ * return a new key/value store containing all the key/value pairs in this
+ * store with this key/value pair added to the front.
+ */
 struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                          struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = eq( store, oblist);
+    bool deep = eq( store, oblist );
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                       pointer2cell( store ).payload.vectorp.tag.bytes );
     }
 #endif
-    if ( nilp( value ) ) {
-        result = store;
-    } else if ( nilp( store ) || consp( store ) ) {
+    if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
         result = hashmap_put( store, key, value );
@@ -479,16 +488,8 @@ struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     debug_print( L"Entering deep_bind\n", DEBUG_BIND );
 
-    struct cons_pointer old = oblist;
-
     oblist = set( key, value, oblist );
 
-    // The oblist is not now an assoc list, and I don't think it will be again.
-    // if ( consp( oblist ) ) {
-    //     inc_ref( oblist );
-    //     dec_ref( old );
-    // }
-
     debug_print( L"deep_bind returning ", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
     debug_println( DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index be4227b..4a89d98 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.
-                              special.executable ) ( get_stack_frame
-                                                     ( next_pointer ),
-                                                     next_pointer, env );
+                            ( *fn_cell.payload.special.
+                              executable ) ( get_stack_frame( next_pointer ),
+                                             next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -850,9 +849,8 @@ struct cons_pointer
 lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer result = internedp( frame->arg[0],
-                                            nilp( frame->
-                                                  arg[1] ) ? oblist : frame->
-                                            arg[1] );
+                                            nilp( frame->arg[1] ) ? oblist :
+                                            frame->arg[1] );
 
     if ( exceptionp( result ) ) {
         struct cons_pointer old = result;
@@ -1313,8 +1311,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1497,14 +1494,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From a1c377bc7c7ded8b175a346e9028212db418bc51 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 28 Feb 2026 15:15:42 +0000
Subject: [PATCH 74/90] Established intern bug is in getting, not setting;
 improved exceptions.

---
 src/arith/peano.c            |  36 ++++--
 src/arith/ratio.c            |  16 ++-
 src/init.c                   |  10 +-
 src/io/read.c                |  15 ++-
 src/memory/consspaceobject.c |  14 +++
 src/memory/consspaceobject.h |  17 +++
 src/ops/intern.c             |  21 ++--
 src/ops/lispops.c            | 206 ++++++++++++++++++++++++-----------
 src/ops/lispops.h            |   3 +-
 9 files changed, 241 insertions(+), 97 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 995ce0f..3e85412 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,7 +296,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -319,7 +320,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -332,7 +334,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -428,7 +431,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -454,7 +458,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -467,7 +472,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -620,7 +626,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -650,7 +657,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -661,7 +669,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -732,7 +741,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -762,7 +772,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -774,7 +785,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 1c20a4f..011ef43 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,7 +114,9 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( make_cons( c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( 
+                            c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -154,7 +156,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -234,7 +237,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -269,7 +273,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -337,7 +342,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
+                            c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 5febcbc..8c8da7c 100644
--- a/src/init.c
+++ b/src/init.c
@@ -84,12 +84,18 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
+    // we can't make this string when we need it, because memory is then 
+    // exhausted!
     if ( nilp( privileged_string_memory_exhausted ) ) {
-        // we can't make this string when we need it, because memory is then 
-        // exhausted!
         privileged_string_memory_exhausted =
             c_string_to_lisp_string( L"Memory exhausted." );
     }
+    if ( nilp( privileged_keyword_location ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
+    }
+    if ( nilp( privileged_keyword_payload ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/io/read.c b/src/io/read.c
index 9ca49f0..5ffb143 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,7 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -177,7 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -266,7 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception( make_cons( c_string_to_lisp_string
+                        throw_exception(c_string_to_lisp_symbol( L"read"),
+                             make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -313,7 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -324,7 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8c4c5c0..c461f10 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -27,6 +27,20 @@
 #include "memory/vectorspace.h"
 #include "ops/intern.h"
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`q.v.
+ */
+struct cons_pointer privileged_keyword_location = NIL;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`, q.v.
+ */
+struct cons_pointer privileged_keyword_payload = NIL;
+
+
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index adde136..bddd232 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -56,6 +56,18 @@
  */
 #define EXCEPTIONTV 1346721861
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_location;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_payload;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
@@ -296,6 +308,11 @@
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
+
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 5a81fb3..2764bae 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,7 +311,8 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( make_cons
+                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                          ( c_string_to_lisp_string
                                            ( L"Unexpected store type: " ),
                                            c_type( store ) ), NIL );
@@ -319,7 +320,8 @@ struct cons_pointer interned( struct cons_pointer key,
                 break;
             default:
                 result =
-                    throw_exception( make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -327,7 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -389,7 +392,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_append
+                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
+                            c_append
                                              ( c_string_to_lisp_string
                                                ( L"Store entry is of unknown type: " ),
                                                c_type( entry_ptr ) ), NIL );
@@ -413,7 +417,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_append
+                throw_exception( c_string_to_lisp_symbol(L"assoc"),
+                    c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
@@ -448,8 +453,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
-    debug_print(L"hashmap_put:\n", DEBUG_BIND);
-    debug_dump_object( mapp, DEBUG_BIND);
+    debug_print( L"hashmap_put:\n", DEBUG_BIND );
+    debug_dump_object( mapp, DEBUG_BIND );
 
     return mapp;
 }
@@ -508,7 +513,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound. TODO: should this bind to NIL?
+         * not currently bound. TODO: this should bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4a89d98..3cb0287 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -248,7 +248,7 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * Evaluate a lambda or nlambda expression.
  */
 struct cons_pointer
-eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
+eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
              struct cons_pointer frame_pointer, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
 #ifdef DEBUG
@@ -257,8 +257,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 #endif
 
     struct cons_pointer new_env = env;
-    struct cons_pointer names = cell.payload.lambda.args;
-    struct cons_pointer body = cell.payload.lambda.body;
+    struct cons_pointer names = cell->payload.lambda.args;
+    struct cons_pointer body = cell->payload.lambda.body;
 
     if ( consp( names ) ) {
         /* if `names` is a list, bind successive items from that list
@@ -328,6 +328,57 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
     return result;
 }
 
+/**
+ * if `r` is an exception, and it doesn't have a location, fix up its location from
+ * the name associated with this fn_pointer, if any. 
+ */
+struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
+                                                    struct cons_pointer
+                                                    fn_pointer ) {
+    struct cons_pointer result = r;
+        
+    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
+
+        struct cons_pointer payload =
+            pointer2cell( result ).payload.exception.payload;
+        /* TODO: should name_key also be a privileged keyword? */
+        struct cons_pointer name_key =
+                        c_string_to_lisp_keyword( L"name" );
+
+        switch ( get_tag_value( payload ) ) {
+            case NILTV:
+            case CONSTV:
+            case HASHTV:
+                {
+                    if ( nilp( c_assoc( privileged_keyword_location ,
+                           payload ) )) {
+                        pointer2cell( result ).payload.exception.payload =
+                            set( privileged_keyword_location,
+                                    c_assoc( name_key,
+                                             fn_cell->payload.function.meta ),
+                                    payload );
+                    }
+                }
+                break;
+            default:
+                pointer2cell( result ).payload.exception.payload =
+                    make_cons( 
+                        make_cons( privileged_keyword_location,
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ) ),
+                               make_cons( 
+                                    make_cons( privileged_keyword_payload,
+                                            payload ) , 
+                                            NIL ));
+        }
+
+        dec_ref( name_key);
+    }
+
+    return result;
+}
+
 
 /**
  * Internal guts of apply.
@@ -348,10 +399,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( exceptionp( fn_pointer ) ) {
         result = fn_pointer;
     } else {
-        struct cons_space_object fn_cell = pointer2cell( fn_pointer );
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
         struct cons_pointer args = c_cdr( frame->arg[0] );
 
-        switch ( fn_cell.tag.value ) {
+        switch ( get_tag_value( fn_pointer ) ) {
             case EXCEPTIONTV:
                 /* just pass exceptions straight back */
                 result = fn_pointer;
@@ -369,10 +420,15 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         struct stack_frame *next =
                             get_stack_frame( next_pointer );
 
-                        result =
-                            ( *fn_cell.payload.function.executable ) ( next,
-                                                                       next_pointer,
-                                                                       env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
+                                                                 ( next,
+                                                                   next_pointer,
+                                                                   env ),
+                                                                 fn_pointer );
                         dec_ref( next_pointer );
                     }
                 }
@@ -406,18 +462,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 }
                 break;
 
-            case VECTORPOINTTV:
-                switch ( pointer_to_vso( fn_pointer )->header.tag.value ) {
-                    case HASHTV:
-                        /* \todo: if arg[0] is a CONS, treat it as a path */
-                        result = c_assoc( eval_form( frame,
-                                                     frame_pointer,
-                                                     c_car( c_cdr
-                                                            ( frame->arg
-                                                              [0] ) ), env ),
-                                          fn_pointer );
-                        break;
-                }
+            case HASHTV:
+                /* \todo: if arg[0] is a CONS, treat it as a path */
+                result = c_assoc( eval_form( frame,
+                                             frame_pointer,
+                                             c_car( c_cdr
+                                                    ( frame->arg
+                                                      [0] ) ), env ),
+                                  fn_pointer );
                 break;
 
             case NLAMBDATV:
@@ -441,14 +493,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+                    // inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
-                        result =
-                            ( *fn_cell.payload.special.
-                              executable ) ( get_stack_frame( next_pointer ),
-                                             next_pointer, env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
+                                                                 ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -464,13 +518,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     memset( buffer, '\0', bs );
                     swprintf( buffer, bs,
                               L"Unexpected cell with tag %d (%4.4s) in function position",
-                              fn_cell.tag.value, &fn_cell.tag.bytes[0] );
+                              fn_cell->tag.value, &( fn_cell->tag.bytes[0] ) );
                     struct cons_pointer message =
                         c_string_to_lisp_string( buffer );
                     free( buffer );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"apply" ),
+                                         message, frame_pointer );
                 }
         }
+
     }
 
     debug_print( L"c_apply: returning: ", DEBUG_EVAL );
@@ -507,9 +564,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
     debug_dump_object( frame_pointer, DEBUG_EVAL );
 
     struct cons_pointer result = frame->arg[0];
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
             result = c_apply( frame, frame_pointer, env );
             break;
@@ -522,7 +579,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         make_cons( c_string_to_lisp_string
                                    ( L"Attempt to take value of unbound symbol." ),
                                    frame->arg[0] );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"eval" ),
+                                         message, frame_pointer );
                 } else {
                     result = c_assoc( canonical, env );
                     inc_ref( result );
@@ -623,7 +682,8 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = frame->arg[1];
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -662,7 +722,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = val;
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set!" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set!` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -734,24 +795,25 @@ struct cons_pointer
 lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.car;
+            result = cell->payload.cons.car;
             break;
         case NILTV:
             break;
         case READTV:
             result =
-                make_string( url_fgetwc( cell.payload.stream.stream ), NIL );
+                make_string( url_fgetwc( cell->payload.stream.stream ), NIL );
             break;
         case STRINGTV:
-            result = make_string( cell.payload.string.character, NIL );
+            result = make_string( cell->payload.string.character, NIL );
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"car" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CAR of non sequence" ),
                                  frame_pointer );
     }
@@ -778,24 +840,25 @@ struct cons_pointer
 lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.cdr;
+            result = cell->payload.cons.cdr;
             break;
         case NILTV:
             break;
         case READTV:
-            url_fgetwc( cell.payload.stream.stream );
+            url_fgetwc( cell->payload.stream.stream );
             result = frame->arg[0];
             break;
         case STRINGTV:
-            result = cell.payload.string.cdr;
+            result = cell->payload.string.cdr;
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"cdr" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CDR of non sequence" ),
                                  frame_pointer );
     }
@@ -856,7 +919,8 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
         struct cons_pointer old = result;
         struct cons_space_object *cell = &( pointer2cell( result ) );
         result =
-            throw_exception( cell->payload.exception.payload, frame_pointer );
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             cell->payload.exception.payload, frame_pointer );
         dec_ref( old );
     }
 
@@ -1213,7 +1277,8 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
 #endif
         }
     } else {
-        result = throw_exception( c_string_to_lisp_string
+        result = throw_exception( c_string_to_lisp_symbol( L"cond" ),
+                                  c_string_to_lisp_string
                                   ( L"Arguments to `cond` must be lists" ),
                                   frame_pointer );
     }
@@ -1271,18 +1336,25 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * pointer to the frame in which the exception occurred.
  */
 struct cons_pointer
-throw_exception( struct cons_pointer message,
+throw_exception( struct cons_pointer location,
+                 struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
     debug_print( L"\nERROR: ", DEBUG_EVAL );
     debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
-    struct cons_space_object cell = pointer2cell( message );
+    struct cons_space_object *cell = &pointer2cell( message );
 
-    if ( cell.tag.value == EXCEPTIONTV ) {
+    if ( cell->tag.value == EXCEPTIONTV ) {
         result = message;
     } else {
-        result = make_exception( message, frame_pointer );
+        result =
+            make_exception( make_cons
+                            ( make_cons( privileged_keyword_location,
+                                         location ),
+                              make_cons( make_cons
+                                         ( privileged_keyword_payload,
+                                           message ), NIL ) ), frame_pointer );
     }
 
     return result;
@@ -1295,7 +1367,7 @@ throw_exception( struct cons_pointer message,
  * normally return. A function which detects a problem it cannot resolve
  * *should* return an exception.
  *
- * * (exception message frame)
+ * * (exception message location)
  *
  * @param frame my stack frame.
  * @param frame_pointer a pointer to my stack_frame.
@@ -1310,7 +1382,9 @@ struct cons_pointer
 lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
+
     return exceptionp( message ) ? message : throw_exception( message,
+                                                              frame->arg[1],
                                                               frame->previous );
 }
 
@@ -1444,24 +1518,24 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
                                  struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
     struct cons_pointer source_key = c_string_to_lisp_keyword( L"source" );
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case FUNCTIONTV:
-            result = c_assoc( source_key, cell.payload.function.meta );
+            result = c_assoc( source_key, cell->payload.function.meta );
             break;
         case SPECIALTV:
-            result = c_assoc( source_key, cell.payload.special.meta );
+            result = c_assoc( source_key, cell->payload.special.meta );
             break;
         case LAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"lambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
         case NLAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"nlambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
     }
     // \todo suffers from premature GC, and I can't see why!
@@ -1484,7 +1558,8 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                       c_append( c_cdr( l1 ), l2 ) );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
@@ -1505,12 +1580,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                                 pointer2cell( l1 ).tag.value );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
         default:
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"append" ),
+                             c_string_to_lisp_string
                              ( L"Can't append: not a sequence" ), NIL );
             break;
     }
@@ -1622,7 +1699,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
             bindings = make_cons( make_cons( symbol, val ), bindings );
         } else {
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"let" ),
+                                 c_string_to_lisp_string
                                  ( L"Let: cannot bind, not a symbol" ),
                                  frame_pointer );
             break;
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 06407c2..da2428a 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -196,7 +196,8 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
  * signature of a lisp function; but it is nevertheless to be preferred to
  * make_exception. A real `throw_exception`, which does, will be needed.
  */
-struct cons_pointer throw_exception( struct cons_pointer message,
+struct cons_pointer throw_exception( struct cons_pointer location,
+                                     struct cons_pointer message,
                                      struct cons_pointer frame_pointer );
 
 struct cons_pointer lisp_exception( struct stack_frame *frame,

From bcb227a5f99b172b48e629dd88941f5eebdcf21b Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 28 Feb 2026 18:09:48 +0000
Subject: [PATCH 75/90] Still not working, but I have increasing confidence I'm
 on the right track.

---
 src/arith/peano.c            | 58 +++++++++++++++++++-----------------
 src/arith/ratio.c            | 21 +++++++------
 src/init.c                   |  5 +++-
 src/io/io.c                  |  4 +--
 src/io/read.c                | 20 ++++++-------
 src/memory/consspaceobject.c |  8 ++---
 src/memory/dump.c            |  8 ++---
 src/memory/stack.c           |  4 +++
 src/ops/intern.c             | 33 ++++++++++----------
 src/ops/lispops.c            | 57 ++++++++++++++++-------------------
 10 files changed, 110 insertions(+), 108 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 3e85412..9a1b478 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,10 +296,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -320,10 +321,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -334,8 +336,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                     c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -431,8 +433,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -458,8 +460,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -472,8 +474,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                          make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -626,8 +628,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -657,8 +659,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -669,8 +671,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -741,8 +743,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -772,8 +774,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -785,8 +787,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 011ef43..82f9138 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,9 +114,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( 
-                            c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -156,8 +155,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -237,8 +236,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -273,8 +272,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -342,8 +341,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio" ),
+                             c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 8c8da7c..04eeeed 100644
--- a/src/init.c
+++ b/src/init.c
@@ -293,6 +293,8 @@ int main( int argc, char *argv[] ) {
      */
     bind_symbol_value( privileged_symbol_nil, NIL, true );
     bind_value( L"t", TRUE, true );
+    bind_symbol_value( privileged_keyword_location, TRUE, true );
+    bind_symbol_value( privileged_keyword_payload, TRUE, true );
 
     /*
      * standard input, output, error and sink streams
@@ -413,7 +415,8 @@ int main( int argc, char *argv[] ) {
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
-    bind_function( L"list", L"`(list args...): Return a list of these `args`.",
+    bind_function( L"list",
+                   L"`(list args...)`: Return a list of these `args`.",
                    &lisp_list );
     bind_function( L"mapcar",
                    L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.",
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/io/read.c b/src/io/read.c
index 5ffb143..fee80b3 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,8 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read" ),
+                             c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -178,8 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                          c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -268,8 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception(c_string_to_lisp_symbol( L"read"),
-                             make_cons( c_string_to_lisp_string
+                        throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                         make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -316,8 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -328,8 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index c461f10..2848b83 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -39,8 +39,6 @@ struct cons_pointer privileged_keyword_location = NIL;
  */
 struct cons_pointer privileged_keyword_payload = NIL;
 
-
-
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
@@ -49,11 +47,11 @@ struct cons_pointer privileged_keyword_payload = NIL;
 bool check_tag( struct cons_pointer pointer, uint32_t value ) {
     bool result = false;
 
-    struct cons_space_object cell = pointer2cell( pointer );
-    result = cell.tag.value == value;
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    result = cell->tag.value == value;
 
     if ( result == false ) {
-        if ( cell.tag.value == VECTORPOINTTV ) {
+        if ( cell->tag.value == VECTORPOINTTV ) {
             struct vector_space_object *vec = pointer_to_vso( pointer );
 
             if ( vec != NULL ) {
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index b6833c9..7f5d581 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -161,6 +161,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                                 env );
                 frame->more = more;
                 inc_ref( more );
+
+                for ( ; !nilp( args ); args = c_cdr( args ) ) {
+                    frame->args++;
+                }
             }
         }
         debug_print( L"make_stack_frame: returning\n", DEBUG_STACK );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 2764bae..ee15485 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,17 +311,17 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
-                                         ( c_string_to_lisp_string
-                                           ( L"Unexpected store type: " ),
-                                           c_type( store ) ), NIL );
+                        throw_exception( c_string_to_lisp_symbol
+                                         ( L"interned?" ),
+                                         make_cons( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( store ) ), NIL );
                 }
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                                     make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -329,8 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -392,11 +392,12 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
-                            c_append
-                                             ( c_string_to_lisp_string
-                                               ( L"Store entry is of unknown type: " ),
-                                               c_type( entry_ptr ) ), NIL );
+                            throw_exception( c_string_to_lisp_symbol
+                                             ( L"assoc" ),
+                                             c_append( c_string_to_lisp_string
+                                                       ( L"Store entry is of unknown type: " ),
+                                                       c_type( entry_ptr ) ),
+                                             NIL );
                     }
 
 // #ifdef DEBUG
@@ -417,8 +418,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_string_to_lisp_symbol(L"assoc"),
-                    c_append
+                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
+                                 c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 3cb0287..98497f6 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -336,44 +336,43 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                                                     struct cons_pointer
                                                     fn_pointer ) {
     struct cons_pointer result = r;
-        
-    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+
+    if ( exceptionp( result )
+         && ( functionp( fn_pointer ) || specialp( fn_pointer ) ) ) {
         struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
 
         struct cons_pointer payload =
             pointer2cell( result ).payload.exception.payload;
         /* TODO: should name_key also be a privileged keyword? */
-        struct cons_pointer name_key =
-                        c_string_to_lisp_keyword( L"name" );
+        struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
 
         switch ( get_tag_value( payload ) ) {
             case NILTV:
             case CONSTV:
             case HASHTV:
                 {
-                    if ( nilp( c_assoc( privileged_keyword_location ,
-                           payload ) )) {
+                    if ( nilp( c_assoc( privileged_keyword_location,
+                                        payload ) ) ) {
                         pointer2cell( result ).payload.exception.payload =
                             set( privileged_keyword_location,
-                                    c_assoc( name_key,
-                                             fn_cell->payload.function.meta ),
-                                    payload );
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ),
+                                 payload );
                     }
                 }
                 break;
             default:
                 pointer2cell( result ).payload.exception.payload =
-                    make_cons( 
-                        make_cons( privileged_keyword_location,
-                                 c_assoc( name_key,
-                                          fn_cell->payload.function.meta ) ),
-                               make_cons( 
-                                    make_cons( privileged_keyword_payload,
-                                            payload ) , 
-                                            NIL ));
+                    make_cons( make_cons( privileged_keyword_location,
+                                          c_assoc( name_key,
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
+                               make_cons( make_cons
+                                          ( privileged_keyword_payload,
+                                            payload ), NIL ) );
         }
 
-        dec_ref( name_key);
+        dec_ref( name_key );
     }
 
     return result;
@@ -421,10 +420,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -498,10 +494,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1385,7 +1378,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1569,13 +1563,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 3a1f64d7ffc17bc5b2a1b1d0bd187d073d336693 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 1 Mar 2026 20:04:21 +0000
Subject: [PATCH 76/90] Well, I'm back to the same failed unit tests as the
 develop branch

and I *feel* that the intern code is better. But it's not without
problems and I don't think I can release at this. But it may be
ready to merge back.
---
 docs/Interning-strings.md    |  44 +++----
 lisp/documentation.lisp      |  29 +++++
 src/debug.c                  |  19 +++
 src/debug.h                  |   1 +
 src/init.c                   |   2 +-
 src/io/io.c                  |   4 +-
 src/io/print.c               |   2 +-
 src/memory/conspage.c        |   5 +-
 src/memory/consspaceobject.c |  31 +++--
 src/memory/consspaceobject.h |  10 +-
 src/memory/dump.c            |   8 +-
 src/ops/equal.c              |   4 +-
 src/ops/intern.c             | 227 ++++++++++++++++++-----------------
 src/ops/intern.h             |  11 +-
 src/ops/lispops.c            |  71 ++++++++---
 15 files changed, 284 insertions(+), 184 deletions(-)

diff --git a/docs/Interning-strings.md b/docs/Interning-strings.md
index b92ded5..af135a1 100644
--- a/docs/Interning-strings.md
+++ b/docs/Interning-strings.md
@@ -12,58 +12,50 @@ causes an unbound variable exception to be thrown, while
 
 returns the value **"froboz"**. This begs the question of whether there's any difference between **"froboz"** and **'froboz**, and the answer is that at this point I don't know.
 
-There will be a concept of a root [namespace](Namespace.html), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
+There will be a concept of a root [namespace](Namespace.md), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
 
 There must be some notation to say distinguish a request for the value of a name in the root namespace and the value of a name in the current namespace. For now I'm proposing that:
 
-    (eval froboz)
+    (eval 'froboz)
 
 will return the value that **froboz** is bound to in the current namespace;
 
-    (eval .froboz)
+    (eval ::/froboz)
 
 will return the value that **froboz** is bound to in the root namespace;
 
-    (eval foobar.froboz)
+    (eval 'foobar/froboz)
 
 will return the value that **froboz** is bound to in a namespace which is the value of the name **foobar** in the current namespace; and that
 
-    (eval .system.users.simon.environment.froboz)
+    (eval ::users:simon:environment/froboz)
 
-will return the value that **froboz** is bound to in the environment of the user of the system called **simon**.
+will return the value that **froboz** is bound to in the environment of the user of the system called **simon** (if that is readable by you).
 
-The exact path separator syntax may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
+The [exact path separator syntax](Paths.md) may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
 
-Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.html) of individual path elements.
+Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.md) of individual path elements.
 
 Obviously this means there may be arbitrarily many paths which reference the same data item. This is intended.
 
 ## Related functions
 
-### (intern! string)
+### (intern! path)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
-### (intern! string T)
+### (intern! path T)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
-### (intern! string T write-access-list)
-
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [access control](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **:friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
 ### (set! string value)
 
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
 ### (set! string value T)
 
 Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
-### (set! string value T write-access-list)
-
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [access control](Access-control.html) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
 ### (put! string token value)
 
 Considers *string* as the path to some namespace, and binds *token* in that namespace to *value*. *Token* should not contain any path separator syntax. If the namespace doesn't exist or if the current user is not entitled to write to the namespace, throws an exception.
@@ -71,16 +63,16 @@ Considers *string* as the path to some namespace, and binds *token* in that name
 ### (string-to-path string)
 
 Behaviour as follows:
-    (string-to-path "foo.bar.ban") => ("foo" "bar" "ban")
-    (string-to-path ".foo.bar.ban") => ("" "foo" "bar" "ban")
+    (string-to-path ":foo:bar/ban") => (-> (environment) :foo :bar 'ban)
+    (string-to-path "::foo:bar/ban") => (-> (oblist) :foo :bar 'ban)
 
-Obviously if the current user can't read the string, throws an exception.
+Obviously if the current user can't read the string, throws an exception. `(oblist)` is currently (version 0.0.6) a function which returns the current value of the root namespace; `(environment)` is a proposed function which returns the current value of the environment of current user (with possibly `(environmnt user-name)` returning the value of the environment of the user indicated by `user-name`, if that is readable by you). The symbol `->` represents a threading macro [similar to Clojure's](https://clojuredocs.org/clojure.core/-%3E).
 
 ### (path-to-string list-of-strings)
 
 Behaviour as follows:
-    (path-to-string '("foo" "bar" "ban")) => "foo.bar.ban"
-    (path-to-string '("" "foo" "bar" "ban")) => ".foo.bar.ban"
+    (path-to-string '(:foo :bar 'ban)) => ":foo:bar/ban"
+    (path-to-string '("" :foo :bar 'ban)) => "::foo:bar/ban"
 
 Obviously if the current user can't read some element of *list-of-strings*, throws an exception.
 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 33fd1e5..7f5867b 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -3,6 +3,31 @@
 ;; `nth` (from `nth.lisp`)
 ;; `string?` (from `types.lisp`)
 
+(set! nil? (lambda 
+          (o) 
+          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
+          (= o nil)))
+
+(set! member? (lambda
+            (item collection)
+            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+            ;; (print (list "In member? item is " item "; collection is " collection))
+            ;; (println)
+            (cond
+              ((= nil collection) nil)
+              ((= item (car collection)) t)
+              (t (member? item (cdr collection))))))
+
+;; (member? (type member?) '("LMDA" "NLMD"))
+
+(set! nth (lambda (n l) 
+    "Return the `n`th member of this list `l`, or `nil` if none."
+    (cond ((= nil l) nil)
+        ((= n 1) (car l))
+        (t (nth (- n 1) (cdr l))))))
+
+(set! string? (lambda (o) "True if `o` is a string." (= (type o) "STRG") ) )
+
 (set! documentation (lambda (object)
     "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
    (cond ((member? (type object) '("FUNC" "SPFM"))
@@ -15,3 +40,7 @@
 
 (set! doc documentation)
 
+(documentation apply)
+
+;; (documentation member?)
+
diff --git a/src/debug.c b/src/debug.c
index 1b895c2..631149d 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -32,6 +32,25 @@
  */
 int verbosity = 0;
 
+/**
+ * When debugging, we want to see exceptions as they happen, because they may
+ * not make their way back down the stack to whatever is expected to handle
+ * them.
+ */
+void debug_print_exception( struct cons_pointer ex_ptr ) {
+#ifdef DEBUG
+    if ( ( verbosity != 0 ) && exceptionp( ex_ptr ) ) {
+        fwide( stderr, 1 );
+        fputws( L"EXCEPTION: ", stderr );
+
+        URL_FILE *ustderr = file_to_url_file( stderr );
+        fwide( stderr, 1 );
+        print( ustderr, ex_ptr );
+        free( ustderr );
+    }
+#endif
+}
+
 /**
  * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
  *
diff --git a/src/debug.h b/src/debug.h
index ef3799d..2e59932 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -81,6 +81,7 @@
 
 extern int verbosity;
 
+void debug_print_exception( struct cons_pointer ex_ptr );
 void debug_print( wchar_t *message, int level );
 void debug_print_128bit( __int128_t n, int level );
 void debug_println( int level );
diff --git a/src/init.c b/src/init.c
index 04eeeed..74b6d94 100644
--- a/src/init.c
+++ b/src/init.c
@@ -325,7 +325,7 @@ int main( int argc, char *argv[] ) {
                                                   ( c_string_to_lisp_keyword
                                                     ( L"url" ),
                                                     c_string_to_lisp_string
-                                                    ( L"system:standard output]" ) ),
+                                                    ( L"system:standard output" ) ),
                                                   NIL ) ), false );
     bind_value( L"*log*",
                 make_write_stream( file_to_url_file( stderr ),
diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/io/print.c b/src/io/print.c
index fdd6ed4..a8f2770 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -101,7 +101,7 @@ void print_map( URL_FILE *output, struct cons_pointer map ) {
             struct cons_pointer key = c_car( ks );
             print( output, key );
             url_fputwc( btowc( ' ' ), output );
-            print( output, hashmap_get( map, key ) );
+            print( output, hashmap_get( map, key, false ) );
 
             if ( !nilp( c_cdr( ks ) ) ) {
                 url_fputws( L", ", output );
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index d7d5cd0..3d96647 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -250,8 +250,9 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
             total_cells_allocated++;
 
             debug_printf( DEBUG_ALLOC,
-                          L"Allocated cell of type '%4.4s' at %d, %d \n",
-                          cell->tag.bytes, result.page, result.offset );
+                          L"Allocated cell of type %4.4s at %u, %u \n",
+                          ( ( char * ) cell->tag.bytes ), result.page,
+                          result.offset );
         } else {
             debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
         }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 2848b83..3d8fe78 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -78,7 +78,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
         cell->count++;
 #ifdef DEBUG
         debug_printf( DEBUG_ALLOC,
-                      L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d",
+                      L"\nIncremented cell of type %4.4s at page %u, offset %u to count %u",
                       ( ( char * ) cell->tag.bytes ), pointer.page,
                       pointer.offset, cell->count );
         if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
@@ -131,6 +131,19 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
     return pointer;
 }
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer ) {
+    uint32_t result = pointer2cell( pointer ).tag.value;
+
+    if ( result == VECTORPOINTTV ) {
+        result = pointer_to_vso( pointer )->header.tag.value;
+    }
+
+    return result;
+}
+
 /**
  * Get the Lisp type of the single argument.
  * @param pointer a pointer to the object whose type is requested.
@@ -399,15 +412,15 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
     if ( tag == SYMBOLTV || tag == KEYTV ) {
         result = make_string_like_thing( c, tail, tag );
 
-        if ( tag == KEYTV ) {
-            struct cons_pointer r = interned( result, oblist );
+        // if ( tag == KEYTV ) {
+        //     struct cons_pointer r = interned( result, oblist );
 
-            if ( nilp( r ) ) {
-                intern( result, oblist );
-            } else {
-                result = r;
-            }
-        }
+        //     if ( nilp( r ) ) {
+        //         intern( result, oblist );
+        //     } else {
+        //         result = r;
+        //     }
+        // }
     } else {
         result =
             make_exception( c_string_to_lisp_string
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index bddd232..1357f34 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -308,11 +308,6 @@ extern struct cons_pointer privileged_keyword_payload;
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
-/**
- * given a cons_pointer as argument, return the tag.
- */
-#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
-
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
@@ -727,6 +722,11 @@ struct cons_pointer inc_ref( struct cons_pointer pointer );
 
 struct cons_pointer dec_ref( struct cons_pointer pointer );
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer );
+
 struct cons_pointer c_type( struct cons_pointer pointer );
 
 struct cons_pointer c_car( struct cons_pointer arg );
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index ea813a9..b2d0fa2 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -272,7 +272,9 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
 
         for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
             struct cons_pointer key = c_car( i );
-            if ( !equal( hashmap_get( a, key ), hashmap_get( b, key ) ) ) {
+            if ( !equal
+                 ( hashmap_get( a, key, false ),
+                   hashmap_get( b, key, false ) ) ) {
                 result = false;
                 break;
             }
diff --git a/src/ops/intern.c b/src/ops/intern.c
index ee15485..ae9800a 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -205,7 +205,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
             for ( struct cons_pointer keys = hashmap_keys( assoc );
                   !nilp( keys ); keys = c_cdr( keys ) ) {
                 struct cons_pointer key = c_car( keys );
-                hashmap_put( mapp, key, hashmap_get( assoc, key ) );
+                hashmap_put( mapp, key, hashmap_get( assoc, key, false ) );
             }
         }
     }
@@ -216,17 +216,33 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
 /** Get a value from a hashmap. 
   *
   * Note that this is here, rather than in memory/hashmap.c, because it is 
-  * closely tied in with c_assoc, q.v.
+  * closely tied in with search_store, q.v.
   */
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key ) {
+                                 struct cons_pointer key, bool return_key ) {
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get: key is `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( mapp ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
+
     struct cons_pointer result = NIL;
     if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) {
         struct vector_space_object *map = pointer_to_vso( mapp );
         uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
 
-        result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] );
+        result =
+            search_store( key, map->payload.hashmap.buckets[bucket_no],
+                          return_key );
     }
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get returning: `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+#endif
 
     return result;
 }
@@ -267,82 +283,134 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
     return result;
 }
 
-// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
-
 /**
- * If this key is lexically identical to a key in this store, return the key
- * from the store (so that later when we want to retrieve a value, an eq test
- * will work); otherwise return NIL.
+ * @brief `(search-store key store return-key?)` Search this `store` for this
+ * a key lexically identical to this `key`. 
+ *
+ * If found, then, if `return-key?` is non-nil, return the copy found in the 
+ * `store`, else return the value associated with it.
+ *
+ * At this stage the following structures are legal stores:
+ * 1. an association list comprising (key . value) dotted pairs;
+ * 2. a hashmap;
+ * 3. a namespace (which for these purposes is identical to a hashmap);
+ * 4. a hybrid list comprising both (key . value) pairs and hashmaps as first
+ *    level items;
+ * 5. such a hybrid list, but where the last CDR pointer is to a hashmap
+ *    rather than to a cons sell or to `nil`.
+ *
+ * This is over-complex and type 5 should be disallowed, but it will do for 
+ * now.
  */
-struct cons_pointer interned( struct cons_pointer key,
-                              struct cons_pointer store ) {
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store,
+                                  bool return_key ) {
     struct cons_pointer result = NIL;
 
-    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+#ifdef DEBUG
+    debug_print( L"\nsearch_store; key is `", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
-    debug_print( L"`\n", DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( store ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        struct cons_space_object *cell = &pointer2cell( store );
+        struct cons_space_object *store_cell = &pointer2cell( store );
 
-        switch ( cell->tag.value ) {
+        switch ( get_tag_value( store ) ) {
             case CONSTV:
-                for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
-                    if ( !nilp( next ) ) {
-                        // struct cons_space_object entry =
-                        //     pointer2cell( c_car( next) );
+                for ( struct cons_pointer cursor = store;
+                      nilp( result ) && ( consp( cursor )
+                                          || hashmapp( cursor ) );
+                      cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                    switch ( get_tag_value( cursor ) ) {
+                        case CONSTV:
+                            struct cons_pointer entry_ptr = c_car( cursor );
 
-                        if ( equal( key, c_car( next ) ) ) {
-                            result = key;
-                        }
+                            switch ( get_tag_value( entry_ptr ) ) {
+                                case CONSTV:
+                                    if ( equal( key, c_car( entry_ptr ) ) ) {
+                                        result =
+                                            return_key ? c_car( entry_ptr ) :
+                                            c_cdr( entry_ptr );
+                                    }
+                                    break;
+                                case HASHTV:
+                                case NAMESPACETV:
+                                    // TODO: I think this should be impossible, and we should maybe
+                                    // throw an exception.
+                                    result =
+                                        hashmap_get( entry_ptr, key,
+                                                     return_key );
+                                    break;
+                                default:
+                                    result =
+                                        throw_exception
+                                        ( c_string_to_lisp_symbol
+                                          ( L"search-store (entry)" ),
+                                          make_cons( c_string_to_lisp_string
+                                                     ( L"Unexpected store type: " ),
+                                                     c_type( c_car
+                                                             ( entry_ptr ) ) ),
+                                          NIL );
+
+                            }
+                            break;
+                        case HASHTV:
+                        case NAMESPACETV:
+                            debug_print
+                                ( L"\n\tHashmap as top-level value in list",
+                                  DEBUG_BIND );
+                            result = hashmap_get( cursor, key, return_key );
+                            break;
+                        default:
+                            result =
+                                throw_exception( c_string_to_lisp_symbol
+                                                 ( L"search-store (cursor)" ),
+                                                 make_cons
+                                                 ( c_string_to_lisp_string
+                                                   ( L"Unexpected store type: " ),
+                                                   c_type( cursor ) ), NIL );
                     }
                 }
                 break;
-            case VECTORPOINTTV:
-                if ( hashmapp( store ) || namespacep( store ) ) {
-                    // get the right hash bucket and recursively call interned on that.
-                    struct vector_space_object *map = pointer_to_vso( store );
-                    uint32_t bucket_no =
-                        get_hash( key ) % map->payload.hashmap.n_buckets;
-
-                    result =
-                        interned( key,
-                                  map->payload.hashmap.buckets[bucket_no] );
-                } else {
-                    result =
-                        throw_exception( c_string_to_lisp_symbol
-                                         ( L"interned?" ),
-                                         make_cons( c_string_to_lisp_string
-                                                    ( L"Unexpected store type: " ),
-                                                    c_type( store ) ), NIL );
-                }
+            case HASHTV:
+            case NAMESPACETV:
+                result = hashmap_get( store, key, return_key );
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
-                                     make_cons
-                                     ( c_string_to_lisp_string
-                                       ( L"Unexpected store type: " ),
-                                       c_type( store ) ), NIL );
+                    throw_exception( c_string_to_lisp_symbol
+                                     ( L"search-store (store)" ),
+                                     make_cons( c_string_to_lisp_string
+                                                ( L"Unexpected store type: " ),
+                                                c_type( store ) ), NIL );
                 break;
         }
     } else {
+        // failing with key type NIL here (?). Probably worth dumping the stack?
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+            throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
                              make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
     }
 
-    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print( L"search-store: returning `", DEBUG_BIND );
     debug_print_object( result, DEBUG_BIND );
     debug_print( L"`\n", DEBUG_BIND );
 
     return result;
 }
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
+    return search_store( key, store, true );
+}
+
 /**
  * @brief Implementation of `interned?` in C: predicate wrapped around interned.
  * 
@@ -365,68 +433,7 @@ struct cons_pointer internedp( struct cons_pointer key,
  */
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store ) {
-    struct cons_pointer result = NIL;
-
-    if ( !nilp( key ) ) {
-        if ( consp( store ) ) {
-            for ( struct cons_pointer next = store;
-                  nilp( result ) && ( consp( next ) || hashmapp( next ) );
-                  next = pointer2cell( next ).payload.cons.cdr ) {
-                if ( consp( next ) ) {
-// #ifdef DEBUG
-//                     debug_print( L"\nc_assoc; key is `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"`\n", DEBUG_BIND );
-// #endif
-
-                    struct cons_pointer entry_ptr = c_car( next );
-                    struct cons_space_object entry = pointer2cell( entry_ptr );
-
-                    switch ( entry.tag.value ) {
-                        case CONSTV:
-                            if ( equal( key, entry.payload.cons.car ) ) {
-                                result = entry.payload.cons.cdr;
-                            }
-                            break;
-                        case VECTORPOINTTV:
-                            result = hashmap_get( entry_ptr, key );
-                            break;
-                        default:
-                            throw_exception( c_string_to_lisp_symbol
-                                             ( L"assoc" ),
-                                             c_append( c_string_to_lisp_string
-                                                       ( L"Store entry is of unknown type: " ),
-                                                       c_type( entry_ptr ) ),
-                                             NIL );
-                    }
-
-// #ifdef DEBUG
-//                     debug_print( L"c_assoc `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"` returning: ", DEBUG_BIND );
-//                     debug_print_object( result, DEBUG_BIND );
-//                     debug_println( DEBUG_BIND );
-// #endif
-                }
-            }
-        } else if ( hashmapp( store ) || namespacep( store ) ) {
-            result = hashmap_get( store, key );
-        } else if ( !nilp( store ) ) {
-// #ifdef DEBUG        
-//             debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-//             debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
-//             debug_print( L"`\n", DEBUG_BIND );
-// #endif
-            result =
-                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
-                                 c_append
-                                 ( c_string_to_lisp_string
-                                   ( L"Store is of unknown type: " ),
-                                   c_type( store ) ), NIL );
-        }
-    }
-
-    return result;
+    return search_store( key, store, false );
 }
 
 /**
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 4043e66..18fc084 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -20,6 +20,9 @@
 #ifndef __intern_h
 #define __intern_h
 
+#include 
+
+
 extern struct cons_pointer privileged_symbol_nil;
 
 extern struct cons_pointer oblist;
@@ -31,7 +34,7 @@ void free_hashmap( struct cons_pointer ptr );
 void dump_map( URL_FILE * output, struct cons_pointer pointer );
 
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
+                                 struct cons_pointer key, bool return_key );
 
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
@@ -46,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
                                   struct cons_pointer hash_fn,
                                   struct cons_pointer write_acl );
 
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store, bool return_key );
+
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
@@ -55,9 +61,6 @@ struct cons_pointer interned( struct cons_pointer key,
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
-struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
-
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
                                  struct cons_pointer val );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 98497f6..c2b0e70 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -365,8 +365,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( name_key,
-                                                   fn_cell->payload.function.
-                                                   meta ) ),
+                                                   fn_cell->payload.
+                                                   function.meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -420,7 +420,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.function.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -494,7 +497,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.special.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1052,11 +1058,15 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
         frame->arg[0] : get_default_stream( true, env );
 
     if ( readp( in_stream ) ) {
-        debug_print( L"lisp_read: setting input stream\n", DEBUG_IO );
+        debug_print( L"lisp_read: setting input stream\n",
+                     DEBUG_IO | DEBUG_REPL );
         debug_dump_object( in_stream, DEBUG_IO );
         input = pointer2cell( in_stream ).payload.stream.stream;
         inc_ref( in_stream );
     } else {
+        /* should not happen, but has done. */
+        debug_print( L"WARNING: invalid input stream; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
         input = file_to_url_file( stdin );
     }
 
@@ -1332,10 +1342,17 @@ struct cons_pointer
 throw_exception( struct cons_pointer location,
                  struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
-    debug_print( L"\nERROR: ", DEBUG_EVAL );
-    debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
+#ifdef DEBUG
+    debug_print( L"\nERROR: `", 511 );
+    debug_print_object( message, 511 );
+    debug_print( L"` at `", 511 );
+    debug_print_object( location, 511 );
+    debug_print( L"`\n", 511 );
+    debug_print_object( location, 511 );
+#endif
+
     struct cons_space_object *cell = &pointer2cell( message );
 
     if ( cell->tag.value == EXCEPTIONTV ) {
@@ -1378,8 +1395,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1399,7 +1415,11 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                                struct cons_pointer env ) {
     struct cons_pointer expr = NIL;
 
-    debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
+#ifdef DEBUG
+    debug_print( L"Entering new inner REPL\n\tenv is `", DEBUG_REPL );
+    debug_print_object( env, DEBUG_REPL );
+    debug_print( L"`\n", DEBUG_REPL );
+#endif
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
@@ -1414,7 +1434,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
             set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
         input = frame->arg[1];
     }
-    if ( readp( frame->arg[2] ) ) {
+    if ( writep( frame->arg[2] ) ) {
         new_env =
             set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
         output = frame->arg[2];
@@ -1424,8 +1444,16 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     inc_ref( output );
     inc_ref( prompt_name );
 
-    URL_FILE *os = pointer2cell( output ).payload.stream.stream;
-
+    /* output should NEVER BE nil; but during development it has happened.
+     * To allow debugging under such circumstances, we need an emergency 
+     * default. */
+    URL_FILE *os =
+        !writep( output ) ? file_to_url_file( stdout ) :
+        pointer2cell( output ).payload.stream.stream;
+    if ( !writep( output ) ) {
+        debug_print( L"WARNING: invalid output; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
+    }
 
     /* \todo this is subtly wrong. If we were evaluating
      *   (print (eval (read)))
@@ -1442,7 +1470,10 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
          * \todo the whole process of resolving symbol values needs to be revisited
          * when we get onto namespaces. */
         /* OK, there's something even more subtle here if the root namespace is a map.
-         * H'mmmm... */
+         * H'mmmm... 
+         * I think that now the oblist is a hashmap masquerading as a namespace,
+         * we should no longer have to do this. TODO: test, and if so, delete this
+         * statement. */
         if ( !eq( oblist, old_oblist ) ) {
             struct cons_pointer cursor = oblist;
 
@@ -1486,6 +1517,9 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
         dec_ref( expr );
     }
 
+    if ( nilp( output ) ) {
+        free( os );
+    }
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
@@ -1563,14 +1597,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 72a8bc09e049b99c0514189272897fba9d985a7b Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sun, 1 Mar 2026 20:37:16 +0000
Subject: [PATCH 77/90] Very minor fixes/

---
 lisp/documentation.lisp | 4 ++--
 src/init.c              | 2 +-
 src/io/print.c          | 9 +--------
 3 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 7f5867b..b303856 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -11,10 +11,10 @@
 (set! member? (lambda
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            ;; (print (list "In member? item is " item "; collection is " collection))
+            (print (list "In member? item is " item "; collection is " collection))
             ;; (println)
             (cond
-              ((= nil collection) nil)
+              ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
               (t (member? item (cdr collection))))))
 
diff --git a/src/init.c b/src/init.c
index 74b6d94..565065f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -94,7 +94,7 @@ void maybe_bind_init_symbols(  ) {
         privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
     }
     if ( nilp( privileged_keyword_payload ) ) {
-        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+        privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
 }
 
diff --git a/src/io/print.c b/src/io/print.c
index a8f2770..f5f80a5 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -348,16 +348,9 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     if ( writep( out_stream ) ) {
         output = pointer2cell( out_stream ).payload.stream.stream;
-        inc_ref( out_stream );
-    } else {
-        output = file_to_url_file( stderr );
-    }
 
-    println( output );
+        println( output );
 
-    if ( writep( out_stream ) ) {
-        dec_ref( out_stream );
-    } else {
         free( output );
     }
 

From 2536e76617f98f0452f013f1680975eec538e978 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Mon, 2 Mar 2026 11:10:29 +0000
Subject: [PATCH 78/90] Added 'depth' counter to stack frames. The idea is
 two-fold:

1. You can limit runaway recursion by binding a symbol *max_stack_depth* in the environment
2. You can limit the number of backtrace frames printed.

However, neither of these have been implemented yet.
---
 src/init.c                   |   3 +
 src/memory/consspaceobject.c |   6 ++
 src/memory/consspaceobject.h |   8 ++
 src/memory/stack.c           |   5 +-
 src/ops/intern.c             | 151 +++++++++++++++++++----------------
 src/ops/lispops.c            |  42 ++++++++--
 src/ops/lispops.h            |   4 +
 7 files changed, 140 insertions(+), 79 deletions(-)

diff --git a/src/init.c b/src/init.c
index 565065f..a2da5e9 100644
--- a/src/init.c
+++ b/src/init.c
@@ -96,6 +96,9 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_keyword_payload ) ) {
         privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
+    if ( nilp( privileged_keyword_cause)) {
+        privileged_keyword_cause = c_string_to_lisp_keyword(L"cause");
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3d8fe78..ffff610 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -39,6 +39,12 @@ struct cons_pointer privileged_keyword_location = NIL;
  */
 struct cons_pointer privileged_keyword_payload = NIL;
 
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`, q.v.
+ */
+struct cons_pointer privileged_keyword_cause = NIL;
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index 1357f34..b456097 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -68,6 +68,12 @@ extern struct cons_pointer privileged_keyword_location;
  */
 extern struct cons_pointer privileged_keyword_payload;
 
+/**
+ * Keywords used when constructing exceptions: `:cause`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_cause;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
@@ -456,6 +462,8 @@ struct stack_frame {
     struct cons_pointer function;
     /** the number of arguments provided. */
     int args;
+    /** the depth of the stack below this frame */
+    int depth;
 };
 
 /**
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 7f5d581..7a85f3d 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -98,6 +98,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
         for ( int i = 0; i < args_in_frame; i++ ) {
             frame->arg[i] = NIL;
         }
+
+        frame->depth = (nilp(previous)) ? 0 : (get_stack_frame(previous))->depth + 1;
     }
     debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC );
     debug_dump_object( result, DEBUG_ALLOC );
@@ -285,7 +287,8 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
     struct stack_frame *frame = get_stack_frame( frame_pointer );
 
     if ( frame != NULL ) {
-        url_fwprintf( output, L"Stack frame with %d arguments:\n",
+        url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
+                      frame->depth;
                       frame->args );
         dump_frame_context( output, frame_pointer, 4 );
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index ae9800a..f5f1e63 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -316,81 +316,92 @@ struct cons_pointer search_store( struct cons_pointer key,
                   return_key ? "key" : "value" );
 #endif
 
-    if ( symbolp( key ) || keywordp( key ) ) {
-        struct cons_space_object *store_cell = &pointer2cell( store );
+    switch ( get_tag_value( key) ) {
+        case SYMBOLTV:
+        case KEYTV:
+            struct cons_space_object *store_cell = &pointer2cell( store );
 
-        switch ( get_tag_value( store ) ) {
-            case CONSTV:
-                for ( struct cons_pointer cursor = store;
-                      nilp( result ) && ( consp( cursor )
-                                          || hashmapp( cursor ) );
-                      cursor = pointer2cell( cursor ).payload.cons.cdr ) {
-                    switch ( get_tag_value( cursor ) ) {
-                        case CONSTV:
-                            struct cons_pointer entry_ptr = c_car( cursor );
+            switch ( get_tag_value( store ) ) {
+                case CONSTV:
+                    for ( struct cons_pointer cursor = store;
+                        nilp( result ) && ( consp( cursor )
+                                            || hashmapp( cursor ) );
+                        cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                        switch ( get_tag_value( cursor ) ) {
+                            case CONSTV:
+                                struct cons_pointer entry_ptr = c_car( cursor );
 
-                            switch ( get_tag_value( entry_ptr ) ) {
-                                case CONSTV:
-                                    if ( equal( key, c_car( entry_ptr ) ) ) {
+                                switch ( get_tag_value( entry_ptr ) ) {
+                                    case CONSTV:
+                                        if ( equal( key, c_car( entry_ptr ) ) ) {
+                                            result =
+                                                return_key ? c_car( entry_ptr ) :
+                                                c_cdr( entry_ptr );
+                                        }
+                                        break;
+                                    case HASHTV:
+                                    case NAMESPACETV:
+                                        // TODO: I think this should be impossible, and we should maybe
+                                        // throw an exception.
                                         result =
-                                            return_key ? c_car( entry_ptr ) :
-                                            c_cdr( entry_ptr );
-                                    }
-                                    break;
-                                case HASHTV:
-                                case NAMESPACETV:
-                                    // TODO: I think this should be impossible, and we should maybe
-                                    // throw an exception.
-                                    result =
-                                        hashmap_get( entry_ptr, key,
-                                                     return_key );
-                                    break;
-                                default:
-                                    result =
-                                        throw_exception
-                                        ( c_string_to_lisp_symbol
-                                          ( L"search-store (entry)" ),
-                                          make_cons( c_string_to_lisp_string
-                                                     ( L"Unexpected store type: " ),
-                                                     c_type( c_car
-                                                             ( entry_ptr ) ) ),
-                                          NIL );
+                                            hashmap_get( entry_ptr, key,
+                                                        return_key );
+                                        break;
+                                    default:
+                                        result =
+                                            throw_exception
+                                            ( c_string_to_lisp_symbol
+                                            ( L"search-store (entry)" ),
+                                            make_cons( c_string_to_lisp_string
+                                                        ( L"Unexpected store type: " ),
+                                                        c_type( c_car
+                                                                ( entry_ptr ) ) ),
+                                            NIL );
 
-                            }
-                            break;
-                        case HASHTV:
-                        case NAMESPACETV:
-                            debug_print
-                                ( L"\n\tHashmap as top-level value in list",
-                                  DEBUG_BIND );
-                            result = hashmap_get( cursor, key, return_key );
-                            break;
-                        default:
-                            result =
-                                throw_exception( c_string_to_lisp_symbol
-                                                 ( L"search-store (cursor)" ),
-                                                 make_cons
-                                                 ( c_string_to_lisp_string
-                                                   ( L"Unexpected store type: " ),
-                                                   c_type( cursor ) ), NIL );
+                                }
+                                break;
+                            case HASHTV:
+                            case NAMESPACETV:
+                                debug_print
+                                    ( L"\n\tHashmap as top-level value in list",
+                                    DEBUG_BIND );
+                                result = hashmap_get( cursor, key, return_key );
+                                break;
+                            default:
+                                result =
+                                    throw_exception( c_string_to_lisp_symbol
+                                                    ( L"search-store (cursor)" ),
+                                                    make_cons
+                                                    ( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( cursor ) ), NIL );
+                        }
                     }
-                }
-                break;
-            case HASHTV:
-            case NAMESPACETV:
-                result = hashmap_get( store, key, return_key );
-                break;
-            default:
-                result =
-                    throw_exception( c_string_to_lisp_symbol
-                                     ( L"search-store (store)" ),
-                                     make_cons( c_string_to_lisp_string
-                                                ( L"Unexpected store type: " ),
-                                                c_type( store ) ), NIL );
-                break;
-        }
-    } else {
-        // failing with key type NIL here (?). Probably worth dumping the stack?
+                    break;
+                case HASHTV:
+                case NAMESPACETV:
+                    result = hashmap_get( store, key, return_key );
+                    break;
+                default:
+                    result =
+                        throw_exception( c_string_to_lisp_symbol
+                                        ( L"search-store (store)" ),
+                                        make_cons( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( store ) ), NIL );
+                    break;
+            }
+            break;
+    case EXCEPTIONTV:
+            result =
+            throw_exception( c_string_to_lisp_symbol( L"search-store (exception)" ),
+                             make_cons
+                             ( c_string_to_lisp_string
+                               ( L"Unexpected key type: " ), c_type( key ) ),
+                             NIL );
+
+            break;
+    default:
         result =
             throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
                              make_cons
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index c2b0e70..fe264e8 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1329,18 +1329,18 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
 }
 
 /**
- * Throw an exception.
+ * Throw an exception with a cause.
  * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
  * lisp function; but it is nevertheless to be preferred to make_exception. A
  * real `throw_exception`, which does, will be needed.
  * object pointing to it. Then this should become a normal lisp function
  * which expects a normally bound frame and environment, such that
- * frame->arg[0] is the message, and frame->arg[1] is the cons-space
+ * frame->arg[0] is the payload, frame->arg[1] is the cause, and frame->arg[2] is the cons-space
  * pointer to the frame in which the exception occurred.
  */
-struct cons_pointer
-throw_exception( struct cons_pointer location,
+struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
                  struct cons_pointer message,
+                 struct cons_pointer cause,
                  struct cons_pointer frame_pointer ) {
     struct cons_pointer result = NIL;
 
@@ -1350,9 +1350,13 @@ throw_exception( struct cons_pointer location,
     debug_print( L"` at `", 511 );
     debug_print_object( location, 511 );
     debug_print( L"`\n", 511 );
-    debug_print_object( location, 511 );
+    if (!nilp( cause)) {
+        debug_print( L"\tCaused by: ", 511)
+        ;
+        debug_print_object( cause, 511);
+        debug_print( L"`\n", 511 );
+    }
 #endif
-
     struct cons_space_object *cell = &pointer2cell( message );
 
     if ( cell->tag.value == EXCEPTIONTV ) {
@@ -1364,10 +1368,31 @@ throw_exception( struct cons_pointer location,
                                          location ),
                               make_cons( make_cons
                                          ( privileged_keyword_payload,
-                                           message ), NIL ) ), frame_pointer );
+                                           message ), 
+                                        (nilp( cause) ? NIL :
+                                    make_cons( make_cons( privileged_keyword_cause,
+                                    cause), NIL)) ) ), frame_pointer );
     }
 
     return result;
+
+}
+
+/**
+ * Throw an exception.
+ * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
+ * lisp function; but it is nevertheless to be preferred to make_exception. A
+ * real `throw_exception`, which does, will be needed.
+ * object pointing to it. Then this should become a normal lisp function
+ * which expects a normally bound frame and environment, such that
+ * frame->arg[0] is the payload, frame->arg[1] is the cause, and frame->arg[2] is the cons-space
+ * pointer to the frame in which the exception occurred.
+ */
+struct cons_pointer
+throw_exception( struct cons_pointer location,
+                 struct cons_pointer payload,
+                 struct cons_pointer frame_pointer ) {
+    return throw_exception_with_cause( location, payload, NIL, frame_pointer);
 }
 
 /**
@@ -1393,8 +1418,9 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
 
-    return exceptionp( message ) ? message : throw_exception( message,
+    return exceptionp( message ) ? message : throw_exception_with_cause( message,
                                                               frame->arg[1],
+                                                              frame->arg[2],
                                                               frame->previous );
 }
 
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index da2428a..630592f 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -190,6 +190,10 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env );
 
+struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
+                 struct cons_pointer message,
+                 struct cons_pointer cause,
+                 struct cons_pointer frame_pointer );
 /**
  * Throw an exception.
  * `throw_exception` is a misnomer, because it doesn't obey the calling

From d1ce893633502b12afa04b4253496b003f95487a Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Fri, 13 Mar 2026 23:42:57 +0000
Subject: [PATCH 79/90] This is broken, but the stack limit feature works. Some
 debugging needed.

---
 docs/State-of-play.md        | 11 +++++
 src/init.c                   | 11 +++--
 src/io/io.c                  |  4 +-
 src/memory/consspaceobject.h |  4 +-
 src/memory/dump.c            |  8 ++--
 src/memory/stack.c           | 66 ++++++++++++++++++++++--------
 src/memory/stack.h           |  4 ++
 src/ops/intern.c             | 75 ++++++++++++++++++----------------
 src/ops/lispops.c            | 79 ++++++++++++++++++------------------
 src/ops/lispops.h            |  7 ++--
 unit-tests/recursion.sh      |  4 +-
 unit-tests/try.sh            |  2 +-
 12 files changed, 164 insertions(+), 111 deletions(-)

diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 61cfa0c..1d8bbfd 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,16 @@
 # State of Play
 
+## 20260311
+
+I've still been having trouble with runaway recursion — in `member`, but
+due to a primitive bug I haven't identified — so this morning I've tried
+to implement a stack limit feature. This has been a real fail at this stage. 
+Many more tests are breaking.
+
+However, I think having a configurable stack limit would be a good thing, so 
+I'm not yet ready to abandon this feature. I need to work out why it's breaking
+things.
+
 ## 20260226
 
 The bug in `member` turned out to be because when a symbol is read by the reader, 
diff --git a/src/init.c b/src/init.c
index a2da5e9..baca2b7 100644
--- a/src/init.c
+++ b/src/init.c
@@ -96,8 +96,8 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_keyword_payload ) ) {
         privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
-    if ( nilp( privileged_keyword_cause)) {
-        privileged_keyword_cause = c_string_to_lisp_keyword(L"cause");
+    if ( nilp( privileged_keyword_cause ) ) {
+        privileged_keyword_cause = c_string_to_lisp_keyword( L"cause" );
     }
 }
 
@@ -217,6 +217,8 @@ void print_options( FILE *stream ) {
               L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
     fwprintf( stream, L"\t-h\tPrint this message and exit;\n" );
     fwprintf( stream, L"\t-p\tShow a prompt (default is no prompt);\n" );
+    fwprintf( stream,
+              L"\t-s LIMIT\n\t\tSet the maximum stack depth to this LIMIT (int)\n" );
 #ifdef DEBUG
     fwprintf( stream,
               L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" );
@@ -249,7 +251,7 @@ int main( int argc, char *argv[] ) {
         exit( 1 );
     }
 
-    while ( ( option = getopt( argc, argv, "phdv:i:" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "dhi:ps:v:" ) ) != -1 ) {
         switch ( option ) {
             case 'd':
                 dump_at_end = true;
@@ -265,6 +267,9 @@ int main( int argc, char *argv[] ) {
             case 'p':
                 show_prompt = true;
                 break;
+            case 's':
+                stack_limit = atoi( optarg );
+                break;
             case 'v':
                 verbosity = atoi( optarg );
                 break;
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index b456097..9653402 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -207,7 +207,7 @@ extern struct cons_pointer privileged_keyword_cause;
 #define READTV      1145128274
 
 /**
- * A real number, represented internally as an IEEE 754-2008 `binary64`.
+ * A real number, represented internally as an IEEE 754-2008 `binary128`.
  */
 #define REALTAG     "REAL"
 
@@ -239,7 +239,7 @@ extern struct cons_pointer privileged_keyword_cause;
 #define STRINGTV    1196577875
 
 /**
- * A symbol is just like a string except not self-evaluating.
+ * A symbol is just like a keyword except not self-evaluating.
  */
 #define SYMBOLTAG   "SYMB"
 
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 7a85f3d..cff1ece 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -26,6 +26,12 @@
 #include "memory/vectorspace.h"
 #include "ops/lispops.h"
 
+/**
+ * @brief If non-zero, maximum depth of stack.
+ * 
+ */
+uint32_t stack_limit = 0;
+
 /**
  * set a register in a stack frame. Alwaye use this to do so,
  * because that way we can be sure the inc_ref happens!
@@ -68,17 +74,19 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
 
 /**
  * Make an empty stack frame, and return it.
+ *
+ * This function does the actual meat of making the frame.
+ *
  * @param previous the current top-of-stack;
- * @param env the environment in which evaluation happens.
+ * @param depth the depth of the new frame.
  * @return the new frame, or NULL if memory is exhausted.
  */
-struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
+struct cons_pointer in_make_empty_frame( struct cons_pointer previous,
+                                         uint32_t depth ) {
     debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC );
     struct cons_pointer result =
         make_vso( STACKFRAMETV, sizeof( struct stack_frame ) );
 
-    debug_dump_object( result, DEBUG_ALLOC );
-
     if ( !nilp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
         /*
@@ -86,6 +94,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
          */
 
         frame->previous = previous;
+        frame->depth = depth;
 
         /*
          * clearing the frame with memset would probably be slightly quicker, but
@@ -99,7 +108,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
             frame->arg[i] = NIL;
         }
 
-        frame->depth = (nilp(previous)) ? 0 : (get_stack_frame(previous))->depth + 1;
+        debug_dump_object( result, DEBUG_ALLOC );
     }
     debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC );
     debug_dump_object( result, DEBUG_ALLOC );
@@ -107,6 +116,37 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     return result;
 }
 
+/**
+ * @brief Make an empty stack frame, and return it.
+ *
+ * This function does the error checking around actual construction.
+ *
+ * @param previous the current top-of-stack;
+ * @param env the environment in which evaluation happens.
+ * @return the new frame, or NULL if memory is exhausted.
+ */
+struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
+    struct cons_pointer result = NIL;
+    uint32_t depth =
+        ( nilp( previous ) ) ? 0 : ( get_stack_frame( previous ) )->depth + 1;
+
+    if ( stack_limit > 0 && stack_limit > depth ) {
+        result = in_make_empty_frame( previous, depth );
+    } else {
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( L"Stack limit exceeded." ), previous );
+    }
+
+    if ( nilp( result ) ) {
+        /* i.e. out of memory */
+        result =
+            make_exception( privileged_string_memory_exhausted, previous );
+    }
+
+    return result;
+}
+
 /**
  * Allocate a new stack frame with its previous pointer set to this value,
  * its arguments set up from these args, evaluated in this env.
@@ -121,11 +161,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
     debug_print( L"Entering make_stack_frame\n", DEBUG_STACK );
     struct cons_pointer result = make_empty_frame( previous );
 
-    if ( nilp( result ) ) {
-        /* i.e. out of memory */
-        result =
-            make_exception( privileged_string_memory_exhausted, previous );
-    } else {
+    if ( !exceptionp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
 
         while ( frame->args < args_in_frame && consp( args ) ) {
@@ -191,12 +227,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous,
 
     struct cons_pointer result = make_empty_frame( previous );
 
-    if ( nilp( result ) ) {
-        /* i.e. out of memory */
-        result =
-            make_exception( c_string_to_lisp_string( L"Memory exhausted." ),
-                            previous );
-    } else {
+    if ( !exceptionp( result ) ) {
         struct stack_frame *frame = get_stack_frame( result );
 
         while ( frame->args < args_in_frame && !nilp( args ) ) {
@@ -288,8 +319,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
 
     if ( frame != NULL ) {
         url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
-                      frame->depth;
-                      frame->args );
+                      frame->depth, frame->args );
         dump_frame_context( output, frame_pointer, 4 );
 
         for ( int arg = 0; arg < frame->args; arg++ ) {
diff --git a/src/memory/stack.h b/src/memory/stack.h
index f132c69..111df48 100644
--- a/src/memory/stack.h
+++ b/src/memory/stack.h
@@ -21,6 +21,8 @@
 #ifndef __psse_stack_h
 #define __psse_stack_h
 
+#include 
+
 #include "consspaceobject.h"
 #include "conspage.h"
 
@@ -35,6 +37,8 @@
  */
 #define stackframep(vso)(((struct vector_space_object *)vso)->header.tag.value == STACKFRAMETV)
 
+extern uint32_t stack_limit;
+
 void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value );
 
 struct stack_frame *get_stack_frame( struct cons_pointer pointer );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index f5f1e63..bba5ee5 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -316,7 +316,7 @@ struct cons_pointer search_store( struct cons_pointer key,
                   return_key ? "key" : "value" );
 #endif
 
-    switch ( get_tag_value( key) ) {
+    switch ( get_tag_value( key ) ) {
         case SYMBOLTV:
         case KEYTV:
             struct cons_space_object *store_cell = &pointer2cell( store );
@@ -324,19 +324,20 @@ struct cons_pointer search_store( struct cons_pointer key,
             switch ( get_tag_value( store ) ) {
                 case CONSTV:
                     for ( struct cons_pointer cursor = store;
-                        nilp( result ) && ( consp( cursor )
-                                            || hashmapp( cursor ) );
-                        cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                          nilp( result ) && ( consp( cursor )
+                                              || hashmapp( cursor ) );
+                          cursor = pointer2cell( cursor ).payload.cons.cdr ) {
                         switch ( get_tag_value( cursor ) ) {
                             case CONSTV:
-                                struct cons_pointer entry_ptr = c_car( cursor );
+                                struct cons_pointer entry_ptr =
+                                    c_car( cursor );
 
                                 switch ( get_tag_value( entry_ptr ) ) {
                                     case CONSTV:
                                         if ( equal( key, c_car( entry_ptr ) ) ) {
                                             result =
-                                                return_key ? c_car( entry_ptr ) :
-                                                c_cdr( entry_ptr );
+                                                return_key ? c_car( entry_ptr )
+                                                : c_cdr( entry_ptr );
                                         }
                                         break;
                                     case HASHTV:
@@ -345,18 +346,18 @@ struct cons_pointer search_store( struct cons_pointer key,
                                         // throw an exception.
                                         result =
                                             hashmap_get( entry_ptr, key,
-                                                        return_key );
+                                                         return_key );
                                         break;
                                     default:
                                         result =
                                             throw_exception
                                             ( c_string_to_lisp_symbol
-                                            ( L"search-store (entry)" ),
-                                            make_cons( c_string_to_lisp_string
-                                                        ( L"Unexpected store type: " ),
-                                                        c_type( c_car
-                                                                ( entry_ptr ) ) ),
-                                            NIL );
+                                              ( L"search-store (entry)" ),
+                                              make_cons
+                                              ( c_string_to_lisp_string
+                                                ( L"Unexpected store type: " ),
+                                                c_type( c_car( entry_ptr ) ) ),
+                                              NIL );
 
                                 }
                                 break;
@@ -364,17 +365,19 @@ struct cons_pointer search_store( struct cons_pointer key,
                             case NAMESPACETV:
                                 debug_print
                                     ( L"\n\tHashmap as top-level value in list",
-                                    DEBUG_BIND );
-                                result = hashmap_get( cursor, key, return_key );
+                                      DEBUG_BIND );
+                                result =
+                                    hashmap_get( cursor, key, return_key );
                                 break;
                             default:
                                 result =
                                     throw_exception( c_string_to_lisp_symbol
-                                                    ( L"search-store (cursor)" ),
-                                                    make_cons
-                                                    ( c_string_to_lisp_string
-                                                    ( L"Unexpected store type: " ),
-                                                    c_type( cursor ) ), NIL );
+                                                     ( L"search-store (cursor)" ),
+                                                     make_cons
+                                                     ( c_string_to_lisp_string
+                                                       ( L"Unexpected store type: " ),
+                                                       c_type( cursor ) ),
+                                                     NIL );
                         }
                     }
                     break;
@@ -385,29 +388,29 @@ struct cons_pointer search_store( struct cons_pointer key,
                 default:
                     result =
                         throw_exception( c_string_to_lisp_symbol
-                                        ( L"search-store (store)" ),
-                                        make_cons( c_string_to_lisp_string
+                                         ( L"search-store (store)" ),
+                                         make_cons( c_string_to_lisp_string
                                                     ( L"Unexpected store type: " ),
                                                     c_type( store ) ), NIL );
                     break;
             }
             break;
-    case EXCEPTIONTV:
+        case EXCEPTIONTV:
             result =
-            throw_exception( c_string_to_lisp_symbol( L"search-store (exception)" ),
-                             make_cons
-                             ( c_string_to_lisp_string
-                               ( L"Unexpected key type: " ), c_type( key ) ),
-                             NIL );
+                throw_exception( c_string_to_lisp_symbol
+                                 ( L"search-store (exception)" ),
+                                 make_cons( c_string_to_lisp_string
+                                            ( L"Unexpected key type: " ),
+                                            c_type( key ) ), NIL );
 
             break;
-    default:
-        result =
-            throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
-                             make_cons
-                             ( c_string_to_lisp_string
-                               ( L"Unexpected key type: " ), c_type( key ) ),
-                             NIL );
+        default:
+            result =
+                throw_exception( c_string_to_lisp_symbol
+                                 ( L"search-store (key)" ),
+                                 make_cons( c_string_to_lisp_string
+                                            ( L"Unexpected key type: " ),
+                                            c_type( key ) ), NIL );
     }
 
     debug_print( L"search-store: returning `", DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index fe264e8..57b2f8e 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -92,18 +92,21 @@ struct cons_pointer eval_form( struct stack_frame *parent,
                 struct cons_pointer next_pointer =
                     make_empty_frame( parent_pointer );
                 // inc_ref( next_pointer );
+                if ( exceptionp( next_pointer ) ) {
+                    result = next_pointer;
+                } else {
+                    struct stack_frame *next = get_stack_frame( next_pointer );
+                    set_reg( next, 0, form );
+                    next->args = 1;
 
-                struct stack_frame *next = get_stack_frame( next_pointer );
-                set_reg( next, 0, form );
-                next->args = 1;
+                    result = lisp_eval( next, next_pointer, env );
 
-                result = lisp_eval( next, next_pointer, env );
-
-                if ( !exceptionp( result ) ) {
-                    /* if we're returning an exception, we should NOT free the
-                     * stack frame. Corollary is, when we free an exception, we
-                     * should free all the frames it's holding on to. */
-                    dec_ref( next_pointer );
+                    if ( !exceptionp( result ) ) {
+                        /* if we're returning an exception, we should NOT free the
+                         * stack frame. Corollary is, when we free an exception, we
+                         * should free all the frames it's holding on to. */
+                        dec_ref( next_pointer );
+                    }
                 }
             }
             break;
@@ -365,8 +368,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( name_key,
-                                                   fn_cell->payload.
-                                                   function.meta ) ),
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -420,10 +423,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -497,10 +497,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1339,9 +1336,10 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * pointer to the frame in which the exception occurred.
  */
 struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
-                 struct cons_pointer message,
-                 struct cons_pointer cause,
-                 struct cons_pointer frame_pointer ) {
+                                                struct cons_pointer message,
+                                                struct cons_pointer cause,
+                                                struct cons_pointer
+                                                frame_pointer ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
@@ -1350,10 +1348,9 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
     debug_print( L"` at `", 511 );
     debug_print_object( location, 511 );
     debug_print( L"`\n", 511 );
-    if (!nilp( cause)) {
-        debug_print( L"\tCaused by: ", 511)
-        ;
-        debug_print_object( cause, 511);
+    if ( !nilp( cause ) ) {
+        debug_print( L"\tCaused by: ", 511 );
+        debug_print_object( cause, 511 );
         debug_print( L"`\n", 511 );
     }
 #endif
@@ -1368,10 +1365,12 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
                                          location ),
                               make_cons( make_cons
                                          ( privileged_keyword_payload,
-                                           message ), 
-                                        (nilp( cause) ? NIL :
-                                    make_cons( make_cons( privileged_keyword_cause,
-                                    cause), NIL)) ) ), frame_pointer );
+                                           message ),
+                                         ( nilp( cause ) ? NIL :
+                                           make_cons( make_cons
+                                                      ( privileged_keyword_cause,
+                                                        cause ), NIL ) ) ) ),
+                            frame_pointer );
     }
 
     return result;
@@ -1392,7 +1391,7 @@ struct cons_pointer
 throw_exception( struct cons_pointer location,
                  struct cons_pointer payload,
                  struct cons_pointer frame_pointer ) {
-    return throw_exception_with_cause( location, payload, NIL, frame_pointer);
+    return throw_exception_with_cause( location, payload, NIL, frame_pointer );
 }
 
 /**
@@ -1418,10 +1417,9 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
 
-    return exceptionp( message ) ? message : throw_exception_with_cause( message,
-                                                              frame->arg[1],
-                                                              frame->arg[2],
-                                                              frame->previous );
+    return exceptionp( message ) ? message :
+        throw_exception_with_cause( message, frame->arg[1], frame->arg[2],
+                                    frame->previous );
 }
 
 /**
@@ -1623,13 +1621,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 630592f..66f46c8 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -191,9 +191,10 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
                                struct cons_pointer env );
 
 struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
-                 struct cons_pointer message,
-                 struct cons_pointer cause,
-                 struct cons_pointer frame_pointer );
+                                                struct cons_pointer message,
+                                                struct cons_pointer cause,
+                                                struct cons_pointer
+                                                frame_pointer );
 /**
  * Throw an exception.
  * `throw_exception` is a misnomer, because it doesn't obey the calling
diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh
index 6b5be2d..e3aa586 100755
--- a/unit-tests/recursion.sh
+++ b/unit-tests/recursion.sh
@@ -5,8 +5,8 @@ output=`target/psse 2>/dev/null <&1 | grep Exception`
 
 if [ "${expected}" = "${actual}" ]

From 7f3460152325f6185642edad13df9dd0968b727a Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Mar 2026 16:58:55 +0000
Subject: [PATCH 80/90] Well, that was easy! Stack limit now working.

---
 Makefile                |  2 +-
 docs/State-of-play.md   | 11 +++++++++++
 lisp/documentation.lisp |  2 +-
 src/memory/stack.c      |  2 +-
 4 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/Makefile b/Makefile
index 7c55be3..5691f29 100644
--- a/Makefile
+++ b/Makefile
@@ -44,7 +44,7 @@ test: $(TESTS) Makefile $(TARGET)
 
 .PHONY: clean
 clean:
-	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
+	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core.*
 
 repl:
 	$(TARGET) -p 2> psse.log
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 1d8bbfd..c619b55 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,16 @@
 # State of Play
 
+## 20260314
+
+When I put a debugger on it, the stack limit bug proved shallow. 
+
+I'm tempted to further exercise my debugging skills by having another go at 
+the bignum arithmetic problems.
+
+However, I've been rethinking the roadmap of the project, and written a long
+[blog post about it](https://www.journeyman.cc/blog/posts-output/2026-03-13-The-worlds-slowest-ever-rapid-prototype/). 
+This isn't a finalised decision yet, but it is something I'm thinking about.
+
 ## 20260311
 
 I've still been having trouble with runaway recursion — in `member`, but
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index b303856..271700d 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -12,7 +12,7 @@
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (print (list "In member? item is " item "; collection is " collection))
-            ;; (println)
+            (println)
             (cond
               ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
diff --git a/src/memory/stack.c b/src/memory/stack.c
index cff1ece..70c07f9 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -130,7 +130,7 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     uint32_t depth =
         ( nilp( previous ) ) ? 0 : ( get_stack_frame( previous ) )->depth + 1;
 
-    if ( stack_limit > 0 && stack_limit > depth ) {
+    if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
         result =

From d42ece5711f29beb5af7a667bb93d40924495d8f Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Sat, 14 Mar 2026 21:20:23 +0000
Subject: [PATCH 81/90] Tactical commit while working on the bignum bug, AGAIN.

---
 src/arith/integer.c | 72 ++++++++++++++++++---------------------------
 src/debug.h         |  7 +++++
 src/init.c          |  3 +-
 src/ops/equal.c     | 22 +++++++-------
 4 files changed, 49 insertions(+), 55 deletions(-)

diff --git a/src/arith/integer.c b/src/arith/integer.c
index a3174ac..3688ff5 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -210,7 +210,7 @@ __int128_t int128_to_integer( __int128_t val,
 
     if ( integerp( less_significant ) ) {
         struct cons_space_object *lsc = &pointer2cell( less_significant );
-        inc_ref( new );
+        // inc_ref( new );
         lsc->payload.integer.more = new;
     }
 
@@ -226,57 +226,43 @@ struct cons_pointer add_integers( struct cons_pointer a,
     struct cons_pointer result = NIL;
     struct cons_pointer cursor = NIL;
 
-    debug_print( L"add_integers: a = ", DEBUG_ARITH );
-    debug_print_object( a, DEBUG_ARITH );
-    debug_print( L"; b = ", DEBUG_ARITH );
-    debug_print_object( b, DEBUG_ARITH );
-    debug_println( DEBUG_ARITH );
-
     __int128_t carry = 0;
     bool is_first_cell = true;
 
-    if ( integerp( a ) && integerp( b ) ) {
-        debug_print( L"add_integers: \n", DEBUG_ARITH );
-        debug_dump_object( a, DEBUG_ARITH );
-        debug_print( L" plus \n", DEBUG_ARITH );
-        debug_dump_object( b, DEBUG_ARITH );
-        debug_println( DEBUG_ARITH );
+    while ( integerp( a ) || integerp( b ) || carry != 0 ) {
+        __int128_t av = cell_value( a, '+', is_first_cell );
+        __int128_t bv = cell_value( b, '+', is_first_cell );
+        __int128_t rv = ( av + bv ) + carry;
 
-        while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
-            __int128_t av = cell_value( a, '+', is_first_cell );
-            __int128_t bv = cell_value( b, '+', is_first_cell );
-            __int128_t rv = ( av + bv ) + carry;
+        debug_print( L"add_integers: av = ", DEBUG_ARITH );
+        debug_print_128bit( av, DEBUG_ARITH );
+        debug_print( L"; bv = ", DEBUG_ARITH );
+        debug_print_128bit( bv, DEBUG_ARITH );
+        debug_print( L"; carry = ", DEBUG_ARITH );
+        debug_print_128bit( carry, DEBUG_ARITH );
+        debug_print( L"; rv = ", DEBUG_ARITH );
+        debug_print_128bit( rv, DEBUG_ARITH );
+        debug_print( L"\n", DEBUG_ARITH );
 
-            debug_print( L"add_integers: av = ", DEBUG_ARITH );
-            debug_print_128bit( av, DEBUG_ARITH );
-            debug_print( L"; bv = ", DEBUG_ARITH );
-            debug_print_128bit( bv, DEBUG_ARITH );
-            debug_print( L"; carry = ", DEBUG_ARITH );
-            debug_print_128bit( carry, DEBUG_ARITH );
-            debug_print( L"; rv = ", DEBUG_ARITH );
-            debug_print_128bit( rv, DEBUG_ARITH );
-            debug_print( L"\n", DEBUG_ARITH );
+        if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
+            result =
+                acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
+            break;
+        } else {
+            struct cons_pointer new = make_integer( 0, NIL );
+            carry = int128_to_integer( rv, cursor, new );
+            cursor = new;
 
-            if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT ) {
-                result =
-                    acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
-                break;
-            } else {
-                struct cons_pointer new = make_integer( 0, NIL );
-                carry = int128_to_integer( rv, cursor, new );
-                cursor = new;
-
-                if ( nilp( result ) ) {
-                    result = cursor;
-                }
-
-                a = pointer2cell( a ).payload.integer.more;
-                b = pointer2cell( b ).payload.integer.more;
-                is_first_cell = false;
+            if ( nilp( result ) ) {
+                result = cursor;
             }
+
+            a = pointer2cell( a ).payload.integer.more;
+            b = pointer2cell( b ).payload.integer.more;
+            is_first_cell = false;
         }
     }
-
+    
     debug_print( L"add_integers returning: ", DEBUG_ARITH );
     debug_print_object( result, DEBUG_ARITH );
     debug_println( DEBUG_ARITH );
diff --git a/src/debug.h b/src/debug.h
index 2e59932..6c7c8cb 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -79,6 +79,13 @@
  */
 #define DEBUG_STACK 256
 
+/**
+ * @brief Print messages about equality tests.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
+ #define DEBUG_EQUAL 512
+
 extern int verbosity;
 
 void debug_print_exception( struct cons_pointer ex_ptr );
diff --git a/src/init.c b/src/init.c
index baca2b7..d88e8aa 100644
--- a/src/init.c
+++ b/src/init.c
@@ -231,7 +231,8 @@ void print_options( FILE *stream ) {
     fwprintf( stream, L"\t\t32\tINPUT/OUTPUT;\n" );
     fwprintf( stream, L"\t\t64\tLAMBDA;\n" );
     fwprintf( stream, L"\t\t128\tREPL;\n" );
-    fwprintf( stream, L"\t\t256\tSTACK.\n" );
+    fwprintf( stream, L"\t\t256\tSTACK;\n" );
+    fwprintf( stream, L"\t\t512\tEQUAL.\n" );
 #endif
 }
 
diff --git a/src/ops/equal.c b/src/ops/equal.c
index b2d0fa2..296aea6 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -74,7 +74,7 @@ bool equal_ld_ld( long double a, long double b ) {
 
     bool result = ( fabsl( a - b ) < tolerance );
 
-    debug_printf( DEBUG_ARITH, L"\nequal_ld_ld returning %d\n", result );
+    debug_printf( DEBUG_EQUAL, L"\nequal_ld_ld returning %d\n", result );
 
     return result;
 }
@@ -332,10 +332,10 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
  * identical structure, else false.
  */
 bool equal( struct cons_pointer a, struct cons_pointer b ) {
-    debug_print( L"\nequal: ", DEBUG_ARITH );
-    debug_print_object( a, DEBUG_ARITH );
-    debug_print( L" = ", DEBUG_ARITH );
-    debug_print_object( b, DEBUG_ARITH );
+    debug_print( L"\nequal: ", DEBUG_EQUAL );
+    debug_print_object( a, DEBUG_EQUAL );
+    debug_print( L" = ", DEBUG_EQUAL );
+    debug_print_object( b, DEBUG_EQUAL );
 
     bool result = false;
 
@@ -389,11 +389,11 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     }
 
 #ifdef DEBUG
-                    debug_print( L"Comparing '", DEBUG_ARITH );
-                    debug_print( a_buff, DEBUG_ARITH );
-                    debug_print( L"' to '", DEBUG_ARITH );
-                    debug_print( b_buff, DEBUG_ARITH );
-                    debug_print( L"'\n", DEBUG_ARITH );
+                    debug_print( L"Comparing '", DEBUG_EQUAL );
+                    debug_print( a_buff, DEBUG_EQUAL );
+                    debug_print( L"' to '", DEBUG_EQUAL );
+                    debug_print( b_buff, DEBUG_EQUAL );
+                    debug_print( L"'\n", DEBUG_EQUAL );
 #endif
 
                     /* OK, now we have wchar string buffers loaded from the objects. We 
@@ -427,7 +427,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
      * I'll ignore them, too, for now.
      */
 
-    debug_printf( DEBUG_ARITH, L"\nequal returning %d\n", result );
+    debug_printf( DEBUG_EQUAL, L"\nequal returning %d\n", result );
 
     return result;
 }

From de50a30be2bf56e2a15715b6bced46e06d30c6e4 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Mon, 16 Mar 2026 15:26:12 +0000
Subject: [PATCH 82/90] Getting closer to tracking down the member bug, but
 cannot use debugger on laptop screen.

---
 Makefile                     |  3 +++
 docs/State-of-play.md        |  9 ++++++++
 lisp/documentation.lisp      |  4 +---
 lisp/member.lisp             |  2 +-
 src/init.c                   | 43 ++++++++++++++++--------------------
 src/memory/consspaceobject.c | 20 +++++++++++++++++
 src/memory/consspaceobject.h | 18 +++++++++++++++
 src/ops/lispops.c            | 31 +++++++++-----------------
 unit-tests/let.sh            |  8 +++----
 unit-tests/progn.sh          |  4 ++--
 unit-tests/recursion.sh      |  2 +-
 11 files changed, 89 insertions(+), 55 deletions(-)

diff --git a/Makefile b/Makefile
index 5691f29..27780a5 100644
--- a/Makefile
+++ b/Makefile
@@ -46,6 +46,9 @@ test: $(TESTS) Makefile $(TARGET)
 clean:
 	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core.*
 
+coredumps:
+	ulimit -c unlimited
+
 repl:
 	$(TARGET) -p 2> psse.log
 
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index c619b55..6ad9c69 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,14 @@
 # State of Play
 
+## 20260316
+
+OK, where we're at: 
+* The garbage collector is doing *even worse* than it was on 4th 
+February, when I did the last serious look at it. 
+* The bignum bugs are not fixed.
+* You can (optionally) limit runaway stack crashes with a new command line option.
+* If you enable the stack limiter feature, `(member? 5 '(1 2 3 4))` returns `nil`, as it should, and does not throw a stack limit exception, but if you do not enable it, `(member? 5 '(1 2 3 4))` causes a segfault. WTAF?
+
 ## 20260314
 
 When I put a debugger on it, the stack limit bug proved shallow. 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 271700d..056856e 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -10,9 +10,7 @@
 
 (set! member? (lambda
             (item collection)
-            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            (print (list "In member? item is " item "; collection is " collection))
-            (println)
+            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
diff --git a/lisp/member.lisp b/lisp/member.lisp
index dfb12af..b67a7e3 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -5,7 +5,7 @@
 
 (set! member? (lambda
             (item collection)
-            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
             (cond
               ((nil? collection) nil)
               ((= item (car collection)) t)
diff --git a/src/init.c b/src/init.c
index d88e8aa..6e6b106 100644
--- a/src/init.c
+++ b/src/init.c
@@ -47,11 +47,12 @@
  */
 struct cons_pointer check_exception( struct cons_pointer pointer,
                                      char *location_descriptor ) {
-    struct cons_pointer result = NIL;
-
-    struct cons_space_object *object = &pointer2cell( pointer );
+    struct cons_pointer result = pointer;
 
     if ( exceptionp( pointer ) ) {
+        struct cons_space_object * object = &pointer2cell( pointer);
+        result = NIL;
+        
         fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
         URL_FILE *ustderr = file_to_url_file( stderr );
         fwide( stderr, 1 );
@@ -59,27 +60,21 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
         free( ustderr );
 
         dec_ref( pointer );
-    } else {
-        result = pointer;
     }
 
     return result;
 }
 
-struct cons_pointer init_documentation_symbol = NIL;
-struct cons_pointer init_name_symbol = NIL;
-struct cons_pointer init_primitive_symbol = NIL;
-
 void maybe_bind_init_symbols(  ) {
-    if ( nilp( init_documentation_symbol ) ) {
-        init_documentation_symbol =
+    if ( nilp( privileged_keyword_documentation ) ) {
+        privileged_keyword_documentation =
             c_string_to_lisp_keyword( L"documentation" );
     }
-    if ( nilp( init_name_symbol ) ) {
-        init_name_symbol = c_string_to_lisp_keyword( L"name" );
+    if ( nilp( privileged_keyword_name ) ) {
+        privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
     }
-    if ( nilp( init_primitive_symbol ) ) {
-        init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
+    if ( nilp( privileged_keyword_primitive ) ) {
+        privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" );
     }
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
@@ -102,9 +97,9 @@ void maybe_bind_init_symbols(  ) {
 }
 
 void free_init_symbols(  ) {
-    dec_ref( init_documentation_symbol );
-    dec_ref( init_name_symbol );
-    dec_ref( init_primitive_symbol );
+    dec_ref( privileged_keyword_documentation );
+    dec_ref( privileged_keyword_name );
+    dec_ref( privileged_keyword_primitive );
 }
 
 /**
@@ -124,10 +119,10 @@ struct cons_pointer bind_function( wchar_t *name,
     struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
-        make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n ),
+        make_cons( make_cons( privileged_keyword_primitive, TRUE ),
+                   make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( init_documentation_symbol, d ),
+                                         ( privileged_keyword_documentation, d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
@@ -153,10 +148,10 @@ struct cons_pointer bind_special( wchar_t *name,
     struct cons_pointer d = c_string_to_lisp_string( doc );
 
     struct cons_pointer meta =
-        make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( init_name_symbol, n ),
+        make_cons( make_cons( privileged_keyword_primitive, TRUE ),
+                   make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( init_documentation_symbol, d ),
+                                         ( privileged_keyword_documentation, d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index ffff610..2c0ab6a 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -45,6 +45,26 @@ struct cons_pointer privileged_keyword_payload = NIL;
  */
 struct cons_pointer privileged_keyword_cause = NIL;
 
+/**
+ * @brief keywords used in documentation: `:documentation`. Instantiated in 
+ * `init.c`, q. v.
+ * 
+ */
+struct cons_pointer privileged_keyword_documentation = NIL;
+
+/**
+ * @brief keywords used in documentation: `:name`. Instantiated in 
+ * `init.c`, q. v.
+ */
+struct cons_pointer privileged_keyword_name = NIL;
+
+/**
+ * @brief keywords used in documentation: `:primitive`. Instantiated in 
+ * `init.c`, q. v.
+ */
+struct cons_pointer privileged_keyword_primitive = NIL;
+
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index 9653402..25f68e3 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -74,6 +74,24 @@ extern struct cons_pointer privileged_keyword_payload;
  */
 extern struct cons_pointer privileged_keyword_cause;
 
+/**
+ * @brief keywords used in documentation: `:documentation`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_documentation;
+
+/**
+ * @brief keywords used in documentation: `:name`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_name;
+
+/**
+ * @brief keywords used in documentation: `:primitive`. Instantiated in 
+ * `init.c`, q. v.
+ */
+extern struct cons_pointer privileged_keyword_primitive;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 57b2f8e..393cc7b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -91,7 +91,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
             {
                 struct cons_pointer next_pointer =
                     make_empty_frame( parent_pointer );
-                // inc_ref( next_pointer );
+
                 if ( exceptionp( next_pointer ) ) {
                     result = next_pointer;
                 } else {
@@ -275,7 +275,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
 
             names = c_cdr( names );
         }
-//        inc_ref( new_env );
 
         /* \todo if there's more than `args_in_frame` arguments, bind those too. */
     } else if ( symbolp( names ) ) {
@@ -296,7 +295,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
         }
 
         new_env = set( names, vals, new_env );
-//        inc_ref( new_env );
     }
 
     while ( !nilp( body ) ) {
@@ -311,9 +309,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
 
         /* if a result is not the terminal result in the lambda, it's a
          * side effect, and needs to be GCed */
-        if ( !nilp( result ) ) {
-            dec_ref( result );
-        }
+        dec_ref( result );
 
         result = eval_form( frame, frame_pointer, sexpr, new_env );
 
@@ -322,6 +318,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
         }
     }
 
+    // TODO: I think we do need to dec_ref everything on new_env back to env    
     // dec_ref( new_env );
 
     debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA );
@@ -346,8 +343,6 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
 
         struct cons_pointer payload =
             pointer2cell( result ).payload.exception.payload;
-        /* TODO: should name_key also be a privileged keyword? */
-        struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
 
         switch ( get_tag_value( payload ) ) {
             case NILTV:
@@ -358,7 +353,7 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                                         payload ) ) ) {
                         pointer2cell( result ).payload.exception.payload =
                             set( privileged_keyword_location,
-                                 c_assoc( name_key,
+                                 c_assoc( privileged_keyword_name,
                                           fn_cell->payload.function.meta ),
                                  payload );
                     }
@@ -367,15 +362,13 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
             default:
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
-                                          c_assoc( name_key,
+                                          c_assoc( privileged_keyword_name,
                                                    fn_cell->payload.function.
                                                    meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
         }
-
-        dec_ref( name_key );
     }
 
     return result;
@@ -415,7 +408,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -446,7 +439,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     struct cons_pointer exep = NIL;
                     struct cons_pointer next_pointer =
                         make_stack_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -475,7 +468,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-//                    inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -492,7 +485,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    // inc_ref( next_pointer );
+
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
@@ -580,7 +573,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
                                          message, frame_pointer );
                 } else {
                     result = c_assoc( canonical, env );
-                    inc_ref( result );
+//                    inc_ref( result );
                 }
             }
             break;
@@ -1196,7 +1189,7 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     while ( consp( expressions ) ) {
         struct cons_pointer r = result;
-        inc_ref( r );
+
         result = eval_form( frame, frame_pointer, c_car( expressions ), env );
         dec_ref( r );
 
@@ -1227,7 +1220,6 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
         struct cons_pointer r = result;
-        inc_ref( r );
 
         result = eval_form( frame, frame_pointer, frame->arg[i], env );
 
@@ -1672,7 +1664,6 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
     for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) {
         struct cons_pointer expr =
             make_cons( frame->arg[0], make_cons( c_car( c ), NIL ) );
-        inc_ref( expr );
 
         debug_printf( DEBUG_EVAL, L"Mapcar %d, evaluating ", i );
         debug_print_object( expr, DEBUG_EVAL );
diff --git a/unit-tests/let.sh b/unit-tests/let.sh
index 037a96a..0a63221 100755
--- a/unit-tests/let.sh
+++ b/unit-tests/let.sh
@@ -2,9 +2,9 @@
 
 result=0
 
-echo -n "$0: let with two bindings, one form in body..."
 expected='11'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
+echo -n "$0: let with two bindings, one form in body... "
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -14,9 +14,9 @@ else
     result=`echo "${result} + 1" | bc`
 fi
 
-echo -n "$0: let with two bindings, two forms in body..."
 expected='1'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
+echo -n "$0: let with two bindings, two forms in body..."
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
index ea6cf7b..f785155 100755
--- a/unit-tests/progn.sh
+++ b/unit-tests/progn.sh
@@ -4,7 +4,7 @@ result=0
 
 echo -n "$0: progn with one form... "
 expected='5'
-actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -16,7 +16,7 @@ fi
 
 echo -n "$0: progn with two forms... "
 expected='"foo"'
-actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
+actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh
index e3aa586..30a6394 100755
--- a/unit-tests/recursion.sh
+++ b/unit-tests/recursion.sh
@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='nil 3,628,800'
-output=`target/psse 2>/dev/null <
Date: Mon, 16 Mar 2026 15:28:09 +0000
Subject: [PATCH 83/90] Added the unit test for member!

---
 unit-tests/memberp.sh | 107 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100644 unit-tests/memberp.sh

diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
new file mode 100644
index 0000000..ff15ea4
--- /dev/null
+++ b/unit-tests/memberp.sh
@@ -0,0 +1,107 @@
+#!/bin/bash
+
+result=0
+
+expected='t'
+output=`target/psse <
Date: Wed, 18 Mar 2026 11:53:48 +0000
Subject: [PATCH 84/90] Working on the `member?` bug. No fix, but some
 improvements in debug message format.

The bug is actually either in `cond` or in `cdr`, but I'm finding it extremely hard
to trace.
---
 src/memory/stack.c    | 15 +++++++++------
 src/ops/lispops.c     |  8 ++++++--
 unit-tests/memberp.sh | 18 +++++++++---------
 3 files changed, 24 insertions(+), 17 deletions(-)

diff --git a/src/memory/stack.c b/src/memory/stack.c
index 70c07f9..8908fc7 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -37,7 +37,7 @@ uint32_t stack_limit = 0;
  * because that way we can be sure the inc_ref happens!
  */
 void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) {
-    debug_printf( DEBUG_STACK, L"Setting register %d to ", reg );
+    debug_printf( DEBUG_STACK, L"\tSetting register %d to ", reg );
     debug_print_object( value, DEBUG_STACK );
     debug_println( DEBUG_STACK );
     dec_ref( frame->arg[reg] ); /* if there was anything in that slot
@@ -63,10 +63,10 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
 
     if ( vectorpointp( pointer ) && stackframep( vso ) ) {
         result = ( struct stack_frame * ) &( vso->payload );
-        debug_printf( DEBUG_STACK,
-                      L"get_stack_frame: all good, returning %p\n", result );
+        // debug_printf( DEBUG_STACK,
+        //               L"\nget_stack_frame: all good, returning %p\n", result );
     } else {
-        debug_print( L"get_stack_frame: fail, returning NULL\n", DEBUG_STACK );
+        debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
     }
 
     return result;
@@ -133,6 +133,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
+        debug_printf( DEBUG_STACK, 
+            L"WARNING: Exceeded stack limit of %d\n", stack_limit);
         result =
             make_exception( c_string_to_lisp_string
                             ( L"Stack limit exceeded." ), previous );
@@ -182,9 +184,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 result = val;
                 break;
             } else {
-                debug_printf( DEBUG_STACK, L"Setting argument %d to ",
+                debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
                               frame->args );
                 debug_print_object( cell.payload.cons.car, DEBUG_STACK );
+                debug_print(L"\n", DEBUG_STACK);
                 set_reg( frame, frame->args, val );
             }
 
@@ -325,7 +328,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
         for ( int arg = 0; arg < frame->args; arg++ ) {
             struct cons_space_object cell = pointer2cell( frame->arg[arg] );
 
-            url_fwprintf( output, L"Arg %d:\t%4.4s\tcount: %10u\tvalue: ",
+            url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ",
                           arg, cell.tag.bytes, cell.count );
 
             print( output, frame->arg[arg] );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 393cc7b..914301d 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -1261,11 +1261,15 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
                                     env ) );
 
 #ifdef DEBUG
-            debug_print( L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL );
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
+            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L" succeeded; returning: ", DEBUG_EVAL );
             debug_print_object( result, DEBUG_EVAL );
             debug_println( DEBUG_EVAL );
         } else {
-            debug_print( L"\n\t\tclause failed.\n", DEBUG_EVAL );
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
+            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L" failed.\n", DEBUG_EVAL );
 #endif
         }
     } else {
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index ff15ea4..ef442f7 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -3,7 +3,7 @@
 result=0
 
 expected='t'
-output=`target/psse <
Date: Wed, 18 Mar 2026 12:22:12 +0000
Subject: [PATCH 85/90] Found and fixed a bug I did not previously know about
 in `println`.

---
 src/init.c            | 2 +-
 src/io/print.c        | 2 --
 src/memory/stack.c    | 4 ++--
 unit-tests/memberp.sh | 1 +
 4 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/init.c b/src/init.c
index 6e6b106..b0042fb 100644
--- a/src/init.c
+++ b/src/init.c
@@ -454,7 +454,7 @@ int main( int argc, char *argv[] ) {
                    &lisp_print );
     bind_function( L"println",
                    L"`(println stream)`: Print a new line character to `stream`, if specified, else to `*out*`.",
-                   &lisp_print );
+                   &lisp_println );
     bind_function( L"put!", L"", lisp_hashmap_put );
     bind_function( L"put-all!",
                    L"`(put-all! dest source)`: If `dest` is a namespace and is writable, copies all key-value pairs from `source` into `dest`.",
diff --git a/src/io/print.c b/src/io/print.c
index f5f80a5..d9d2998 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -350,8 +350,6 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
         output = pointer2cell( out_stream ).payload.stream.stream;
 
         println( output );
-
-        free( output );
     }
 
     return NIL;
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 8908fc7..6cc68a0 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -97,8 +97,8 @@ struct cons_pointer in_make_empty_frame( struct cons_pointer previous,
         frame->depth = depth;
 
         /*
-         * clearing the frame with memset would probably be slightly quicker, but
-         * this is clear.
+         * The frame has already been cleared with memset in make_vso, but our
+         * NIL is not the same as C's NULL.
          */
         frame->more = NIL;
         frame->function = NIL;
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index ef442f7..a20a8b7 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -60,6 +60,7 @@ output=`target/psse $1 <
Date: Wed, 18 Mar 2026 13:27:19 +0000
Subject: [PATCH 86/90] Fixed a segfault when the system can initialise no more
 pages.

Still not fixed the `member?` bug.
---
 lisp/member.lisp      | 28 ++++++++++++++++------------
 src/memory/conspage.c | 12 +++++++-----
 unit-tests/memberp.sh |  4 ++--
 3 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/lisp/member.lisp b/lisp/member.lisp
index b67a7e3..1e0df38 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -1,14 +1,18 @@
-(set! nil? (lambda 
-          (o) 
-          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
-          (= o nil)))
+(set! nil? (lambda (o) (= (type o) "NIL ")))
 
-(set! member? (lambda
-            (item collection)
-            "`(member? item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            (cond
-              ((nil? collection) nil)
-              ((= item (car collection)) t)
-              (t (member? item (cdr collection))))))
+(set! CDR (lambda (o) 
+  (print (list "in CDR; o is: " o) *log*) 
+  (let ((r . (cdr o))) 
+    (print (list "; returning: " r) *log*) 
+    (println *log*) 
+    (println *log*) 
+    r)))
 
-;; (member? (type member?) '("LMDA" "NLMD"))
+(set! member? 
+  (lambda
+    (item collection)
+    (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
+    (cond
+      ((nil? collection) nil)
+      ((= item (car collection)) t)
+      (t (member? item (CDR collection))))))
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 3d96647..9c6ea20 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -65,7 +65,11 @@ struct cons_page *conspages[NCONSPAGES];
  * that exception would have to have been pre-built.
  */
 void make_cons_page(  ) {
-    struct cons_page *result = malloc( sizeof( struct cons_page ) );
+    struct cons_page *result = NULL;
+
+    if ( initialised_cons_pages < NCONSPAGES) {
+        result = malloc( sizeof( struct cons_page ) );
+    }
 
     if ( result != NULL ) {
         conspages[initialised_cons_pages] = result;
@@ -116,12 +120,10 @@ void make_cons_page(  ) {
 
         initialised_cons_pages++;
     } else {
-        debug_printf( DEBUG_ALLOC,
-                      L"FATAL: Failed to allocate memory for cons page %d\n",
-                      initialised_cons_pages );
+        fwide( stderr, 1 );
+        fwprintf( stderr, L"FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages );
         exit( 1 );
     }
-
 }
 
 /**
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index a20a8b7..f3a50af 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -53,7 +53,7 @@ else
 fi
 
 
-expected='nil'
+expected='nil'(CDR )
 output=`target/psse $1 <
Date: Wed, 18 Mar 2026 20:44:18 +0000
Subject: [PATCH 87/90] Work on the 'member?' bug - (issue #8) -- which turns
 out to be assoc/interned.

Progress has been made, but this is not fixed.
---
 src/ops/intern.c      | 36 +++++++++++++++++++++++++++++++++---
 src/ops/intern.h      |  3 +++
 src/ops/lispops.c     | 19 ++++++++++++++-----
 unit-tests/memberp.sh |  4 ++--
 4 files changed, 52 insertions(+), 10 deletions(-)

diff --git a/src/ops/intern.c b/src/ops/intern.c
index bba5ee5..6221b2a 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -191,7 +191,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
             for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
                   pair = c_car( assoc ) ) {
                 /* TODO: this is really hammering the memory management system, because
-                 * it will make a new lone for every key/value pair added. Fix. */
+                 * it will make a new clone for every key/value pair added. Fix. */
                 if ( consp( pair ) ) {
                     mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
                 } else if ( hashmapp( pair ) ) {
@@ -338,6 +338,7 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             result =
                                                 return_key ? c_car( entry_ptr )
                                                 : c_cdr( entry_ptr );
+                                            break;
                                         }
                                         break;
                                     case HASHTV:
@@ -426,7 +427,7 @@ struct cons_pointer interned( struct cons_pointer key,
 }
 
 /**
- * @brief Implementation of `interned?` in C: predicate wrapped around interned.
+ * @brief Implementation of `interned?` in C.
  * 
  * @param key the key to search for.
  * @param store the store to search in.
@@ -434,7 +435,36 @@ struct cons_pointer interned( struct cons_pointer key,
  */
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer store ) {
-    return nilp( interned( key, store ) ) ? NIL : TRUE;
+    struct cons_pointer result = NIL;
+
+    if ( consp( store ) ) {
+        for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair );
+                pair = c_car( store ) ) {
+            if ( consp( pair ) ) {
+                if ( equal( c_car( pair), key)) {
+                    // yes, this should be `eq`, but if symbols are correctly 
+                    // interned this will work efficiently, and if not it will
+                    // still work.
+                    result = TRUE; 
+                }
+            } else if ( hashmapp( pair ) ) {
+                result=internedp( key, pair); 
+            } 
+            
+            store = c_cdr( store );
+        }
+    } else if ( hashmapp( store ) ) {
+        struct vector_space_object *map = pointer_to_vso( store );
+
+        for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
+            for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
+                  !nilp( c ); c = c_cdr( c ) ) {
+                result = internedp( key, c);
+            }
+        }
+    }
+
+    return result;
 }
 
 /**
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 18fc084..e54ae7b 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -75,4 +75,7 @@ struct cons_pointer deep_bind( struct cons_pointer key,
 struct cons_pointer intern( struct cons_pointer key,
                             struct cons_pointer environment );
 
+struct cons_pointer internedp( struct cons_pointer key,
+                               struct cons_pointer store );                            
+
 #endif
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 914301d..98c518f 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -919,17 +919,26 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
 struct cons_pointer c_keys( struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
-    if ( hashmapp( store ) ) {
-        result = hashmap_keys( store );
-    } else if ( consp( store ) ) {
-        for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) {
-            result = make_cons( c_car( c ), result );
+    if ( consp( store ) ) {
+        for ( struct cons_pointer pair = c_car( store ); !nilp( pair );
+                pair = c_car( store ) ) {
+            if ( consp( pair ) ) {
+                result = make_cons( c_car( pair), result);
+            } else if ( hashmapp( pair ) ) {
+                result=c_append( hashmap_keys( pair), result);
+            } 
+            
+            store = c_cdr( store );
         }
+    } else if ( hashmapp( store ) ) {
+        result = hashmap_keys( store );
     }
 
     return result;
 }
 
+
+
 struct cons_pointer lisp_keys( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env ) {
diff --git a/unit-tests/memberp.sh b/unit-tests/memberp.sh
index f3a50af..e1795fc 100644
--- a/unit-tests/memberp.sh
+++ b/unit-tests/memberp.sh
@@ -53,14 +53,14 @@ else
 fi
 
 
-expected='nil'(CDR )
+expected='nil'
 output=`target/psse $1 <
Date: Wed, 18 Mar 2026 21:35:34 +0000
Subject: [PATCH 88/90] 'Fixed' issue #8; but done so by introducing a `goto`.
 Not entirely happy about this.

---
 lisp/member.lisp      |  4 ++--
 src/arith/integer.c   |  5 ++---
 src/debug.h           |  2 +-
 src/init.c            | 13 ++++++++-----
 src/io/io.c           |  4 ++--
 src/memory/conspage.c |  6 ++++--
 src/memory/dump.c     |  8 ++++----
 src/memory/stack.c    |  9 +++++----
 src/ops/intern.c      | 22 +++++++++++-----------
 src/ops/intern.h      |  2 +-
 src/ops/lispops.c     | 41 +++++++++++++++++++++++------------------
 11 files changed, 63 insertions(+), 53 deletions(-)

diff --git a/lisp/member.lisp b/lisp/member.lisp
index 1e0df38..b1225cd 100644
--- a/lisp/member.lisp
+++ b/lisp/member.lisp
@@ -11,8 +11,8 @@
 (set! member? 
   (lambda
     (item collection)
-    (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
+    ;; (print (list "in member?: " 'item item 'collection collection) *log*)(println *log*)
     (cond
       ((nil? collection) nil)
       ((= item (car collection)) t)
-      (t (member? item (CDR collection))))))
+      (t (member? item (cdr collection))))))
diff --git a/src/arith/integer.c b/src/arith/integer.c
index 3688ff5..682efd0 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -245,8 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
         debug_print( L"\n", DEBUG_ARITH );
 
         if ( carry == 0 && rv >= 0 && rv < SMALL_INT_LIMIT && is_first_cell ) {
-            result =
-                acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL ); 
+            result = acquire_integer( ( int64_t ) ( rv & MAX_INTEGER ), NIL );
             break;
         } else {
             struct cons_pointer new = make_integer( 0, NIL );
@@ -262,7 +261,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
             is_first_cell = false;
         }
     }
-    
+
     debug_print( L"add_integers returning: ", DEBUG_ARITH );
     debug_print_object( result, DEBUG_ARITH );
     debug_println( DEBUG_ARITH );
diff --git a/src/debug.h b/src/debug.h
index 6c7c8cb..d08df7e 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -84,7 +84,7 @@
  * 
  * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
  */
- #define DEBUG_EQUAL 512
+#define DEBUG_EQUAL 512
 
 extern int verbosity;
 
diff --git a/src/init.c b/src/init.c
index b0042fb..48e4efa 100644
--- a/src/init.c
+++ b/src/init.c
@@ -50,9 +50,9 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
     struct cons_pointer result = pointer;
 
     if ( exceptionp( pointer ) ) {
-        struct cons_space_object * object = &pointer2cell( pointer);
+        struct cons_space_object *object = &pointer2cell( pointer );
         result = NIL;
-        
+
         fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
         URL_FILE *ustderr = file_to_url_file( stderr );
         fwide( stderr, 1 );
@@ -74,7 +74,8 @@ void maybe_bind_init_symbols(  ) {
         privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
     }
     if ( nilp( privileged_keyword_primitive ) ) {
-        privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" );
+        privileged_keyword_primitive =
+            c_string_to_lisp_keyword( L"primitive" );
     }
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
@@ -122,7 +123,8 @@ struct cons_pointer bind_function( wchar_t *name,
         make_cons( make_cons( privileged_keyword_primitive, TRUE ),
                    make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( privileged_keyword_documentation, d ),
+                                         ( privileged_keyword_documentation,
+                                           d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
@@ -151,7 +153,8 @@ struct cons_pointer bind_special( wchar_t *name,
         make_cons( make_cons( privileged_keyword_primitive, TRUE ),
                    make_cons( make_cons( privileged_keyword_name, n ),
                               make_cons( make_cons
-                                         ( privileged_keyword_documentation, d ),
+                                         ( privileged_keyword_documentation,
+                                           d ),
                                          NIL ) ) );
 
     struct cons_pointer r =
diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index 9c6ea20..31ab050 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -67,7 +67,7 @@ struct cons_page *conspages[NCONSPAGES];
 void make_cons_page(  ) {
     struct cons_page *result = NULL;
 
-    if ( initialised_cons_pages < NCONSPAGES) {
+    if ( initialised_cons_pages < NCONSPAGES ) {
         result = malloc( sizeof( struct cons_page ) );
     }
 
@@ -121,7 +121,9 @@ void make_cons_page(  ) {
         initialised_cons_pages++;
     } else {
         fwide( stderr, 1 );
-        fwprintf( stderr, L"FATAL: Failed to allocate memory for cons page %d\n", initialised_cons_pages );
+        fwprintf( stderr,
+                  L"FATAL: Failed to allocate memory for cons page %d\n",
+                  initialised_cons_pages );
         exit( 1 );
     }
 }
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index 6cc68a0..0188e6b 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -66,7 +66,8 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
         // debug_printf( DEBUG_STACK,
         //               L"\nget_stack_frame: all good, returning %p\n", result );
     } else {
-        debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
+        debug_print( L"\nget_stack_frame: fail, returning NULL\n",
+                     DEBUG_STACK );
     }
 
     return result;
@@ -133,8 +134,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
     if ( stack_limit == 0 || stack_limit > depth ) {
         result = in_make_empty_frame( previous, depth );
     } else {
-        debug_printf( DEBUG_STACK, 
-            L"WARNING: Exceeded stack limit of %d\n", stack_limit);
+        debug_printf( DEBUG_STACK,
+                      L"WARNING: Exceeded stack limit of %d\n", stack_limit );
         result =
             make_exception( c_string_to_lisp_string
                             ( L"Stack limit exceeded." ), previous );
@@ -187,7 +188,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                 debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
                               frame->args );
                 debug_print_object( cell.payload.cons.car, DEBUG_STACK );
-                debug_print(L"\n", DEBUG_STACK);
+                debug_print( L"\n", DEBUG_STACK );
                 set_reg( frame, frame->args, val );
             }
 
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 6221b2a..989686b 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -338,13 +338,11 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             result =
                                                 return_key ? c_car( entry_ptr )
                                                 : c_cdr( entry_ptr );
-                                            break;
+                                            goto found;
                                         }
                                         break;
                                     case HASHTV:
                                     case NAMESPACETV:
-                                        // TODO: I think this should be impossible, and we should maybe
-                                        // throw an exception.
                                         result =
                                             hashmap_get( entry_ptr, key,
                                                          return_key );
@@ -414,6 +412,8 @@ struct cons_pointer search_store( struct cons_pointer key,
                                             c_type( key ) ), NIL );
     }
 
+  found:
+
     debug_print( L"search-store: returning `", DEBUG_BIND );
     debug_print_object( result, DEBUG_BIND );
     debug_print( L"`\n", DEBUG_BIND );
@@ -438,19 +438,19 @@ struct cons_pointer internedp( struct cons_pointer key,
     struct cons_pointer result = NIL;
 
     if ( consp( store ) ) {
-        for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair );
-                pair = c_car( store ) ) {
+        for ( struct cons_pointer pair = c_car( store );
+              eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
             if ( consp( pair ) ) {
-                if ( equal( c_car( pair), key)) {
+                if ( equal( c_car( pair ), key ) ) {
                     // yes, this should be `eq`, but if symbols are correctly 
                     // interned this will work efficiently, and if not it will
                     // still work.
-                    result = TRUE; 
+                    result = TRUE;
                 }
             } else if ( hashmapp( pair ) ) {
-                result=internedp( key, pair); 
-            } 
-            
+                result = internedp( key, pair );
+            }
+
             store = c_cdr( store );
         }
     } else if ( hashmapp( store ) ) {
@@ -459,7 +459,7 @@ struct cons_pointer internedp( struct cons_pointer key,
         for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
             for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
                   !nilp( c ); c = c_cdr( c ) ) {
-                result = internedp( key, c);
+                result = internedp( key, c );
             }
         }
     }
diff --git a/src/ops/intern.h b/src/ops/intern.h
index e54ae7b..0b8f657 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -76,6 +76,6 @@ struct cons_pointer intern( struct cons_pointer key,
                             struct cons_pointer environment );
 
 struct cons_pointer internedp( struct cons_pointer key,
-                               struct cons_pointer store );                            
+                               struct cons_pointer store );
 
 #endif
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 98c518f..3c0c55b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( privileged_keyword_name,
-                                                   fn_cell->payload.function.
-                                                   meta ) ),
+                                                   fn_cell->payload.
+                                                   function.meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -416,7 +416,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.function.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -490,7 +493,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.special.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -921,13 +927,13 @@ struct cons_pointer c_keys( struct cons_pointer store ) {
 
     if ( consp( store ) ) {
         for ( struct cons_pointer pair = c_car( store ); !nilp( pair );
-                pair = c_car( store ) ) {
+              pair = c_car( store ) ) {
             if ( consp( pair ) ) {
-                result = make_cons( c_car( pair), result);
+                result = make_cons( c_car( pair ), result );
             } else if ( hashmapp( pair ) ) {
-                result=c_append( hashmap_keys( pair), result);
-            } 
-            
+                result = c_append( hashmap_keys( pair ), result );
+            }
+
             store = c_cdr( store );
         }
     } else if ( hashmapp( store ) ) {
@@ -1270,14 +1276,14 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
                                     env ) );
 
 #ifdef DEBUG
-            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
-            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL );
+            debug_print_object( clause, DEBUG_EVAL );
             debug_print( L" succeeded; returning: ", DEBUG_EVAL );
             debug_print_object( result, DEBUG_EVAL );
             debug_println( DEBUG_EVAL );
         } else {
-            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
-            debug_print_object( clause, DEBUG_EVAL);
+            debug_print( L"\n\t\tCond clause ", DEBUG_EVAL );
+            debug_print_object( clause, DEBUG_EVAL );
             debug_print( L" failed.\n", DEBUG_EVAL );
 #endif
         }
@@ -1626,14 +1632,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 788cb48b37a462ce1760b90d61ef696707c97401 Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 19 Mar 2026 13:38:50 +0000
Subject: [PATCH 89/90] Ready for release 0.0.6 (still lots of bugs).

---
 Makefile                                      |   2 +-
 docs/Home.md                                  |  70 ++++-
 docs/Roadmap.md                               |  41 ++-
 docs/State-of-play.md                         |  14 +
 ...The-worlds-slowest-ever-rapid-prototype.md | 240 ++++++++++++++++++
 src/init.c                                    |   4 +-
 src/io/io.c                                   |   4 +-
 src/memory/dump.c                             |   8 +-
 src/ops/lispops.c                             |  23 +-
 9 files changed, 371 insertions(+), 35 deletions(-)
 create mode 100644 docs/The-worlds-slowest-ever-rapid-prototype.md

diff --git a/Makefile b/Makefile
index 27780a5..bc2952b 100644
--- a/Makefile
+++ b/Makefile
@@ -50,7 +50,7 @@ coredumps:
 	ulimit -c unlimited
 
 repl:
-	$(TARGET) -p 2> psse.log
+	$(TARGET) -ps1000 2> tmp/psse.log
 
 
 -include $(DEPS)
diff --git a/docs/Home.md b/docs/Home.md
index f9019a6..b4dfc0e 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -38,25 +38,59 @@ This project is necessarily experimental and exploratory. I write code, it revea
 
 ## Building
 
-The substrate of this system is written in plain old fashioned C and built with a Makefile. I regret this decision; I think either Zig or Rust would have been better places to start; but neither of them were sufficiently well developed to support what I wanted to do when I did start.
+The substrate of this version is written in plain old fashioned C and built with a Makefile. I regret this decision; I think either Zig or Rust would have been better places to start; but neither of them were sufficiently well developed to support what I wanted to do when I did start.
 
 To build, you need a C compiler; I use GCC, others may work. You need a make utility; I use GNU Make. You need [libcurl](https://curl.se/libcurl/).
 
 With these dependencies in place, clone the repository from [here](https://git.journeyman.cc/simon/post-scarcity/), and run `make` in the resulting project directory. If all goes well you will find and executable, `psse`, in the target directory.
 
+This has been developed on Debian but probably builds on any 64 bit UN*X; however I do **not** guarantee this.
+
+### Make targets
+
+#### default
+
+The default `make` target will produce an executable as `target/psse`.
+
+#### clean
+
+`make clean` will remove all compilation detritus; it will also remove temporary files.
+
+#### doc
+
+`make doc` will generate documentation in the `doc` directory. Depends on `doxygen` being present on your system.
+
+#### format
+
+`make format` will standardise the formay of C code. Depends on the GNU `indent` program being present on your system.
+
+#### REPL
+
+`make repl` will start a read-eval-print loop. `*log*` is directed to `tmp/psse.log`.
+
+#### test
+
+`make test` will run all unit tests.
+
 ## In use
 
 What works just now is a not very good, not very efficient Lisp interpreter which does not conform to any existing Lisp standard. You can start a REPL, and you can write and evaluate functions. You can't yet save or load your functions. It's interesting mainly because of its architecture, and where it's intended to go, rather than where it is now.
 
+### Documentation
+
+There is [documentation](https://www.journeyman.cc/post-scarcity/doc/html/).
+
 ### Invoking
 
-When invoking the system, the following invocation arguments may be passed:
+The binary is canonically named `psse`. When invoking the system, the following invocation arguments may be passed:
 ```
         -d      Dump memory to standard out at end of run (copious!);
         -h      Print this message and exit;
         -p      Show a prompt (default is no prompt);
+        -s LIMIT
+                Set a limit to the depth the stack can extend to;
         -v LEVEL
-                Set verbosity to the specified level (0...512)
+                Set verbosity to the specified level (0...1024)
                 Where bits are interpreted as follows:
                 1       ALLOC;
                 2       ARITH;
@@ -66,7 +100,8 @@ When invoking the system, the following invocation arguments may be passed:
                 32      INPUT/OUTPUT;
                 64      LAMBDA;
                 128     REPL;
-                256     STACK.
+                256     STACK;
+                512     EQUAL.
 ```
 
 Note that any verbosity level produces a great deal of output, and although standardising the output to make it more legible is something I'm continually working on, it's still hard to read the output. It is printed to stderr, so can be redirected to a file for later analysis, which is the best plan.
@@ -77,7 +112,10 @@ The following functions are provided as of release 0.0.6:
 
 | Symbol | Type | Documentation |
 | ------ | ---- | ------------- |
-| * | FUNC | `(* args...)` Multiplies these `args`, all of which should be numbers, and return the product. |
+| `*` | FUNC | `(* args...)` Multiplies these `args`, all of which should be numbers, and return the product. |
+| `*in*` | READ | The standard input stream. |
+| `*log*` | WRIT | The standard logging stream (stderr). |
+| `*out*` | WRIT | The standard output stream. |
 | + | FUNC | `(+ args...)`: If `args` are all numbers, returns the sum of those numbers. |
 | - | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | / | FUNC | `(/ a b)`: Divides `a` by `b` and returns the result. Expects both arguments to be numbers. |
@@ -112,7 +150,7 @@ The following functions are provided as of release 0.0.6:
 | multiply | FUNC | `(multiply args...)` Multiply these `args`, all of which should be numbers, and return the product. |
 | negative? | FUNC | `(negative? n)`: Return `t` if `n` is a negative number, else `nil`. |
 | nlambda | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
-| not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. |
+| not | FUNC | `(not arg)`: Return `t` only if `arg` is `nil`, else `nil`. |
 | nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. |
 | oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. |
 | open | FUNC | `(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading. |
@@ -127,14 +165,26 @@ The following functions are provided as of release 0.0.6:
 | read-char | FUNC | `(read-char stream)`: Return the next character. If `stream` is specified and is a read stream, then read from that stream, else the stream which is the value of  `*in*` in the environment. |
 | repl | FUNC | `(repl prompt input output)`: Starts a new read-eval-print-loop. All arguments are optional. If `prompt` is present, it will be used as the prompt. If `input` is present and is a readable stream, takes input from that stream. If `output` is present and is a writable stream, prints output to that stream. |
 | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. |
-| set | FUNC | null |
+| set | FUNC | `(set symbol value namespace)`: Binds the value `symbol` in the specified  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace. |
 | set! | SPFM | `(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace. |
 | slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. |
 | source | FUNC | `(source  object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. |
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
-| throw | FUNC | null |
+| throw | FUNC | `(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).|
 | time | FUNC | `(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch. |
-| try | SPFM | null |
+| try | SPFM | `(try forms... (catch symbol forms...))`: Doesn't work yet! |
 | type | FUNC | `(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change. |
-| λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ funtion. |
+| λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ function. |
+
+## Known bugs 
+
+The following bugs are known in 0.0.6:
+
+1. bignum arithmetic does not work (returns wrong answers, does not throw exception);
+2. subtraction of ratios is broken (returns wrong answers, does not throw exception);
+3. equality of hashmaps is broken (returns wrong answers, does not throw exception);
+4. The garbage collector doesn't work at all well.
+
+There are certainly very many unknown bugs.
+
 
diff --git a/docs/Roadmap.md b/docs/Roadmap.md
index 7cd654b..fb83875 100644
--- a/docs/Roadmap.md
+++ b/docs/Roadmap.md
@@ -15,6 +15,41 @@ However, while I will fix bugs where I can, it's good enough for other people to
 
 ## Next major milestones
 
+### New substrate language?
+
+I really don't feel competent to write the substrate in C, and I don't think 
+that what exists of the substrate is of sufficient quality. It's too big and
+too complex. I think what the system needs is a smaller substrate written in
+a more modern language. 
+
+I propose to evaluate both [Zig](https://ziglang.org/) and 
+[Rust](https://rust-lang.org/), and see whether I can feel more productive in
+either of those. 
+
+### Smaller substrate
+
+However, I also think the substrate ought to be smaller. I
+do not think the substrate should include things like bignum or ratio 
+arithmetic, for example. I'm not convinced that it should include things like
+hashmaps. If these things are to be written in Lisp, though, it means that 
+there have to be Lisp functions which manipulate memory a long way below the
+'[don't know, don't care](Post-scarcity-software.md#store-name-and-value)' 
+dictum; this means that these functions have to be system private. But they
+can be, because access control lists on arbitrary objects have always been
+part of this architecture.
+
+### The 0.1.0 branch
+
+I'm therefore proposing, immediately, to upversion the `develop` branch to
+0.1.0, and restart pretty much from scratch. For now, the C code will remain in
+the development tree, and I may fix bugs which annoy me (and possibly other
+people), but I doubt there now will be a 0.0.7 release, unless I decide that
+the new substrate languages are a bust. 
+
+So release 0.1.0, which I'll target for 1st January 2027, will 
+essentially be a Lisp interpreter running on the new substrate and memory
+architecture, without any significant new features.
+
 ### Simulated hypercube
 
 There is really no point to this whole project while it remains a single thread running on a single processor. Until I can pass off computation to peer neighbours, I can't begin to understand what the right strategies are for when to do so.
@@ -27,11 +62,11 @@ For most other things, my hunch is that you pass args which are not self-evaluat
 
 But before that can happen, we need a router on each node which can monitor concurrent traffic on six bidirectional links. I think at least initially what gets written across those links is just S-expressions.
 
-I think a working simulated hypercube is the key milestone for version 0.0.7.
+I think a working simulated hypercube is the key milestone for version 0.1.1.
 
 ### Sysout, sysin, and system persistance
 
-Doctrine is that the post scarcity computing environment doesn't have a file system, but nevertheless we need some way of making an image of a working system so that, after a catastrophic crash or a power outage, it can be brought back up to a known good state. This also really needs to be in 0.0.7. 
+Doctrine is that the post scarcity computing environment doesn't have a file system, but nevertheless we need some way of making an image of a working system so that, after a catastrophic crash or a power outage, it can be brought back up to a known good state. This also really needs to be in 0.1.1. 
 
 ### Better command line experience
 
@@ -39,7 +74,7 @@ The current command line experience is embarrassingly poor. Recallable input his
 
 ### Users, groups and ACLs
 
-Allowing multiple users to work together within the same post scarcity computing environment while retaining security and privacy is a major goal. So working out ways for users to sign on and be authenticated, and to configure their own environment, and to set up their own access control lists on objects they create, needs to be another nearish term goal. Probably 0.0.8.
+Allowing multiple users to work together within the same post scarcity computing environment while retaining security and privacy is a major goal. So working out ways for users to sign on and be authenticated, and to configure their own environment, and to set up their own access control lists on objects they create, needs to be another nearish term goal. Probably 0.1.2.
 
 ### Homogeneities, regularities, slots, migration, permeability
 
diff --git a/docs/State-of-play.md b/docs/State-of-play.md
index 6ad9c69..55d9bab 100644
--- a/docs/State-of-play.md
+++ b/docs/State-of-play.md
@@ -1,5 +1,19 @@
 # State of Play
 
+## 20260319
+
+Right, the `member?` bug [is fixed](https://git.journeyman.cc/simon/post-scarcity/issues/11).
+There are, of course, lots more bugs. But I nevertheless propose to release
+0.0.6 **now**, because there will always be more bugs, quite a lot works, and
+I'm thinking about completely rearchitecting the memory system and, at the same
+time, trying once more to move away from C.
+
+The reasons are given in [this essay](The-worlds-slowest-ever-rapid-prototype.md).
+
+This, of course, completely invalidates the [roadmap](Roadmap.md) that I wrote 
+less than a month ago, but that's because I really have been thinking seriously
+about the future of this project. 
+
 ## 20260316
 
 OK, where we're at: 
diff --git a/docs/The-worlds-slowest-ever-rapid-prototype.md b/docs/The-worlds-slowest-ever-rapid-prototype.md
new file mode 100644
index 0000000..00d42ac
--- /dev/null
+++ b/docs/The-worlds-slowest-ever-rapid-prototype.md
@@ -0,0 +1,240 @@
+# Vector space, Pages, Mark-but-don't-sweep, and the world's slowest ever rapid prototype
+
+By: Simon Brooke :: 13 March 2026
+
+I started work on the Post-scarcity Software Environment on the second of January, 2017; which is to say, more than nine years ago. It was never intended to be a rapid prototype; it was intended, largely, to be a giant thought experiment. But now enough of it does work that I can see fundamental design mistakes, and I'm thinking about whether it's time to treat it as a rapid prototype: to take what has been learned from this code, and instead of trying to fix those mistakes, to start again from scratch.
+
+So what are the mistakes?
+
+## Allocating only cons-sized objects in pages
+
+### What currently happens
+
+The current post-scarcity prototype allocates objects that are the size of a cons cell in 'cons pages'. A cons page is an object that floats in vector space, which is to say the heap, which has a header to identify it, followed by an array of slots each of which is the size of a cons cell. When a cons page is initialised, each slot is initialised as a FREE object, and these are linked together onto the front of the global free list.
+
+A cons pointer comprises a page part and an offset part. The exact size of these two parts is implementation dependent, but in the present implementation they're both uint32_t, which essentially means you can address four billion pages each of four billion slots; consequently, the size of the pointer is 64 bits, which means that the size of the payload of a cons cell is 128 bits. But a cons cell also needs a header to do housekeeping in, which is
+
+struct cons_space_object {
+    union {
+        /** the tag (type) of this cell,
+         * considered as bytes */
+        char bytes[TAGLENGTH];
+        /** the tag considered as a number */
+        uint32_t value;
+    } tag;
+    /** the count of the number of references to this cell */
+    uint32_t count;
+    /** cons pointer to the access control list of this cell */
+    struct cons_pointer access;
+//...
+
+which is to say, 32 bits tag, 32 bits reference count, 64 bits access control list pointer, total 16 bytes. So the whole cell is 32 bytes.
+
+We currently have nineteen different types of object which can fit into the size of the payload of a cons cell (plus FREE, which is sort of a non-object, but must exist), namely
+
+
+|​	| Tag (byte string) 	| Tag (numeric)	| Interpretation |
+| ---- | ---- | ---- | ---- |
+| 1	| CONS	| 1397641027	| An ordinary cons cell. | 
+| 2	| EXEP	| 1346721861	| An exception.| 
+| 3	| FREE	| 1162170950	| An unallocated cell on the free list — should never be encountered by a Lisp function. | 
+| 4	| FUNC	| 1129207110	| An ordinary Lisp function — one whose arguments are pre-evaluated. | 
+| 5	| INTR	| 1381256777	| An integer number (bignums are integers). | 
+| 6	| KEYW	| 1465468235	| A keyword — an interned, self-evaluating string. | 
+| 7	| LMDA	| 1094995276	| A lambda cell. Lambdas are the interpretable (source) versions of functions.| 
+| 8	| LOOP	| 1347374924	| A loop exit is a special kind of exception which has exactly the same payload as an exception.| 
+| 9	| NIL	| 541870414	| The special cons cell at address {0,0} whose car and cdr both point to itself.| 
+| 10	| NLMD	| 1145916494	| An nlambda cell. NLambdas are the interpretable (source) versions of special forms.| 
+| 11	| RTIO	| 1330205778	| A rational number, stored as pointers to two integers representing dividend and divisor respectively| 
+| 12	| READ	| 1145128274	| An open read stream.| 
+| 13	| REAL	| 1279346002	| A real number, represented internally as an IEEE 754-2008 binary128.| 
+| 14	| SPFM	| 1296453715	| A special form — one whose arguments are not pre-evaluated but passed as provided.| 
+| 15	| STRG	| 1196577875	| A string of characters, organised as a linked list.| 
+| 16	| SYMB	| 1112365395	| A symbol is just like a keyword except not self-evaluating.| 
+| 17	| TIME	| 1162692948	| A time stamp, representing milliseconds since the big bang.| 
+| 18	| TRUE	| 1163219540	| The special cons cell at address {0,1} which is canonically different from NIL.| 
+| 19	| VECP	| 1346585942	| A pointer to an object in vector space.| 
+| 20	| WRIT	| 1414091351	| An open write stream.| 
+
+Obviously it is absurdly wasteful to allocate 32 bits to a tag for twenty different types of object, but
+
+1. The type system should be extensible; and
+2. While debugging, it is useful to have human-readable mnemonics as tags.
+
+But the point is, all these types of thing can be allocated into an identical footprint, which means that a cell can be popped off the free list and populated as any one of these; so that memory churn of objects of these types happens only in cons pages, not in the heap.
+Why this is a good thing
+
+Cons cells very often have quite transient life-cycles. They're allocated, and, in the majority of cases, deallocated, in the process of computation; of a single function call. Only a small minority of cons cells become parts of the values of interned symbols, and consequently retained in the long term. In other words, there is a lot of churn of cons cells. If you allocate and deallocate lots of small objects in the heap, the heap rapidly fragments, and then it becomes increasingly difficult to allocate new, larger objects.
+
+But by organising them in pages with an internal free list, we can manage that churn in managed space, and only bother the heap allocator when all the cells in all the pages that we currently have allocated are themselves allocated.
+
+Other objects which live in cons space, such as numbers, are also likely to experience considerable churn. Although I needed to solve the churn problem for cons cells, the fact that the same solution automatically generalises to all other cons space objects is a good thing.
+### Why this needs to be different in future anyway
+
+A two part cons pointer implies a single integrated address space, but in fact in a massively parallel machine we won't have that. In the final machine, the cons pointer would have to comprise three parts: a node part, a page part, and an offset part. And, indeed, in the next iteration of the project it ought to, because in the next iteration I do want to start experimenting with the hypercube topology. So actually, these parts are probably node: 32 bits; page; 8 bits; offset: 24 bits. So that you could have (in a fully populated machine) a hypercube of four billion nodes, each of which can locally address probably 256 pages each of sixteen million cells; and given that a cell is (currently) eight bytes, that's a total potential address space of 4,722,366,482,869,645,213,696 bytes, which is 4.7x1022, which is rather a lot.
+
+You also need an additional cell type, CACH, a cache cell, a specialisation of CONS, whose first pointer points to the (foreign) cell which is cached, and whose second pointer points to the local (i.e. in this node's cons space) copy. When a non-local cell is first requested by EVAL,
+
+1. the communications thread on the node requests it from the ('foreign') node which curates it;
+2. the foreign node increments the reference counter on its copy;
+3. the foreign node sends a representation of the content of the cell hoppity-hop across the grid to the requesting node;
+4. the requesting node pops a cell off its local free list, writes into it the content it has received, increments its reference counter to one, pops a second cell off its free list, writes CACH into the tag, the address of the foreign cell into the first pointer, the address of the newly created copy into the second, and returns this second cell.
+
+When the reference counter on a CACH cell is decremented to zero,
+
+1. the communications thread on the requesting node notifies the curating node that the reference can be decremented;
+2. the curating node decrements the reference and signals back that this has been done;
+3. the requesting node clears both cells and pushes them back onto its free list.
+
+### Why we should generalise this idea: stack frames
+
+We currently allocate stack frames in vector space, which is to say on the heap. The payload of a stack frame is currently 96 bytes (eleven cons pointers plus two 32 bit integers):
+
+```C
+/*
+ * number of arguments stored in a stack frame
+ */
+#define args_in_frame 8
+
+/**
+ * A stack frame. Yes, I know it isn't a cons-space object, but it's defined
+ * here to avoid circularity. \todo refactor.
+ */
+    struct stack_frame {
+        /** the previous frame. */
+        struct cons_pointer previous;
+        /** first 8 arument bindings. */
+        struct cons_pointer arg[args_in_frame];
+        /** list of any further argument bindings. */
+        struct cons_pointer more;
+        /** the function to be called. */
+        struct cons_pointer function;
+        /** the number of arguments provided. */
+        int args;
+        /** the depth of the stack below this frame */
+        int depth;
+    };
+```
+
+But because it's a Lisp object in vector space it also needs a vector space object header, so that we can identify it and manage it:
+
+```c
+/**
+ * the header which forms the start of every vector space object.
+ */
+    struct vector_space_header {
+    /** the tag (type) of this vector-space object. */
+    union {
+        /** the tag considered as bytes. */
+        char bytes[TAGLENGTH];
+        /** the tag considered as a number */
+        uint32_t value;
+    } tag;
+    /** back pointer to the vector pointer which uniquely points to this vso */
+    struct cons_pointer vecp;
+    /** the size of my payload, in bytes */
+    uint64_t size;
+    };
+```
+
+which is a further twenty bytes, so one hundred and sixteen bytes in total. We're allocating one of these objects every time we evaluate a function; we're deallocating one every time we leave a function. The present prototype will happily run up a stack of several tens of thousands of frames, and collapse it back down again, in a single recursive computation.
+
+That's a lot of churn.
+
+If we allocated stack frames in pages, in the same way that we allocate cons cells, that churn would never hit the heap allocator: we would not fragment the heap.
+Generalising the generalisation
+
+So we have one set of objects which are each 32 bytes, and one set which are each 116; and just as there are lots of things which are not cons cells which can be fitted into the payload footprint of a cons cell, so I suspect we may find, when we move on to implementing things like regularities, that there many things which are not stack frames which fit into the payload footprint of a stack frame, more or less.
+
+But the size of a stack frame is closely coupled to the number of registers of the actual hardware of the processor on the node; and though if I ever get round to building an actual prototype that's probably ARM64, I like the idea that there should at least in theory be a custom processor for nodes that runs Lisp on the metal, as the Symbolics Ivory did.
+
+So while a cons cell payload probably really is 128 bits for all time, a stack frame payload is more mutable. Eight argument registers and one 'more' register seems about right to me, but...
+
+However, if we say we will have a number of standard sizes of paged objects; that every paged object shall have the same sized header; that all objects on any given page shall be the same size; and that all pages shall fit into the same footprint (that is to say, a page with larger objects must needs have proportionally fewer of them), then we can say that the standard payload sizes, in bytes, shall be powers of two, and that we don't allocate a page for a standard size until we have a request to allocate an object of that size.
+
+So our standard sizes have payloads of 1, 2, 4, 8, 16, 32, 64, 128, 256, 512...
+
+I've highlighted 16 because that will accommodate all our existing cons space objects; 32 because that will accommodate my current implementation of hash tables and namespaces,128 because that will accommodate stack frames... But actually, we would do a much more efficient implementation of hash tables if we allocated an object big enough to have a separate pointer for each bucket, so we probably already have a need for three distinct standard sizes of object, and, as I say, I see benefit of having a generalised scheme.
+
+In the current prototype I'm allocating pages to fit only 1024 cons cells each, because I wanted to be able to test running a free list across multiple pages. My current idea of the final size of a cons page is that it should accommodate 16 million (224) cells, which is 134 million (227) bytes. So on the generalised scheme, we would be able in principle to allocate a single object of up to ~134 megabytes in a page that would fit sixteen million cells, and we would only need to introduce any fragmentation into the heap if we needed to allocate single objects larger than this.
+
+That seems a very big win.
+## Mark but don't sweep
+
+The post scarcity architecture was designed around the idea of a reference counting garbage collector, and I have a very clear idea of how you can make tracking references, and collecting garbage, work across a hypercube
+
+[^1]: I'm not certain I'm using the word hypercube strictly correctly; the topology I'm contemplating is more than three dimensions but fewer than four. However, the architecture would scale to fractal dimensions greater than four, although I think it would get progressively harder to physically build such machines as the dimensions increase.
+
+ in which pretty much every node is caching copies of objects which actually 'belong to', or are curated by, other nodes — provided that you can make reference counting work at all, which so far I'm struggling to do (but I think this is because I'm stupid, not because it's impossible).
+
+I don't yet have a clear account of how you could make a non-reference counting garbage collector work across a distributed network.
+
+However, I can see how, in having pages of equal sized objects, you can make garbage collection very much faster and can probably do it without even interrupting the evaluation thread.
+
+Conventional mark and sweep garbage collectors — including generational garbage collectors — implement the following algorithm:
+
+1. Halt execution of program evaluation;
+2. Trace every single pointer on every single object in the generation being collected, and mark the object each points to;
+3. Then go through every object in that generation, and those which have not been marked, schedule for overwriting;
+4. Then move objects which have been marked downwards in memory to fill the voids left by objects which have not been marked (this is the sweeping phase);
+5. Then correct all the pointers to all the objects which have been moved;
+6. If that didn't recover enough memory, repeat for the previous generation, recursively;
+7. Finally restart execution.
+
+This is a really complicated operation and takes considerable time. It's this which is the main cause of the annoying pauses in programs which use automatic memory management. Of course, in a reference counting system, when you remove the last link to the top node of a large data structure, there is a cascade of decrements below it, but these can take place in a separate thread and do not have to interrupt program execution.
+
+However, a large part of the cost of the mark-and-sweep algorithm is the sweep phase (and as I say, even generational systems have a sweep phase). The reason you need to sweep is to avoid fragmentation of the heap. If you allocate objects in equal sized pages each of equal sized objects, you can never fragment the heap, so (there is a problem here, but I'm going to ignore it for a moment and then come back to it), you never(ish) need to sweep.
+
+You instead, when a page becomes full,
+
+1. Don't halt program execution, but temporarily mark this page as locked (allocation can continue on other pages);
+2. In a separate thread, trace all the links in this page and pages newer than this page to objects in this page, and mark those objects
+      1. Obviously, if while this is happening the execution thread makes a new link to something on the locked page, then that something needs to be marked;
+3. Clear all the objects which have not been marked, and push them back onto the free list of the page;
+4. If all the objects on this page are now on the free list, deallocate this page. Otherwise, remove the locked marker on this page (allocation can resume on this page).
+
+Program execution never needs to halt. If the node hardware architecture has two cores, an execution core and a communications core, then garbage collection can run on the communications core, and execution doesn't even have to slow. If it proves in practice that this slows communications too much, then perhaps a third core is needed, or perhaps you shift garbage collection back to a separate thread on the evaluation core.
+The problem
+
+So, I said there was a problem. Obviously, a page which is empty (every object in it is FREE) can safely be deallocated, and another page, perhaps for objects of a different size, can later be allocated in the same real estate. The problem is that, in the worst case, you might end up with two (or more) pages for a given size of object each of which was less than half full, but neither of which was empty. I don't currently see how you can merge the two pages into one without doing a mark-and-sweep, and without interrupting execution.
+
+Also, if another node is holding a pointer to an object on one of the two half-empty pages, then the housekeeping to maintain track of which nodes hold pointers to what, and where that has been moved to, becomes very awkward.
+
+So it may be that a hypercube running mark-but-don't-sweep would eventually suffer from coronary artery disease, which would mean this architecture would be a bust. But it might also be that in practice this wouldn't happen; that newer pages — which is inevitably where churn would occur — would automatically empty and be deallocated in the normal course of computation. I don't know; it's quite likely but I certainly don't have a proof of it.
+
+## The substrate language
+
+### Emerging from the stone age
+
+I started work on the post scarcity software environment, as I say, nine years ago. At that time Rust could not do unions, and I was not aware of Zig at all. I needed — or at least, I thought I needed (and still do think I need) a language in which to write the substrate from which Lisp could be bootstrapped: a language in which the memory management layer would be written.
+
+I needed a language in which I could write as close to the metal as possible. I chose C, and because I'm allergic to the Byzantine complexity of C++, I chose plain old vanilla C. I've written large programs in C before, but it is not a language I'm comfortable with. When things break horribly in C — as they do — I really struggle. The thing which has really held development of this system back is that I tried to write bignum arithmetic in C, and I have utterly failed to get it working. And then spent literally years beating myself up about it.
+
+I've also failed to get my garbage collector working to my satisfaction; I don't think I'm incrementing and decrementing counters where I should be, and I feel that far too much garbage is not being collected. But it sort of works. Well enough for now.
+
+The solutions to these problems would probably be absurdly obvious to someone who is actually a good software engineer, rather than just cos-playing one, but they have proved beyond me.
+
+I've been unwilling to change the substrate language, because I've done an awful lot of work in the memory architecture in C and up to now I've been pretty satisfied with that work; and because Rust still doesn't look very appealing to me; and because I really have not yet fully evaluated Zig.
+
+However...
+
+If I am going to do a big rewrite of the bottom layer of the memory allocation system, then it would make sense to write it in a more modern language.
+A bootstrap made of bootstraps
+
+But more! One of the things I'm thinking looking at what I've built so far is that I've tried to do too much in the substrate. Bignums could have been implemented — much more easily, and probably not much less efficiently — in the Lisp layer. So could rationals (and complex numbers, and all sorts of other fancy number systems). So could hash tables and namespaces and regularities and homogeneities and all the other fancy data structures that I want to build.
+
+To do that, I would need a Lisp which had functions to do low level manipulation of memory structures, which is something I don't want 'user level' programmers to be able to do. But I already have a Lisp with access control lists on every data item, including functions. So it will be trivial to implement a :system privilege layer, and to have functions written at that :system privilege layer that most users would not be entitled to invoke.
+Conclusion, for now
+
+Of course, it's now the end of winter, and big software projects are, for me, these days, winter occupations; in summer there is too much to do outside.
+
+But I think my plan now is to
+
+1. get version 0.0.6 just a little bit more polished so that other people can — if they're mad enough — play with it; and then call the 0.0.X series done;
+2. start again with a new 0.1.X series, with a much shallower substrate written probably in Zig, with generalised paged memory objects;
+3. write the access control list system, something of a use authentication system, something of a privilege layer system;
+4. write Lisp functions which can directly manipulate memory objects, and, within the paged memory objects framework, define completely new types of memory objects;
+5. write the north, south, east, west, up, down internode communication channels, so that I can start patching together a virtual hypercube;
+6. write a launcher (in some language) which can launch n3 instances of the same Lisp image as processes on a single conventional UN*X machine, stitch their channels together so that they can communicate, and allow clients to connect (probably over SSH) so that users can open REPL sessions.
+
+If I ever get that completed, the next goal is probably a compiler, and the goal after that build a real physical hypercube of edge 2, probably using ARM or RISC-V processors.
\ No newline at end of file
diff --git a/src/init.c b/src/init.c
index 48e4efa..b0d18da 100644
--- a/src/init.c
+++ b/src/init.c
@@ -487,7 +487,9 @@ int main( int argc, char *argv[] ) {
     bind_function( L"subtract",
                    L"`(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers.",
                    &lisp_subtract );
-    bind_function( L"throw", L"", &lisp_exception );
+    bind_function( L"throw",
+                   L"`(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).",
+                   &lisp_exception );
     bind_function( L"time",
                    L"`(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch.",
                    &lisp_time );
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 3c0c55b..a9dd7ea 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -363,8 +363,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( privileged_keyword_name,
-                                                   fn_cell->payload.
-                                                   function.meta ) ),
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -416,10 +416,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -493,10 +490,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1632,13 +1626,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From e5e0de957c0572e47a386f9e0eea0aaa08199d8d Mon Sep 17 00:00:00 2001
From: Simon Brooke 
Date: Thu, 19 Mar 2026 13:49:56 +0000
Subject: [PATCH 90/90] Release 0.0.6!

---
 docs/Home.md  | 2 +-
 src/init.c    | 4 +++-
 src/version.h | 2 +-
 3 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/docs/Home.md b/docs/Home.md
index b4dfc0e..be2fad6 100644
--- a/docs/Home.md
+++ b/docs/Home.md
@@ -172,7 +172,7 @@ The following functions are provided as of release 0.0.6:
 | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. |
 | throw | FUNC | `(throw message cause)`: Throw an exception with this `message`, and, if specified, this `cause` (which is expected to be an exception but need not be).|
 | time | FUNC | `(time arg)`: Return a time object. If an `arg` is supplied, it should be an integer which will be interpreted as a number of microseconds since the big bang, which is assumed to have happened 441,806,400,000,000,000 seconds before the UNIX epoch. |
-| try | SPFM | `(try forms... (catch symbol forms...))`: Doesn't work yet! |
+| try | SPFM | `(try forms... (catch catch-forms...))`: Evaluate `forms` sequentially, and return the value of the last. If an exception is thrown in any, evaluate `catch-forms` sequentially in an environment in which `*exception*` is bound to that exception, and return the value of the last of these. |
 | type | FUNC | `(type object)`: returns the type of the specified `object`. Currently (0.0.6) the type is returned as a four character string; this may change. |
 | λ | SPFM | `(lamda arg-list forms...)`: Construct an interpretable λ function. |
 
diff --git a/src/init.c b/src/init.c
index b0d18da..0bfec24 100644
--- a/src/init.c
+++ b/src/init.c
@@ -537,7 +537,9 @@ int main( int argc, char *argv[] ) {
     bind_special( L"set!",
                   L"`(set! symbol value namespace)`: Binds `symbol` in  `namespace` to the value of `value`, altering the namespace in so doing, and returns `value`. If `namespace` is not specified, it defaults to the default namespace.",
                   &lisp_set_shriek );
-    bind_special( L"try", L"", &lisp_try );
+    bind_special( L"try",
+                  L"`(try forms... (catch catch-forms...))`: Evaluate `forms` sequentially, and return the value of the last. If an exception is thrown in any, evaluate `catch-forms` sequentially in an environment in which `*exception*` is bound to that exception, and return the value of the last of these.",
+                  &lisp_try );
     debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP );
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
 
diff --git a/src/version.h b/src/version.h
index 462f9be..5638bc6 100644
--- a/src/version.h
+++ b/src/version.h
@@ -8,4 +8,4 @@
  *  Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#define VERSION "0.0.6-SNAPSHOT"
+#define VERSION "0.0.6"