Add compile-only check while interpreting.

SirWumpus · Sep 19, 2024 · 108e505 · 108e505
1 parent ff236ce
commit 108e505
Show file tree

Hide file tree

Showing 3 changed files with 6 additions and 3 deletions.
diff --git a/src/post4.c b/src/post4.c
@@ -1538,6 +1538,7 @@ p4Repl(P4_Ctx *ctx, int thrown)
 		(void) printf(crlf);
 		exit(128+SIGTERM);
 	case P4_THROW_UNDEFINED:
+	case P4_THROW_COMPILE_ONLY:
 	case P4_THROW_BAD_CONTROL:
 	case P4_THROW_WORDLIST:
 		p4Bp(ctx);
@@ -1642,6 +1643,8 @@ _inter_loop:	while (ctx->input->offset < ctx->input->length) {
 					P4_PUSH(ctx->ds, x);
 					p4StackGuards(ctx);
 				}
+			} else if (ctx->state == P4_STATE_INTERPRET && P4_WORD_IS(word, P4_BIT_COMPILE)) {
+				THROW(P4_THROW_COMPILE_ONLY);
 			} else if (ctx->state == P4_STATE_COMPILE && !P4_WORD_IS_IMM(word)) {
 				p4WordAppend(ctx, (P4_Cell) word);
 			} else {

diff --git a/src/post4.p4 b/src/post4.p4
@@ -43,7 +43,7 @@
 ' _bp alias _bpnow immediate
 
 \ ( xt -- )
-' , alias COMPILE, compile-only $10 _pp!
+' , alias COMPILE, compile-only
 
 \ (C: xu ... x1 x0 u -- xu ... x1 x0 xu )
 ' PICK alias CS-PICK compile-only
@@ -251,7 +251,7 @@ END-STRUCTURE
 : CELL- /CELL - ; $11 _pp!
 
 \ ( -- x )(R: x -- x)
-: R@ R> R> DUP >R SWAP >R ; compile-only $1101 _pp!
+: R@ R> R> DUP >R SWAP >R ; $1101 _pp!
 
 \ ( i*x -- )
 : dropall _ds DROP DROP CELL- dsp! ;

diff --git a/test/core.p4 b/test/core.p4
@@ -402,7 +402,7 @@ t{ 10 ' tw_f1 ' tw_f2 tw_compose execute -> -5 }t
 
 \ GH-15
 t{ depth -> 0 }t
-t{ :noname  ( +n -- i*n ) dup if dup 1- [ depth 1- pick compile, ] then ; 3 swap execute -> 3 2 1 0 }t
+t{ :noname  ( +n -- i*n ) dup if dup 1- [ depth 1- pick , ] then ; 3 swap execute -> 3 2 1 0 }t
 
 test_group_end