From d2101dbd473eff0984e540bd76b45cd4484803ff Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 24 Jul 2021 08:54:55 +0100 Subject: [PATCH] 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{