fix implementation of ABORT, ABORT" and QUIT

README.md

@@ -49,13 +49,13 @@ Implemented and tested:
 ```
 CORE:
 ! ' ( * */ */MOD + +! +LOOP , - . ." # #> #S <# >BODY >NUMBER / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
-: ; < = > >IN >R ?DUP @ ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
+: ; < = > >IN >R ?DUP @ ABORT ABORT" ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
 CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EVALUATE EXECUTE EXIT FILL FM/MOD FIND
 HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
 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:
-.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: C" CASE COMPILE, ENDCASE ENDOF ERASE FALSE HEX HOLDS MARKER NIP OF PAD PARSE PARSE-NAME PICK RESTORE-INPUT SAVE-INPUT ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN
+.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO ACTION-OF AGAIN BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE FALSE HEX HOLDS IS MARKER NIP OF PAD PARSE PARSE-NAME PICK RESTORE-INPUT SAVE-INPUT ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN
 \
 
 Other sets:
@@ -66,10 +66,10 @@ Missing:
 
 ```
 CORE:
-ABORT ABORT" ACCEPT KEY
+ACCEPT KEY
 
 CORE-EXT:
-ACTION-OF DEFER DEFER! DEFER@ IS REFILL SOURCE-ID [COMPILE]
+REFILL SOURCE-ID [COMPILE]
 ```
 
 .

include/fh_builtins.h

@@ -22,7 +22,7 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh);
 
 #define ENSURE_STATE(__state) do {      \
   if (fh->state != (__state)) {         \
-    LOGE("Invalid state %d, expected %d", fh->state, (__state)); \
+    LOGE("Invalid state %d, expected %d in file " __FILE__ " line %d", fh->state, (__state), __LINE__); \
     return FH_ERR_INVALID_STATE;        \
   }                                     \
 } while (0)

include/fh_error.h

@@ -29,6 +29,7 @@ enum fh_error {
   FH_ERR_SYNTAX,
   FH_ERR_NOT_APPLICABLE,
   FH_ERR_PICTNUM_FULL,
+  FH_ERR_BAD_DEFER,
   FH_ERR_MAX,
 };
 

include/fh_parse.h

@@ -21,4 +21,10 @@ enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, c
 
 enum fh_error fh_handle_ascii_word(struct fh_thread_s *fh, const char *name, size_t wordlen);
 
+// chartest space or 0, param is ignored
+bool fh_chartest_space_or_end(char c, void *param);
+
+// chartest given char or 0. param is pointer to char.
+bool fh_chartest_equals_or_end(char c, void *param);
+
 #endif //FORTH_FH_PARSE_H

include/fh_runtime.h

@@ -43,6 +43,9 @@ enum fh_instruction_kind {
   /** This is the `."` instruction, same format as above. */
   FH_INSTR_TYPESTR,
 
+  /** abort" in compiled form */
+  FH_INSTR_ABORTSTR,
+
   /* Unconditional jump */
   FH_INSTR_JUMP,
 
@@ -76,12 +79,22 @@ enum fh_instruction_kind {
 
   /* Postponed word */
   FH_INSTR_POSTPONED_WORD,
+  
+  /* Action-of in compiled form */
+  FH_INSTR_ACTIONOF,
+  
+  /* IS in compiled form */
+  FH_INSTR_ISDEFER,
 
   FH_INSTR_MAX,
 };
 
 const char *instr_name(enum fh_instruction_kind kind);
 
