diff --git a/README.md b/README.md index 369c8ee..0833a70 100644 --- a/README.md +++ b/README.md @@ -55,7 +55,7 @@ HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE 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 BUFFER: CASE ENDCASE ENDOF FALSE HEX HOLDS MARKER NIP OF PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN +.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: C" CASE COMPILE, ENDCASE ENDOF ERASE FALSE HEX HOLDS MARKER NIP OF PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN \ Other sets: @@ -69,8 +69,7 @@ CORE: ABORT" ACCEPT EVALUATE KEY CORE-EXT: -.R ACTION-OF C" COMPILE, DEFER DEFER! DEFER@ ERASE IS -PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE] +ACTION-OF DEFER DEFER! DEFER@ IS PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE] ``` . diff --git a/src/fh_builtins_mem.c b/src/fh_builtins_mem.c index 7863472..4d8f07f 100644 --- a/src/fh_builtins_mem.c +++ b/src/fh_builtins_mem.c @@ -246,6 +246,23 @@ static enum fh_error w_here(struct fh_thread_s *fh, const struct fh_word_s *w) return FH_OK; } +static enum fh_error w_erase(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t addr, len; + TRY(ds_pop(fh, &len)); + TRY(ds_pop(fh, &addr)); + + if (len > 0) { + if (addr+len < HEAP_SIZE) { + LOG("Erase at 0x%08x, len %d", addr, len); + memset(&fh->heap[addr], 0, len); + } + } + return FH_OK; +} + const struct name_and_handler fh_builtins_mem[] = { {"chars", wp_mul, 0, 1}, {"char+", wp_add, 0, 1}, @@ -259,6 +276,7 @@ const struct name_and_handler fh_builtins_mem[] = { {"aligned", w_aligned, 0, 0}, {"allot", w_allot, 0, 0}, {"buffer:", w_buffer_colon, 0, 0}, + {"erase", w_erase, 0, 0}, {"align", w_align, 0, 0}, {",", w_comma, 0, 0}, {"c,", w_c_comma, 0, 0}, diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index defa6ce..0fa7005 100644 --- a/src/fh_builtins_meta.c +++ b/src/fh_builtins_meta.c @@ -338,6 +338,17 @@ static enum fh_error w_semicolon(struct fh_thread_s *fh, const struct fh_word_s return FH_OK; } +static enum fh_error w_compile_comma(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + uint32_t xt; + TRY(ds_pop(fh, &xt)); + TRY(fh_put_instr(fh, FH_INSTR_WORD, xt)); + return FH_OK; +} + static enum fh_error w_immediate(struct fh_thread_s *fh, const struct fh_word_s *w) { (void) w; @@ -695,5 +706,6 @@ const struct name_and_handler fh_builtins_meta[] = { {"execute", w_execute, 0, 0}, {"environment?", w_env_query, 0, 0}, {"marker", w_marker, 0, 0}, + {"compile,", w_compile_comma, 0, 0}, { /* end marker */ } }; diff --git a/src/fh_builtins_text.c b/src/fh_builtins_text.c index be2c58b..500cd06 100644 --- a/src/fh_builtins_text.c +++ b/src/fh_builtins_text.c @@ -81,6 +81,19 @@ static enum fh_error w_dot(struct fh_thread_s *fh, const struct fh_word_s *w) } + +static enum fh_error w_dot_r(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t a = 0, n; + TRY(ds_pop(fh, &n)); + TRY(ds_pop(fh, &a)); + + FHPRINT("%*."PRIi32" ", n, (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; @@ -100,7 +113,7 @@ static enum fh_error w_u_r(struct fh_thread_s *fh, const struct fh_word_s *w) TRY(ds_pop(fh, &n)); TRY(ds_pop(fh, &a)); - FHPRINT("%*d", n, a); + FHPRINT("%*."PRIu32, n, a); return FH_OK; } @@ -482,6 +495,7 @@ 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}, + {".r", w_dot_r, 0, 0}, {"u.", w_u_dot, 0, 0}, {"type", w_type, 0, 0}, {"fill", w_fill, 0, 0}, diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index 4bc2459..b98ba86 100644 --- a/testfiles/combinedtest.f +++ b/testfiles/combinedtest.f @@ -838,7 +838,6 @@ T{ ' W1 >BODY -> HERE }T T{ W1 -> HERE 1 + }T T{ W1 -> HERE 2 + }T -0 [if] \ TODO \ ------------------------------------------------------------------------ TESTING EVALUATE @@ -883,7 +882,6 @@ DROP -> 0 }T \ BLANK LINE RETURN ZERO-LENGTH STRING : GS4 SOURCE >IN ! DROP ; T{ GS4 123 456 -> }T -[then] \ ------------------------------------------------------------------------ TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL @@ -1051,7 +1049,6 @@ TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U. T{ OUTPUT-TEST -> }T -0 [if] \ FIXME \ ------------------------------------------------------------------------ TESTING INPUT: ACCEPT @@ -1065,7 +1062,6 @@ CREATE ABUF 50 CHARS ALLOT ; T{ ACCEPT-TEST -> }T -[then] \ ------------------------------------------------------------------------ TESTING DICTIONARY SEARCH RULES