From bcc804289f166a37855744d47f213c12a632d776 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Sun, 21 Nov 2021 13:47:31 +0100 Subject: [PATCH] more words implemented --- README.md | 14 +++++------- include/forth_internal.h | 1 + src/fh_builtins_mem.c | 25 +++++++++++++++++++++ src/fh_builtins_text.c | 47 ++++++++++++++++++++++++++++++++++++++-- testfiles/combinedtest.f | 4 ++-- testfiles/dotquote.txt | 9 ++++++++ 6 files changed, 88 insertions(+), 12 deletions(-) create mode 100644 testfiles/dotquote.txt diff --git a/README.md b/README.md index 2c630dc..b4adb3f 100644 --- a/README.md +++ b/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 -HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD 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] ] +CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? 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 +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 diff --git a/include/forth_internal.h b/include/forth_internal.h index 2ce78af..b28c8f6 100644 --- a/include/forth_internal.h +++ b/include/forth_internal.h @@ -16,6 +16,7 @@ #include #include #include +#include #include "fh_config.h" #include "fh_error.h" diff --git a/src/fh_builtins_mem.c b/src/fh_builtins_mem.c index 3fde8ce..1bad0fb 100644 --- a/src/fh_builtins_mem.c +++ b/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 */ } }; diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c index 0840115..e436882 100644 --- a/src/fh_builtins_text.c +++ b/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}, diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index 6686fe1..4bc2459 100644 --- a/testfiles/combinedtest.f +++ b/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 diff --git a/testfiles/dotquote.txt b/testfiles/dotquote.txt new file mode 100644 index 0000000..9e1c3a5 --- /dev/null +++ b/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." +