add PARSE, PARSE-NAME

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 @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
+: ; < = > >IN >R ?DUP @ 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 PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN
+.( .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
 \
 
 Other sets:
@@ -66,10 +66,10 @@ Missing:
 
 ```
 CORE:
-ABORT" ACCEPT KEY
+ABORT ABORT" ACCEPT KEY
 
 CORE-EXT:
-ACTION-OF DEFER DEFER! DEFER@ IS PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE]
+ACTION-OF DEFER DEFER! DEFER@ IS REFILL SOURCE-ID [COMPILE]
 ```
 
 .

src/fh_builtins_meta.c

@@ -723,6 +723,50 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s
   return FH_OK;
 }
 
+static enum fh_error w_parse(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t ch;
+  TRY(ds_pop(fh, &ch));
+  if (ch > 0xFF) {
+    LOGE("Char out of ASCII bounds!");
+    return FH_ERR_NOT_APPLICABLE;
+  }
+
+  char *out;
+  size_t len;
+  fh_input_read_delimited(fh, &out, &len, chartest_equals_or_end, &ch);
+  if (len >= WORDBUF_SIZE) {
+    LOGE("PARSE parsed string too long: %d", len);
+    return FH_ERR_NAME_TOO_LONG;
+  }
+  
+  LOG("Parsed %d", len);
+  
+  TRY(ds_push(fh, (void*) out - (void*) &fh->heap[0]));
+  TRY(ds_push(fh, len));  
+  return FH_OK;
+}
+
+static enum fh_error w_parse_name(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+
+  fh_input_consume_spaces(fh);
+  
+  char * ww;
+  size_t len;
+  TRY(fh_input_read_word(fh, &ww, &len));
+  
+  LOG("Parsed %.*s", len, ww);
+  
+  TRY(ds_push(fh, (void*) ww - (void*) &fh->heap[0]));
+  TRY(ds_push(fh, len));  
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_meta[] = {
     {"depth",        w_depth,         0, 0},
     {"unused",       w_unused,        0, 0},
@@ -748,6 +792,8 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"value",        wp_variable,     1, 1},
     {"constant",     wp_variable,     1, 2},
     {"word",         w_word,          0, 0},
+    {"parse",        w_parse,         0, 0},
+    {"parse-name",   w_parse_name,    0, 0},
     {"count",        w_count,         0, 0},
     {"create",       w_create,        0, 0},
     {"find",         w_find,          0, 0},

src/fh_parse.c

@@ -103,8 +103,8 @@ enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t
     char c = *rp;
     if (test(c, param)) {
       if (rp == start) {
-        LOGE("Expected a word!");
+        // nothing was found, this is probably OK.        
-        return FH_ERR_SYNTAX;
+        LOG("Parsed an empty word");
       }
       *out = start;
       *len = rp - start;
@@ -391,7 +391,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh)
         } else {
           if (EQ(rp, "\\", length)) {
             // discard to EOL
-            LOG("Discard \"%.*s\"", (int)(fh->inputlen - fh->inputptr + length), rp);
+//             LOG("Discard \"%.*s\"", (int)(fh->inputlen - fh->inputptr + length), rp);
             goto done;
           }
 

testfiles/combinedtest.f

@@ -1712,6 +1712,9 @@ T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T
 TESTING PARSE-NAME  (Forth 2012)
 \ Adapted from the PARSE-NAME RfD tests
 
+: STR1 S" abcd" ;
+: STR2 S" abcde" ;
+
 T{ PARSE-NAME abcd  STR1  S= -> TRUE }T        \ No leading spaces
 T{ PARSE-NAME      abcde STR2 S= -> TRUE }T    \ Leading spaces