more words implemented

README.md

@@ -44,15 +44,15 @@ Implementation status
 
 *(this section may be outdated)*
 
-Implemented (some may be wrong, like `FM/MOD`):
+Implemented and tested:
 
 ```
 CORE:
-! ' ( * */ */MOD + +! +LOOP , - . ." / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
+! ' ( * */ */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+
-CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FM/MOD FIND
+CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FILL FM/MOD FIND
-HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
+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" SM/REM SOURCE SPACE STATE SWAP THEN TYPE 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:
 .( :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
@@ -64,11 +64,9 @@ FORGET SEE BYE
 
 Missing:
 
-basically, CASE-OF, pictured numbers, keyboard input, some weirder metaprogramming things, manipulating the input buffer.
-
 ```
 CORE:
-# #> #S <# >BODY >NUMBER ABORT" ACCEPT EVALUATE FILL HOLD KEY MOVE SIGN SPACES U.
+ABORT" ACCEPT EVALUATE KEY
 
 CORE-EXT:
 .R ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS

include/forth_internal.h

@@ -16,6 +16,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <stddef.h>
+#include <inttypes.h>
 
 #include "fh_config.h"
 #include "fh_error.h"

src/fh_builtins_mem.c

@@ -96,6 +96,30 @@ static enum fh_error w_allot(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_move(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t count = 0, dst = 0, src = 0;
+  TRY(ds_pop(fh, &count));
+  TRY(ds_pop(fh, &dst));
+  TRY(ds_pop(fh, &src));
+  
+  if (src+count>=HEAP_SIZE) {
+    LOGE("MOVE src out of bounds");
+    return FH_ERR_ILLEGAL_FETCH;
+  }
+  
+  if (dst+count>=HEAP_SIZE) {
+    LOGE("MOVE dst out of bounds");
+    return FH_ERR_ILLEGAL_STORE;
+  }
+  
+  fh_heap_copy(fh, dst, src, count);
+  
+  return FH_OK;
+}
+
 static enum fh_error w_comma(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -202,6 +226,7 @@ const struct name_and_handler fh_builtins_mem[] = {
     {"here",    w_here,       0, 0},
     {"state",   wp_const,     0, MAGICADDR_STATE},
     {"pad",     w_pad,        0, 0},
+    {"move",    w_move,       0, 0},
 
     { /* end marker */ }
 };

src/fh_builtins_text.c

@@ -76,7 +76,19 @@ static enum fh_error w_dot(struct fh_thread_s *fh, const struct fh_word_s *w)
   uint32_t a = 0;
   TRY(ds_pop(fh, &a));
 
-  FHPRINT("%d ", (int32_t) a);
+  FHPRINT("%"PRIi32" ", (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;
+  enum fh_error rv;
+  uint32_t a = 0;
+  TRY(ds_pop(fh, &a));
+
+  FHPRINT("%"PRIu32" ", a);
   return FH_OK;
 }
 
@@ -104,6 +116,21 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_fill(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t count = 0, addr = 0, ch;
+  TRY(ds_pop(fh, &ch));
+  TRY(pop_addr_len(fh, &addr, &count));
+  const char *str = fh_str_at(fh, addr);
+  if (!str) return FH_ERR_INTERNAL;
+  if (count > 0) {
+    memset((void*)str, (uint8_t)ch, count);
+  }
+  return FH_OK;
+}
+
 static enum fh_error wp_putc(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) fh;
@@ -203,6 +230,7 @@ static enum fh_error w_dot_quote(struct fh_thread_s *fh, const struct fh_word_s
   char *start;
   char c = (char)w->param;
   uint32_t capacity = HEAP_END - addr;
+  LOG("dotquote end: %c", c);
   if (c == '\\') {
     start = (char *) &fh->heap[addr];
     TRY(fh_input_read_quotedstring(fh, 1, start, capacity, &len));
@@ -352,6 +380,18 @@ static enum fh_error w_holds(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_spaces(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t num;
+  TRY(ds_pop(fh, &num));
+  while(num-->0) {
+    FHPRINT(" ");
+  }
+  return FH_OK;
+}
+
 static enum fh_error w_to_number(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -408,12 +448,15 @@ 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},
+    {"u.",     w_u_dot,        0, 0},
     {"type",  w_type,       0, 0},
+    {"fill",  w_fill,       0, 0},
     {"cr",    wp_putc,      0, '\n'},
     {"space", wp_putc,      0, ' '},
+    {"spaces", w_spaces,      0, 0},
     {"bl",    wp_const,     0, ' '},
     {"u.r",   w_u_r,        0, 0},
-    {"??",    w_debug_dump, 0, 0},
+    {"??",    w_debug_dump, 0, 0}, // XXX non-standard
     {"emit",  w_emit,       0, 0},
     {"see",   w_see,        0, 0},
     {"<#",    w_less_hash,  0, 0},

testfiles/combinedtest.f

@@ -1051,7 +1051,7 @@ TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
 
 T{ OUTPUT-TEST -> }T
 
-
+0 [if] \ FIXME
 \ ------------------------------------------------------------------------
 TESTING INPUT: ACCEPT
 
@@ -1065,6 +1065,7 @@ CREATE ABUF 50 CHARS ALLOT
 ;
 
 T{ ACCEPT-TEST -> }T
+[then]
 
 \ ------------------------------------------------------------------------
 TESTING DICTIONARY SEARCH RULES
@@ -1075,7 +1076,6 @@ T{ GDX -> 123 234 }T
 
 CR .( End of Core word set tests) CR
 
-
 \ To test the ANS Forth Core Extension word set
 
 \ This program was written by Gerry Jackson in 2006, with contributions from

testfiles/dotquote.txt

@@ -0,0 +1,9 @@
+." hello"
+.\" banana"
+
+." a" .( this should be shown) ." END" 65 EMIT
+
+CR .( End of Core word set tests) CR
+
+." This is the end."
+