From c22ca16b8f8fe45cd0369fc805efc75034fe8bbd Mon Sep 17 00:00:00 2001
From: Anthony Howe <achowe@snert.com>
Date: Mon, 26 Aug 2024 07:54:33 -0400
Subject: [PATCH] GH-21 Fix CATCH and THROW from C back to Forth.

---
 src/post4.c        | 21 +++++++++++++++------
 src/post4.h        |  1 +
 src/post4.p4       |  3 +--
 test/exceptions.p4 |  5 +++++
 4 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/src/post4.c b/src/post4.c
index 767b56c..6820cca 100755
--- a/src/post4.c
+++ b/src/post4.c
@@ -1427,6 +1427,7 @@ p4Repl(P4_Ctx *ctx, int rc)
 		P4_WORD("_branch",	&&_branch,	P4_BIT_COMPILE, 0x00),	// p4
 		P4_WORD("_branchz",	&&_branchz,	P4_BIT_COMPILE, 0x10),	// p4
 		P4_WORD("_call",	&&_call,	P4_BIT_COMPILE, 0x0100),// p4
+		P4_WORD("catch_frame",	&&_frame,	0, 0x01),	// p4
 		P4_WORD("_ds",		&&_ds,		0, 0x03),	// p4
 		P4_WORD("_dsp@",	&&_dsp_get,	0, 0x01),	// p4
 		P4_WORD("_dsp!",	&&_dsp_put,	0, 0x10),	// p4
@@ -1558,7 +1559,9 @@ p4Repl(P4_Ctx *ctx, int rc)
 	}
 
 #define NEXT		goto _next
-#define THROW(x)	{ rc = (x); goto _thrown; }
+#define THROWHARD(e)	{ rc = (e); goto _thrown; }
+#define THROW(e)	{ if ((word = p4FindName(ctx, "THROW", STRLEN("THROW"))) != NULL) { \
+				P4_PUSH(ctx->ds, (P4_Int)(e)); goto _forth; } THROWHARD(e); }
 
 	static P4_Word w_inter_loop = P4_WORD("_inter_loop", &&_inter_loop, P4_BIT_HIDDEN, 0x00);
 	static P4_Word w_halt = P4_WORD("_halt", &&_halt, P4_BIT_HIDDEN, 0x00);
@@ -1580,7 +1583,7 @@ p4Repl(P4_Ctx *ctx, int rc)
 	case P4_THROW_SIGTERM:
 		/* Return shell equivalent exit status. */
 		(void) printf(crlf);
-		return 128+SIGTERM;
+		exit(128+SIGTERM);
 	case P4_THROW_UNDEFINED:
 		p4Bp(ctx);
 		/*@fallthrough@*/
@@ -1618,7 +1621,6 @@ p4Repl(P4_Ctx *ctx, int rc)
 		/* Historically no message, simply return to REPL. */
 _abort:		(void) fflush(stdout);
 		/* Set exit status within 1..255 */
-		rc = EXIT_FAILURE;
 		P4_RESET(ctx->ds);
 #ifdef HAVE_MATH_H
 		P4_RESET(ctx->fs);
@@ -1681,7 +1683,7 @@ _inter_loop:	while (ctx->input.offset < ctx->input.length) {
 			} else if (ctx->state == P4_STATE_COMPILE && !P4_WORD_IS_IMM(word)) {
 				p4WordAppend(ctx, (P4_Cell) word);
 			} else {
-				exec[0].w = word;
+_forth:				exec[0].w = word;
 				ip = exec;
 				NEXT;
 			}
@@ -1815,7 +1817,7 @@ _fsp_put:	w = P4_POP(ctx->ds);
 
 		// ( n -- )
 _longjmp:	w = P4_POP(ctx->ds);
-		THROW((int) w.n);
+		THROWHARD((int) w.n);
 
 		// ( -- x )
 		// : lit r> dup cell+ >r @ ;
@@ -2046,6 +2048,10 @@ _env:		P4_DROP(ctx->ds, 1);		// Ignore k, S" NUL terminates.
 		P4_PUSH(ctx->ds, (P4_Int)(x.s == NULL ? -1 : strlen(x.s)));
 		NEXT;
 
+		// ( -- addr )
+_frame:		P4_PUSH(ctx->ds, (P4_Cell *) &ctx->frame);
+		NEXT;
+
 		// ( -- addr )
 _trace:		P4_PUSH(ctx->ds, (P4_Cell *) &ctx->trace);
 		NEXT;
@@ -2428,8 +2434,11 @@ _included:	w = P4_POP(ctx->ds);
 		if ((cstr = strndup(x.s, w.u)) == NULL) {
 			THROW(P4_THROW_ALLOCATE);
 		}
-		(void) p4LoadFile(ctx, cstr);
+		rc = p4LoadFile(ctx, cstr);
 		free(cstr);
+		if (rc != 0) {
+			THROW(rc);
+		}
 		NEXT;
 
 
diff --git a/src/post4.h b/src/post4.h
index 4cce3bd..f609742 100755
--- a/src/post4.h
+++ b/src/post4.h
@@ -401,6 +401,7 @@ struct p4_ctx {
 	P4_Stack	fs;		/* Float stack */
 	P4_Int		precision;
 #endif
+	P4_Int		frame;		/* See CATCH and THROW. */
 	P4_Int          trace;          /* Word trace for debugging. */
 	P4_Int		level;		/* Tracing depth. */
 	P4_Int		state;
diff --git a/src/post4.p4 b/src/post4.p4
index d3ffb45..f4c3f2b 100755
--- a/src/post4.p4
+++ b/src/post4.p4
@@ -604,8 +604,6 @@ MAX-U MAX-N 2CONSTANT MAX-D
 \
 : DEFER@ >BODY @ ;
 
-VARIABLE catch_frame
-
 DEFER _fsp@
 DEFER _fsp!
 
@@ -2084,6 +2082,7 @@ BEGIN-STRUCTURE p4_ctx
 	p4_stack +FIELD ctx.fs	\ see _fs
 	FIELD: ctx.precision	\ see PRECISION and SET-PRECISION
 [THEN]
+	FIELD: ctx.frame  	\ see CATCH and THROW
 	FIELD: ctx.trace	\ see _trace
 	FIELD: ctx.level	\ see p4
 	FIELD: ctx.state	\ see STATE
diff --git a/test/exceptions.p4 b/test/exceptions.p4
index 7929d94..d0a360e 100644
--- a/test/exceptions.p4
+++ b/test/exceptions.p4
@@ -77,6 +77,11 @@ T{ 123 S" ABORT" ' EVALUATE CATCH NIP NIP -> 123 -1 }T
 T{ 123 S" 0 THROW" ' EVALUATE CATCH -> 123 0 }T
 T{ 123 S" -1 THROW" ' EVALUATE CATCH NIP NIP -> 123 -1 }T
 T{ 123 :NONAME 456 S" -1 THROW" ['] EVALUATE CATCH NIP NIP ; EXECUTE -> 123 456 -1 }T
+
+\ GH-21
+T{ 1 0 ' / CATCH NIP NIP -> -10 ( P4_THROW_DIV_ZERO) }T
+T{ S" INCLUDE /tmp/XYZZY" ' EVALUATE CATCH NIP NIP -> -38 ( P4_THROW_ENOENT) }T
+T{ S" i_am_not_number" ' EVALUATE CATCH NIP NIP -> -13 ( P4_THROW_UNDEFINED) }T
 test_group_end
 
 .( -56 THROW ) test_group