add ACCEPT and KEY

master
Ondřej Hruška 3 years ago
parent 2632f748b1
commit 5724ac4273
  1. 7
      README.md
  2. 1
      include/fh_builtins.h
  3. 1
      src/fh_builtins.c
  4. 77
      src/fh_builtins_stdin.c
  5. 6
      testfiles/combinedtest.f

@ -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]
```

@ -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);

@ -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;
}

@ -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 */ }
};

@ -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

Loading…
Cancel
Save