From e7d005391525a29f0151717c45c220f5d5562c7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Sun, 21 Nov 2021 17:17:20 +0100 Subject: [PATCH] implemented CASE-OF --- README.md | 6 +-- include/fh_config.h | 1 + include/fh_runtime.h | 7 ++++ src/fh_builtins_control.c | 85 +++++++++++++++++++++++++++++++++++++++ src/fh_runtime.c | 25 +++++++++++- src/fh_see.c | 8 ++++ 6 files changed, 128 insertions(+), 4 deletions(-) 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) {