diff --git a/README.md b/README.md
index b4adb3f..369c8ee 100644
--- a/README.md
+++ b/README.md
@@ -55,7 +55,7 @@ HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE
REPEAT ROT RSHIFT S>D S" SIGN SM/REM SOURCE SPACE SPACES STATE SWAP THEN TYPE U. U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ]
CORE-EXT:
-.( :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
+.( :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: CASE ENDCASE ENDOF FALSE HEX HOLDS MARKER NIP OF PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN
\
Other sets:
@@ -69,8 +69,8 @@ CORE:
ABORT" ACCEPT EVALUATE KEY
CORE-EXT:
-.R ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS
-MARKER OF PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID WITHIN [COMPILE]
+.R ACTION-OF C" COMPILE, DEFER DEFER! DEFER@ ERASE IS
+PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE]
```
.
diff --git a/include/fh_config.h b/include/fh_config.h
index 52fd421..0daf892 100644
--- a/include/fh_config.h
+++ b/include/fh_config.h
@@ -32,5 +32,6 @@
#define MAGICADDR_STATE 0xFFFF57a7ULL
#define MAGICADDR_INPTR 0xFFFFF175ULL
#define MAGICADDR_UNRESOLVED 0xFFFFFBADULL
+#define MAGICADDR_ENDCASE_UNRESOLVED 0xFFFC5BADULL
#endif //FORTH_FH_CONFIG_H
diff --git a/include/fh_runtime.h b/include/fh_runtime.h
index 48ced42..9fbc980 100644
--- a/include/fh_runtime.h
+++ b/include/fh_runtime.h
@@ -44,6 +44,13 @@ enum fh_instruction_kind {
/* Jump if zero */
FH_INSTR_JUMPZERO,
+ /* Jump if the two elements on stack do not equal, consuming the top one.
+ * Otherwise consume both and continue. */
+ FH_INSTR_OF,
+
+ /* Endcase, pop the testval from DS */
+ FH_INSTR_ENDCASE,
+
/* Loop exit */
FH_INSTR_LEAVE,
diff --git a/src/fh_builtins_control.c b/src/fh_builtins_control.c
index d4c19b2..4d7a949 100644
--- a/src/fh_builtins_control.c
+++ b/src/fh_builtins_control.c
@@ -118,6 +118,7 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
ii->data = endaddr;
}
+ // Resolve LEAVEs
while (startaddr < loopendaddr) {
ii = fh_instr_at(fh, startaddr);
if (!ii) {
@@ -223,6 +224,86 @@ static enum fh_error wp_ij(struct fh_thread_s *fh, const struct fh_word_s *w)
return FH_OK;
}
+
+
+static enum fh_error w_case(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+ (void) w;
+ enum fh_error rv;
+ TRY(cs_push(fh, fh->here)); // save marker for ENDCASE to resolve all the ENDOF's within
+ ENSURE_STATE(FH_STATE_COMPILE);
+ return FH_OK;
+}
+
+static enum fh_error w_of(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+ (void) w;
+ enum fh_error rv;
+ ENSURE_STATE(FH_STATE_COMPILE);
+ TRY(cs_push(fh, fh->here)); // save the marker for ENDOF
+ TRY(fh_put_instr(fh, FH_INSTR_OF, MAGICADDR_UNRESOLVED));
+ return FH_OK;
+}
+
+static enum fh_error w_endof(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+ (void) w;
+ enum fh_error rv;
+ ENSURE_STATE(FH_STATE_COMPILE);
+ uint32_t ofaddr;
+ TRY(cs_pop(fh, &ofaddr));
+
+ struct fh_instruction_s *of_instr = fh_instr_at(fh, ofaddr);
+ if (!of_instr || of_instr->data != MAGICADDR_UNRESOLVED) {
+ LOGE("CASE-OF control stack corruption");
+ return FH_ERR_INTERNAL;
+ }
+
+ of_instr->data = fh->here + INSTR_SIZE; // next
+
+ TRY(fh_put_instr(fh, FH_INSTR_JUMP, MAGICADDR_ENDCASE_UNRESOLVED)); // go to end of CASEs
+ return FH_OK;
+}
+
+static enum fh_error w_endcase(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+ (void) w;
+ enum fh_error rv;
+ ENSURE_STATE(FH_STATE_COMPILE);
+ uint32_t caseaddr;
+ TRY(cs_pop(fh, &caseaddr));
+
+ // Now walk the instructions and resolve every MAGICADDR_ENDCASE_UNRESOLVED
+
+ uint32_t caseendaddr = fh->here;
+ struct fh_instruction_s *ii;
+
+ // Resolve ENDOF. TODO copied from LOOP impl, unify?
+ while (caseaddr < caseendaddr) {
+ ii = fh_instr_at(fh, caseaddr);
+ if (!ii) {
+ LOGE("WHAT?");
+ return FH_ERR_INTERNAL;
+ }
+ if (ii->kind == FH_INSTR_JUMP && ii->data == MAGICADDR_ENDCASE_UNRESOLVED) {
+ LOG("Resolve endof jump");
+ ii->data = caseendaddr + INSTR_SIZE;
+ }
+
+ // forward, skipping strings safely
+ if (ii->kind == FH_INSTR_TYPESTR || ii->kind == FH_INSTR_ALLOCSTR) {
+ caseaddr += INSTR_SIZE + ii->data;
+ caseaddr = WORDALIGNED(caseaddr);
+ } else {
+ caseaddr += INSTR_SIZE;
+ }
+ }
+
+ TRY(fh_put_instr(fh, FH_INSTR_ENDCASE, 0));
+
+ return FH_OK;
+}
+
const struct name_and_handler fh_builtins_control[] = {
{"i", wp_ij, 0, 0},
{"j", wp_ij, 0, 1},
@@ -241,6 +322,10 @@ const struct name_and_handler fh_builtins_control[] = {
{"again", w_again, 1, 0},
{"until", w_until, 1, 0},
{"unloop", w_unloop, 0, 0},
+ {"case", w_case, 1, 0},
+ {"of", w_of, 1, 0},
+ {"endof", w_endof, 1, 0},
+ {"endcase", w_endcase, 1, 0},
{ /* end marker */ }
};
diff --git a/src/fh_runtime.c b/src/fh_runtime.c
index 47fb16c..f9e0774 100644
--- a/src/fh_runtime.c
+++ b/src/fh_runtime.c
@@ -139,7 +139,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
fh->execptr += INSTR_SIZE;
uint32_t strl;
- uint32_t val;
+ uint32_t val, testval;
uint32_t limit, index;
LOG("0x%08x: Instr %s, 0x%08x", fh->execptr, instr_name(instr->kind), instr->data);
@@ -321,6 +321,29 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
fh->execptr = instr->data;
goto instr;
+ case FH_INSTR_OF:
+ LOG("\x1b[35mExec: OF\x1b[m");
+ if (instr->data == MAGICADDR_UNRESOLVED) {
+ LOGE("Encountered unresolved OF!");
+ goto end;
+ }
+ TRY(ds_pop(fh, &testval));
+ TRY(ds_pop(fh, &val));
+
+ LOG("Val %d, testval %d", val, testval);
+
+ if (testval != val) {
+ LOG("No match, go to ENDOF");
+ TRY(ds_push(fh, val));
+ fh->execptr = instr->data;
+ }
+ goto instr;
+
+ case FH_INSTR_ENDCASE:
+ LOG("\x1b[35mExec: ENDCASE\x1b[m");
+ TRY(ds_pop(fh, &val)); // discard the tested value
+ goto instr;
+
/* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR:
diff --git a/src/fh_see.c b/src/fh_see.c
index 2280255..e336583 100644
--- a/src/fh_see.c
+++ b/src/fh_see.c
@@ -53,6 +53,14 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
}
break;
+ case FH_INSTR_OF:
+ FHPRINT("OF(value %d / 0x%08x)\n", instr->data, instr->data);
+ break;
+
+ case FH_INSTR_ENDCASE:
+ FHPRINT("ENDCASE\n");
+ break;
+
case FH_INSTR_TO:
w2 = fh_word_at(fh, instr->data);
if (w2) {