diff --git a/README.md b/README.md index 9850210..a3705de 100644 --- a/README.md +++ b/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] ``` diff --git a/include/fh_builtins.h b/include/fh_builtins.h index 4e8fcc0..1a61d61 100644 --- a/include/fh_builtins.h +++ b/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); diff --git a/src/fh_builtins.c b/src/fh_builtins.c index ad2e9ab..a3dc91f 100644 --- a/src/fh_builtins.c +++ b/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; } diff --git a/src/fh_builtins_stdin.c b/src/fh_builtins_stdin.c new file mode 100644 index 0000000..069a30f --- /dev/null +++ b/src/fh_builtins_stdin.c @@ -0,0 +1,77 @@ +#include "forth_internal.h" + +#include +#include + +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 */ } +}; diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index 63d55cc..fdcdf56 100644 --- a/testfiles/combinedtest.f +++ b/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