+void fh_quit(struct fh_thread_s *fh);
+void fh_abort(struct fh_thread_s *fh);
+void fh_drop_to_interactive(struct fh_thread_s *fh);
+
 /** One instruction in bytecode */
 struct fh_instruction_s {
   /** What is the meaning of data? */
@@ -133,6 +146,8 @@ extern const char *substatenames[FH_SUBSTATE_MAX];
 #define WORDFLAG_CREATED  0x20
 /** Word marked as hidden is not findable, e.g. because it is being compiled. */
 #define WORDFLAG_HIDDEN  0x40
+/** Created using DEFER */
+#define WORDFLAG_DEFER  0x80
 
 /** Word struct as they are stored in the dictionary */
 struct fh_word_s {

src/fh_builtins_control.c

@@ -244,6 +244,67 @@ static enum fh_error w_of(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_abort(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  fh_abort(fh);
+  return FH_OK;
+}
+
+static enum fh_error w_quit(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  fh_quit(fh);
+  return FH_OK;
+}
+
+static enum fh_error w_abort_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  size_t len;
+  
+  // this is copied from ."
+
+  // leave space for the instr in case of compiled version
+  uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
+
+  /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
+
+  fh_input_consume_spaces(fh);
+  char *start;
+  uint32_t capacity = HEAP_END - addr;
+  
+  start = NULL;
+  char c = '"';
+  TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
+  if (len > capacity) {
+    LOGE("String too long for heap");
+    return FH_ERR_HEAP_FULL;
+  }
+  if (fh->state == FH_STATE_COMPILE) {
+    fh_heap_copyptr(fh, addr, start, len);
+  }
+
+  if (fh->state == FH_STATE_INTERPRET) {
+    uint32_t val;
+    TRY(ds_pop(fh, &val));
+    if (val) {
+      FHPRINT("%.*s", (int) len, start);      
+      fh_abort(fh);
+    }
+    // the string is invalidated immediately, heap pointer is NOT advanced.
+  } else {
+    LOG("Compile abort string: \"%.*s\"", (int) len, start);
+    TRY(fh_put_instr(fh, FH_INSTR_ABORTSTR, len));
+    fh->here = WORDALIGNED(addr + len); // at the end of the string
+  }
+
+  return FH_OK;
+}
+
 static enum fh_error w_endof(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -310,6 +371,9 @@ const struct name_and_handler fh_builtins_control[] = {
     {"else",    w_else,    1, 0},
     {"then",    w_then,    1, 0},
     {"recurse", w_recurse, 1, 0},
+    {"quit",   w_quit,   0, 0},
+    {"abort",   w_abort,   0, 0},
+    {"abort\"", w_abort_quote, 1, 0},
     {"do",      wp_do,     1, 0},
     {"?do",     wp_do,     1, 1},
     {"loop",    wp_loop,   1, 0},

src/fh_builtins_meta.c

@@ -38,6 +38,17 @@ static enum fh_error rt_marker(struct fh_thread_s *fh, const struct fh_word_s *w
   return FH_OK;
 }
 
+static enum fh_error rt_defer(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  uint32_t defered = w->param;
+  if (defered == MAGICADDR_UNRESOLVED) {
+    LOGE("Exec DEFER name without assigned xt!");
+    return FH_ERR_BAD_DEFER;
+  }
+  
+  return fh_handle_word(fh, defered);
+}
+
 static enum fh_error w_marker(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -512,6 +523,135 @@ static enum fh_error w_create(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_defer(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  ENSURE_STATE(FH_STATE_INTERPRET);
+
+  char *wordname;
+  size_t namelen = 0;
+  fh_input_consume_spaces(fh);
+  TRY(fh_input_read_word(fh, &wordname, &namelen));
+
+  uint32_t ptr;
+
+  TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
+
+  struct fh_word_s *new_word = fh_word_at(fh, ptr);
+  if (!new_word) { return FH_ERR_INTERNAL; }
+  new_word->previous = fh->dict_last;
+  new_word->param = MAGICADDR_UNRESOLVED;
+  new_word->handler = rt_defer;
+  strncpy(new_word->name, wordname, namelen);
+  new_word->name[namelen] = 0;
+  new_word->flags = WORDFLAG_BUILTIN | WORDFLAG_DEFER;
+
+  fh->dict_last = ptr;
+
+  return FH_OK;
+}
+
+static enum fh_error w_defer_store(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  
+  uint32_t xt1, xt2;
+  TRY(ds_pop(fh, &xt1));
+  TRY(ds_pop(fh, &xt2));
+  
+  struct fh_word_s *ww = fh_word_at(fh, xt1);
+  if (0 == (ww->flags & WORDFLAG_DEFER)) {
+    LOGE("%s is not DEFER!", ww->name);
+    return FH_ERR_BAD_DEFER;
+  }
+  
+  ww->param = xt2;
+  
+  return FH_OK;
+}
+
+static enum fh_error w_defer_fetch(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  
+  uint32_t xt1;
+  TRY(ds_pop(fh, &xt1));
+  
+  struct fh_word_s *ww = fh_word_at(fh, xt1);
+  if (0 == (ww->flags & WORDFLAG_DEFER)) {
+    LOGE("%s is not DEFER!", ww->name);
+    return FH_ERR_BAD_DEFER;
+  }
+  
+  TRY(ds_push(fh, ww->param));
+  
+  return FH_OK;
+}
+
+static enum fh_error w_is(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  char *wordname;
+  size_t namelen = 0;
+  fh_input_consume_spaces(fh);
+  TRY(fh_input_read_word(fh, &wordname, &namelen));
+
+  uint32_t addr;
+  if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
+    LOGE("' %.*s word not found!", (int) namelen, wordname);
+    return FH_ERR_UNKNOWN_WORD;
+  }
+  
+  struct fh_word_s *ww = fh_word_at(fh, addr);
+  if (0 == (ww->flags & WORDFLAG_DEFER)) {
+    LOGE("%s is not DEFER!", ww->name);
+    return FH_ERR_BAD_DEFER;
+  }
+  
+  if (fh->state == FH_STATE_COMPILE) {
+    TRY(fh_put_instr(fh, FH_INSTR_ISDEFER, addr));
+  } else {  
+    TRY(ds_pop(fh, &ww->param));
+  }  
+  return FH_OK;
+}
+
+static enum fh_error w_action_of(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  char *wordname;
+  size_t namelen = 0;
+  fh_input_consume_spaces(fh);
+  TRY(fh_input_read_word(fh, &wordname, &namelen));
+
+  uint32_t addr;
+  if (FH_OK != fh_find_word(fh, wordname, namelen, &addr)) {
+    LOGE("' %.*s word not found!", (int) namelen, wordname);
+    return FH_ERR_UNKNOWN_WORD;
+  }
+  
+  struct fh_word_s *ww = fh_word_at(fh, addr);
+  if (0 == (ww->flags & WORDFLAG_DEFER)) {
+    LOGE("%s is not DEFER!", ww->name);
+    return FH_ERR_BAD_DEFER;
+  }
+  
+  if (fh->state == FH_STATE_COMPILE) {
+    TRY(fh_put_instr(fh, FH_INSTR_ACTIONOF, addr));
+  } else {  
+    TRY(ds_push(fh, ww->param));
+  }
+  
+  return FH_OK;
+}
+
 static enum fh_error w_find(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -796,6 +936,11 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"parse-name",   w_parse_name,    0, 0},
     {"count",        w_count,         0, 0},
     {"create",       w_create,        0, 0},
+    {"defer",        w_defer,         0, 0},
+    {"defer!",       w_defer_store,   0, 0},
+    {"defer@",       w_defer_fetch,   0, 0},
+    {"action-of",    w_action_of,     1, 0}, // imm because it has special compile behavior
+    {"is",           w_is,            1, 0},
     {"find",         w_find,          0, 0},
     {"'",            wp_tick,         1, 0},
     {"[']",          wp_tick,         1, 1},

src/fh_builtins_text.c

@@ -255,12 +255,6 @@ static enum fh_error w_c_quote(struct fh_thread_s *fh, const struct fh_word_s *w
   return FH_OK;
 }
 
-static bool chartest_equals_or_end(char c, void *param)
-{
-  char cc = *(char *) param;
-  return cc == c || c == 0;
-}
-
 static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -282,7 +276,7 @@ static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s
     TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len));
   } else {
     start = NULL;
-    TRY(fh_input_read_delimited(fh, &start, &len, chartest_equals_or_end, &c));
+    TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
     if (len > capacity) {
       LOGE("String too low for heap");
       return FH_ERR_HEAP_FULL;

src/fh_error.c

@@ -22,6 +22,7 @@ static const char *errornames[FH_ERR_MAX] = {
     [FH_ERR_SYNTAX] = "SYNTAX_ERROR",
     [FH_ERR_PICTNUM_FULL] = "PICTNUM_FULL",
     [FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE",
+    [FH_ERR_BAD_DEFER] = "BAD_DEFER",
 };
 
 /** Get error name from code, returns Unknown if not defined */

src/fh_parse.c

@@ -119,15 +119,21 @@ enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t
   return FH_OK;
 }
 
-static bool chartest_space_or_end(char c, void *param)
+bool fh_chartest_space_or_end(char c, void *param)
 {
   (void) param;
   return isspace(c) || c == 0;
 }
 
+bool fh_chartest_equals_or_end(char c, void *param)
+{
+  char cc = *(char *) param;
+  return cc == c || c == 0;
+}
+
 enum fh_error fh_input_read_word(struct fh_thread_s *fh, char **out, size_t *len)
 {
-  return fh_input_read_delimited(fh, out, len, chartest_space_or_end, NULL);
+  return fh_input_read_delimited(fh, out, len, fh_chartest_space_or_end, NULL);
 }
 
 enum fh_error fh_input_read_quotedstring(struct fh_thread_s *fh, bool escaped, char *outbuf, size_t capacity, size_t *out_len)
@@ -273,22 +279,16 @@ enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *i
         if (fh_globals.interactive || fh_globals.echo) {
           FHPRINT_SVC(" ok\n");
         }
+        if (fh->state == FH_STATE_SHUTDOWN) {
+          return 1;
+        }
       } else {
         LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum);
-        if (!fh_globals.interactive) {
-          if (fh_globals.rescue) {
-            fh_globals.interactive = 1;
-            fh_input_teardown(fh);
-            fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL));
-          } else {
-            return 1;
-          }
+        if (fh_globals.interactive || fh_globals.rescue) {
+          fh_drop_to_interactive(fh);
+        } else {
+          return 1;
         }
-        /* reset state */
-        fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
-        // reset stack pointers
-        fh->data_stack_top = 0;
-        fh->return_stack_top = 0;
       }
 
       if (fh_globals.interactive) {

src/fh_runtime.c

@@ -43,8 +43,33 @@ static const char *instrnames[FH_INSTR_MAX] = {
     [FH_INSTR_LOOP] = "LOOP",
     [FH_INSTR_LOOP_PLUS] = "LOOP_PLUS",
     [FH_INSTR_POSTPONED_WORD] = "POSTPONED_WORD",
+    [FH_INSTR_ABORTSTR] = "ABORTSTR",
+    [FH_INSTR_ACTIONOF] = "ACTIONOF",
+    [FH_INSTR_ISDEFER] = "ISDEFER",
 };
 
+void fh_abort(struct fh_thread_s *fh) {
+  fh->data_stack_top = 0;
+  fh_quit(fh);
+}
+
+void fh_drop_to_interactive(struct fh_thread_s *fh) {
+  fh_input_teardown(fh);
+  fh_push_input(fh, fh_create_input_from_filestruct(stdin, NULL));
+  fh->return_stack_top = 0; 
+  fh->execptr = MAGICADDR_EXEC_INTERACTIVE;
+  fh_globals.interactive = 1;
+  fh_setstate(fh, FH_STATE_INTERPRET, 0);
+}
+
+void fh_quit(struct fh_thread_s *fh) {
+  if (fh_globals.interactive) {
+    fh_drop_to_interactive(fh);
+    fh_setstate(fh, FH_STATE_QUIT, 0);
+  } else {
+    fh_setstate(fh, FH_STATE_SHUTDOWN, 0);
+  }
+}
 
 const char *instr_name(enum fh_instruction_kind kind)
 {
@@ -125,7 +150,11 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   }
 
   instr:;
+  if (fh->state == FH_STATE_SHUTDOWN) {
+    return FH_OK;
+  }
   if (fh->state == FH_STATE_QUIT) {
+    LOG("QUIT word exec");
     /* abort or quit was called, return to interactive mode */
     fh_setstate(fh, FH_STATE_INTERPRET, FH_SUBSTATE_NONE);
     return FH_OK;
@@ -366,6 +395,19 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       fh->execptr += strl;
       goto instr;
 
+    case FH_INSTR_ABORTSTR:
+      strl = instr->data;
+      TRY(ds_pop(fh, &val));
+      LOG("\x1b[35mExec: abort-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
+      if (val != 0) {
+        FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));   
+        LOG("ABORTing");     
+        fh_abort(fh);
+        goto end;
+      }
+      fh->execptr += strl;
+      goto instr;
+
     case FH_INSTR_ENDWORD:
       LOG("\x1b[35mExec: word-end\x1b[m");
       TRY(rs_pop(fh, &fh->execptr));
@@ -374,6 +416,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
         goto end;
       }
       goto instr;
+      
+    case FH_INSTR_ACTIONOF:
+      LOG("\x1b[35mExec: actionof\x1b[m");
+      w2 = fh_word_at(fh, instr->data);
+      TRY(ds_push(fh, w2->param));
+      goto instr;
+      
+    case FH_INSTR_ISDEFER:
+      LOG("\x1b[35mExec: isdefer\x1b[m");
+      w2 = fh_word_at(fh, instr->data);
+      TRY(ds_pop(fh, &w2->param));
+      goto instr;
 
     default:
       LOGE("Run handler not implemented for instr opcode %d", instr->kind);

src/fh_see.c

@@ -82,6 +82,14 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
             FHPRINT("Jump(dest 0x%08x)\n", instr->data);
             break;
 
+          case FH_INSTR_ACTIONOF:
+            FHPRINT("ActionOf(word 0x%08x)\n", instr->data);
+            break;
+
+          case FH_INSTR_ISDEFER:
+            FHPRINT("IsDefer(word 0x%08x)\n", instr->data);
+            break;
+
           case FH_INSTR_DO:
             FHPRINT("DO\n");
             break;
@@ -111,6 +119,12 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
             execptr += strl;
             break;
 
+          case FH_INSTR_ABORTSTR:
+            strl = instr->data;
+            FHPRINT("AbortStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
+            execptr += strl;
+            break;
+
           case FH_INSTR_ALLOCSTR_C:
             strl = instr->data;
             FHPRINT("AllocStrC(%d, \"%.*s\")\n", fh->heap[execptr], fh->heap[execptr], fh_str_at(fh, execptr + 1));
@@ -139,6 +153,8 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
     FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
   } else if (w->flags & WORDFLAG_CREATED) {
     FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
+  } else if (w->flags & WORDFLAG_DEFER) {
+    FHPRINT("DEFER'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
   } else {
     FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
   }

src/main.c

@@ -82,6 +82,8 @@ int main(int argc, char *argv[])
       (int) fh.data_stack_hwm, (int) fh.return_stack_hwm,
       (int) fh.here);
 
-  FHPRINT_SVC("Bye.\n");
+  if (fh_globals.interactive) {
+    FHPRINT_SVC("Bye.\n");
+  }
   return 0;
 }

testfiles/abort.f

@@ -0,0 +1,4 @@
+: foo abort" Aborting!" ." Did not abort" ;
+
+1 foo
+0 foo

testfiles/combinedtest.f

@@ -1712,6 +1712,7 @@ T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T
 TESTING PARSE-NAME  (Forth 2012)
 \ Adapted from the PARSE-NAME RfD tests
 
+\ XXX this was missing from the test suite, added!
 : STR1 S" abcd" ;
 : STR2 S" abcde" ;