From d2101dbd473eff0984e540bd76b45cd4484803ff Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
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 <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <ctype.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#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
zcmeHOeQZ<L6~DF<2n8GiVGXc09wi#IiU|;Cpkmk|4lh;sC?qS}pf8T?BwqcI+0P}Z
z3ZqSnWThEMo3u{bAK9dCo%W$j`-e`I8VaTDq@nQ7#6+tx1e&vtHl#4ot>B$=-#PYs
zFOI0H{kL}&``q(8ANSsK@4LP?@7`|*JKCHMhv4KAUlGVncyz>10?#(e0P%}vu^7JV
z#DiiU@D&o%<$j%jR8N<jW?DtK3n<#vVx|oJq7DnDTtlR2H&>d(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=l<jbUd8)eB@FDwJc
z)UG{U0^Cd>Mq!kFQA0e+&%Zb`dh*<!bw@rKIrc`2a^-{Xe%;AFuuRm!g!VinkjMN2
z_@Iv7{^ud5V@NMXFC>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<iMAOl}SVoJcJ9qDl
zr;^dmP){6v^d(YB@}cUgWfk>)bU|-ofAR;L<p9nBl*emLEVdX&!2!auD`U|8PH`BO
zA@MxI&+ph09e<7H3C6n#uk!11#+kpgL&tGUVSPAVG2n8(BthPQ8=u2z1I}fj$!!CU
z<CoKE!si2k?dCLL!1)<M*}DcDpBGM(1{{6a$&P>>0XqVA1ndad5wIg*N8qzX;N$8C
z|E&!Fqe>a6{L^|Nl$RznXJJwqK38>CIw)*@0pOWJ{V<T~I)VEAD4Ci1OQBFWC3#%P
z%}iY^^0=U!nL1PCaX~jT^&95F+fnJQRY-rpH(2<33;%$HUvA_#{IflG@hK&DRT;iE
zy|1%lv~nKQKp9<p5-O&QZa)LX7naZXgt&PM*cD)_j8-m1vh}vM9GZRsWZ3itg)7x{
z$3b13B?|geC>-5<70J50N^V*?^WhHV%x#zAIImp1tJQ#mSII$D;Yx3H9kh$>F+Rt)
zqgZ4g=~9NbzkpdKcU@bgjBGyvOn&Nap^%S2aL!jA1>SKOY)$r4M?i><y1))Pt1)-<
zeI=Kjj3^@&^=qZO;Oz|)Z{qqme;K?fxnN!y3Fb#cE_m~u;5F=@zaJh6UQ=FCMr+;%
zPJnn)aZD;BRmy1a=I_u{$z4!#@8rJ;4o13elJ+8l_PfdmD4mCp{2ulwr_oLR5NHoW
z384O1@crk0C{bl3dpn|RYLb=HD)V0krT3s!)Zc+8J4UxZ1UtdNSKD)c40N^UZUs66
zxlg;4(S{m;4|J@%gJUwU-hsB9x#QC6He9Cu=*Z1<<UVZ8{WVai`Li;7)}d_uAp18Q
zuirQvI21S>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&#8|Jg?)&-J#FsV$Ez0}sX8uptlakSrZuY(M*BnXISqQ!5J5<YYw#Hd+z*r!
zmi01x&Omu@AsBRfPB?cip67fWY6Qgt^h@~kLtCOKZ*zN2I@{f~-*E-q-qDJnd+p1W
zt?tGX^AvaU@cdnFf70C?a5o0rYg^pj7I$rn+tcE%lJD<sg83=%V|;IhF70GTz>a_&
z0XqVA1ndad5wIg*N5GDN9f8jh0Y2Zy=lN)RRXjVlh@H@82wu#|l&3?MD~RWFgR6+=
zvwACu=ktTOU&6%lTXzd7<j3ex9`9{VS0Kt~QsJB)$zcmA)31r*`BO}_IuXl>G9fcD
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-<I#-I7d&pwc$MJ(G~){dj{`G)pWyLk#uo}6mu4KE(lY(xf?E{cvbb9e
zl*OyX@v^w5cwfU@?h?WCfEkC$!D~eHyh|(-d>-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<anEhNV0DLLL=L-FP(KIVo
zNSsS6Q6J#m5?jpuMB=l@&*Ol5#EMztXBps2owJ{pClD`sEoBmO;Lp#2j{%P5TF3LR
z0QZ*M7ISX^zQnmg@Vv}|_YlV#krDk2i%WoG+y<z!Q8LI&oUKdrO~`s++}8R_80LOT
zekSO-SWn_l0Y`n0p8z6N@Pm!z{+!11TZAtL9P4k@Ujew+>_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<u?)IH#iM)9N5ZwGxg9>?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+^{4buJycw<iYp^sMGg7Z*RC=ml^x;aEw_~1!N!00dc=zSgxe}Q4DfVo{y
zy#8a#`wJ3FUCtwY2tK%`XM0{JGWCMYn0Ot}*cQkb?GMtrk?9&%B+BzA!|fJ(UUxF}
zvLaEd{gZ(I3-$zDf8IAS<?{Ism9_pMu*W?U+w;DP=`@v#ZNxaUJ@0Q~fMJu_p4Yof
zd0z%9GNBJ+`W7&_=V5zZ7c<58Y?!$ItjF{i$Z!wEJg=XbHcD%~kBs#vSd2mjW6Jit
z&SpA6id??6{og117SiMOIMZ%}J;uyx|6{<gUhE%!+Vn)!y27;f|Bo#8Ub17lkK8e_
zxEDXO*z-PsDeKQ=KW?!<P6kZ<Y)F*-F@4=)KS2Vf_1rNQdv=TK3S<0u|G||1Kf(Ie
z_`OZ`#bUgqNwk_+CRTe~pJMrJ@A2xIOj~uf_-(bn3=*ULL9edLv<iiW#N&sd>yW`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<S1pt5HNdN!<

literal 8544
zcmeHNO=ufO7#+p=aT8<9fwnG<VeO!hAFxZ~Lum+=i<fL@+NQA`Odw1wS&2j>*+?rA
z9~=y-p^H%KV?r*$xs=jFjy<}xkWdUxa!C$4_>cq{8pzQUW97ZwS!=a!dvBQ!X6JkJ
z%{<NbW*266wEEZUt$jj7+Ju<jC4}fgS>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;#9Pb<T4`L~^lmEsS#dyxIM-dPQ
z$NTr4&)<9w&Yk`03v=YGe-9g>Jb`If+~kEIk8<7iemrL%(KCc-N7atnp97#UfImS!
zftvlOJ>!eO%rV+0#Cg<QZ`MI$UzV2pJ=g*M8^inEP_w{e!YPRkl)+N5Fqq9G2B&7T
zQ^2$jQ8<tH7gox5S3ev5!Mxvf>*B$ckI`nJL{LQMez(wfwd}YPISxO{n6jhDpFDgn
zgT~)w-i$GaJ&#@>jYxAYn9t~J(N5(CJ|DomG6{5o9YG=gcZQeOF@>p@Hm!hGKr5gX
z&<bb;v;taz|DOWmmh;jo{~7;<n_lPFhvp`8bmlfJr}V~hR_kRz%Q5R##jIDN&iL9x
zv&Ic-#jKq&H@d3a$E(3sb$rdLU|4dlW>to^Ea#c!{82wehU#g)bXt`!5gljrNd=u9
z^YH^w=N{BCSHM_ajyPs*{a&NdsF<5p`S<wc-x{$W5pTqPa<4z*dal}AMKwIyh|Qs1
zOyeTfUtv)CU3xWohv_|q7aJNFDt`J-YzmueZ=ZdL4lG!6&&)mb5NejBdJm+}y?6)q
z(ot`h4%BoAg7&R?|NCCmw^beNqkXM_RzNGD70?Q31+)TM0j+>mKr5gX&<bb;{#y!k
z_eV!L<L)>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{