add ACCEPT and KEY

README.md

@@ -49,9 +49,9 @@ 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 ABORT" ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
+: ; < = > >IN >R ?DUP @ ACCEPT 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
+HERE HOLD I IF IMMEDIATE INVERT J KEY 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:
@@ -65,9 +65,6 @@ FORGET SEE BYE INCLUDE INCLUDED
 Missing:
 
 ```
-CORE:
-ACCEPT KEY
-
 CORE-EXT:
 [COMPILE]
 ```

include/fh_builtins.h

@@ -34,6 +34,7 @@ extern const struct name_and_handler fh_builtins_mem[];
 extern const struct name_and_handler fh_builtins_meta[];
 extern const struct name_and_handler fh_builtins_text[];
 extern const struct name_and_handler fh_builtins_system[];
+extern const struct name_and_handler fh_builtins_stdin[];
 
 enum fh_error ds_pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len);
 

src/fh_builtins.c

@@ -32,5 +32,6 @@ enum fh_error register_builtin_words(struct fh_thread_s *fh)
   TRY(fh_register_words_from_array(fh, fh_builtins_meta));
   TRY(fh_register_words_from_array(fh, fh_builtins_text));
   TRY(fh_register_words_from_array(fh, fh_builtins_system));
+  TRY(fh_register_words_from_array(fh, fh_builtins_stdin));
   return FH_OK;
 }

src/fh_builtins_stdin.c

@@ -0,0 +1,77 @@
+#include "forth_internal.h"
+ 
+#include <unistd.h>
+#include <termios.h>
+
+static char getch() {
+        char buf = 0;
+        struct termios old = {0};
+        if (tcgetattr(0, &old) < 0)
+                perror("tcsetattr()");
+        old.c_lflag &= ~ICANON;
+        old.c_lflag &= ~ECHO;
+        old.c_cc[VMIN] = 1;
+        old.c_cc[VTIME] = 0;
+        if (tcsetattr(0, TCSANOW, &old) < 0)
+                perror("tcsetattr ICANON");
+        if (read(0, &buf, 1) < 0)
+                perror ("read()");
+        old.c_lflag |= ICANON;
+        old.c_lflag |= ECHO;
+        if (tcsetattr(0, TCSADRAIN, &old) < 0)
+                perror ("tcsetattr ~ICANON");
+        return (buf);
+}
+
+
+static enum fh_error w_key(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t a;
+  
+  a = getch();
+  
+  TRY(ds_push(fh, a));
+  return FH_OK;
+}
+
+static inline bool iscrlf(char c) {
+  return c == '\r' || c == '\n';
+}
+
+static enum fh_error w_accept(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  uint32_t abuf;
+  uint32_t count;
+  
+  TRY(ds_pop(fh, &count));
+  TRY(ds_pop(fh, &abuf));
+  
+  char *s = fgets(&fh->heap[abuf], count, stdin);
+  if (!s) {
+    LOGE("Error reading stdin!");
+    count = 0;
+  } else {
+    count = strnlen(s, count);
+    // remove the newline
+    if(count > 0) {
+      char *end = s + (count - 1);
+      while (iscrlf(*end)) {
+        end--;
+        count--;
+      }
+    }
+  }
+  
+  TRY(ds_push(fh, count));
+  return FH_OK;
+}
+
+const struct name_and_handler fh_builtins_stdin[] = {
+    {"key",  w_key,          0, 0},
+    {"accept",  w_accept,          0, 0},
+    { /* end marker */ }
+};

testfiles/combinedtest.f

@@ -25,9 +25,6 @@ VARIABLE VERBOSE
 
 VARIABLE #ERRORS 0 #ERRORS !
 
-: ERROR TYPE QUIT ;
-
-0 [if]
 : ERROR      \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
       \ THE LINE THAT HAD THE ERROR.
    CR TYPE SOURCE TYPE       \ DISPLAY LINE CORRESPONDING TO ERROR
@@ -35,7 +32,6 @@ VARIABLE #ERRORS 0 #ERRORS !
    #ERRORS @ 1 + #ERRORS !
 \   QUIT  \ *** Uncomment this line to QUIT on an error
 ;
-[then]
 
 VARIABLE ACTUAL-DEPTH         \ STACK RECORD
 CREATE ACTUAL-RESULTS 20 CELLS ALLOT
@@ -1053,7 +1049,6 @@ TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
 
 T{ OUTPUT-TEST -> }T
 
-0 [if]
 \ ------------------------------------------------------------------------
 TESTING INPUT: ACCEPT
 
@@ -1067,7 +1062,6 @@ CREATE ABUF 50 CHARS ALLOT
 ;
 
 T{ ACCEPT-TEST -> }T
-[then]
 
 \ ------------------------------------------------------------------------
 TESTING DICTIONARY SEARCH RULES