implemented CASE-OF

master
Ondřej Hruška 3 years ago
parent f2d0d82eb3
commit e7d0053915
  1. 6
      README.md
  2. 1
      include/fh_config.h
  3. 7
      include/fh_runtime.h
  4. 85
      src/fh_builtins_control.c
  5. 25
      src/fh_runtime.c
  6. 8
      src/fh_see.c

@ -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] ] 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: 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: Other sets:
@ -69,8 +69,8 @@ CORE:
ABORT" ACCEPT EVALUATE KEY ABORT" ACCEPT EVALUATE KEY
CORE-EXT: CORE-EXT:
.R ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS .R ACTION-OF C" COMPILE, DEFER DEFER! DEFER@ ERASE IS
MARKER OF PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID WITHIN [COMPILE] PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE]
``` ```
. .

@ -32,5 +32,6 @@
#define MAGICADDR_STATE 0xFFFF57a7ULL #define MAGICADDR_STATE 0xFFFF57a7ULL
#define MAGICADDR_INPTR 0xFFFFF175ULL #define MAGICADDR_INPTR 0xFFFFF175ULL
#define MAGICADDR_UNRESOLVED 0xFFFFFBADULL #define MAGICADDR_UNRESOLVED 0xFFFFFBADULL
#define MAGICADDR_ENDCASE_UNRESOLVED 0xFFFC5BADULL
#endif //FORTH_FH_CONFIG_H #endif //FORTH_FH_CONFIG_H

@ -44,6 +44,13 @@ enum fh_instruction_kind {
/* Jump if zero */ /* Jump if zero */
FH_INSTR_JUMPZERO, 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 */ /* Loop exit */
FH_INSTR_LEAVE, FH_INSTR_LEAVE,

@ -118,6 +118,7 @@ static enum fh_error wp_loop(struct fh_thread_s *fh, const struct fh_word_s *w)
ii->data = endaddr; ii->data = endaddr;
} }
// Resolve LEAVEs
while (startaddr < loopendaddr) { while (startaddr < loopendaddr) {
ii = fh_instr_at(fh, startaddr); ii = fh_instr_at(fh, startaddr);
if (!ii) { 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; 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[] = { const struct name_and_handler fh_builtins_control[] = {
{"i", wp_ij, 0, 0}, {"i", wp_ij, 0, 0},
{"j", wp_ij, 0, 1}, {"j", wp_ij, 0, 1},
@ -241,6 +322,10 @@ const struct name_and_handler fh_builtins_control[] = {
{"again", w_again, 1, 0}, {"again", w_again, 1, 0},
{"until", w_until, 1, 0}, {"until", w_until, 1, 0},
{"unloop", w_unloop, 0, 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 */ } { /* end marker */ }
}; };

@ -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; fh->execptr += INSTR_SIZE;
uint32_t strl; uint32_t strl;
uint32_t val; uint32_t val, testval;
uint32_t limit, index; uint32_t limit, index;
LOG("0x%08x: Instr %s, 0x%08x", fh->execptr, instr_name(instr->kind), instr->data); 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; fh->execptr = instr->data;
goto instr; 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 */ /* special case for strings stored in compile memory */
case FH_INSTR_ALLOCSTR: case FH_INSTR_ALLOCSTR:
case FH_INSTR_TYPESTR: case FH_INSTR_TYPESTR:

@ -53,6 +53,14 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
} }
break; 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: case FH_INSTR_TO:
w2 = fh_word_at(fh, instr->data); w2 = fh_word_at(fh, instr->data);
if (w2) { if (w2) {

Loading…
Cancel
Save