add COMPILE, ERASE, .R

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

src/fh_builtins_mem.c

@@ -246,6 +246,23 @@ static enum fh_error w_here(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_erase(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t addr, len;
+  TRY(ds_pop(fh, &len));
+  TRY(ds_pop(fh, &addr));
+  
+  if (len > 0) {
+    if (addr+len < HEAP_SIZE) {
+      LOG("Erase at 0x%08x, len %d", addr, len);
+      memset(&fh->heap[addr], 0, len);
+    }
+  }
+  return FH_OK;
+}
+
 const struct name_and_handler fh_builtins_mem[] = {
     {"chars",   wp_mul,       0, 1},
     {"char+",   wp_add,       0, 1},
@@ -259,6 +276,7 @@ const struct name_and_handler fh_builtins_mem[] = {
     {"aligned", w_aligned,    0, 0},
     {"allot",   w_allot,      0, 0},
     {"buffer:", w_buffer_colon, 0, 0},
+    {"erase", w_erase, 0, 0},
     {"align",   w_align,      0, 0},
     {",",       w_comma,      0, 0},
     {"c,",      w_c_comma,    0, 0},

src/fh_builtins_meta.c

@@ -338,6 +338,17 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s
   return FH_OK;
 }
 
+static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  
+  uint32_t xt;
+  TRY(ds_pop(fh, &xt));
+  TRY(fh_put_instr(fh, FH_INSTR_WORD, xt));
+  return FH_OK;
+}
+
 static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -695,5 +706,6 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"execute",      w_execute,      0, 0},
     {"environment?", w_env_query,    0, 0},
     {"marker",       w_marker,       0, 0},
+    {"compile,",     w_compile_comma, 0, 0},
     { /* end marker */ }
 };

src/fh_builtins_text.c

@@ -81,6 +81,19 @@ static enum fh_error w_dot(struct fh_thread_s *fh, const struct fh_word_s *w)
 }
 
 
+
+static enum fh_error w_dot_r(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t a = 0, n;
+  TRY(ds_pop(fh, &n));
+  TRY(ds_pop(fh, &a));
+
+  FHPRINT("%*."PRIi32" ", n, (int32_t) a);
+  return FH_OK;
+}
+
 static enum fh_error w_u_dot(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -100,7 +113,7 @@ static enum fh_error w_u_r(struct fh_thread_s *fh, const struct fh_word_s *w)
   TRY(ds_pop(fh, &n));
   TRY(ds_pop(fh, &a));
 
-  FHPRINT("%*d", n, a);
+  FHPRINT("%*."PRIu32, n, a);
   return FH_OK;
 }
 
@@ -482,6 +495,7 @@ const struct name_and_handler fh_builtins_text[] = {
     {".(",    w_dot_quote,   1, ')'},
     {".\\\"", w_dot_quote,  1, '\\'}, // escaped, this is non-standard
     {".",     w_dot,        0, 0},
+    {".r",     w_dot_r,        0, 0},
     {"u.",     w_u_dot,        0, 0},
     {"type",  w_type,       0, 0},
     {"fill",  w_fill,       0, 0},

testfiles/combinedtest.f

@@ -838,7 +838,6 @@ T{ ' W1 >BODY -> HERE }T
 T{ W1 -> HERE 1 + }T
 T{ W1 -> HERE 2 + }T
 
-0 [if] \ TODO
 \ ------------------------------------------------------------------------
 TESTING EVALUATE
 
@@ -883,7 +882,6 @@ DROP -> 0 }T            \ BLANK LINE RETURN ZERO-LENGTH STRING
 : GS4 SOURCE >IN ! DROP ;
 T{ GS4 123 456
 -> }T
-[then]
 
 \ ------------------------------------------------------------------------
 TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
@@ -1051,7 +1049,6 @@ TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
 
 T{ OUTPUT-TEST -> }T
 
-0 [if] \ FIXME
 \ ------------------------------------------------------------------------
 TESTING INPUT: ACCEPT
 
@@ -1065,7 +1062,6 @@ CREATE ABUF 50 CHARS ALLOT
 ;
 
 T{ ACCEPT-TEST -> }T
-[then]
 
 \ ------------------------------------------------------------------------
 TESTING DICTIONARY SEARCH RULES