diff --git a/common/boot.fs b/common/boot.fs index a07a82b..f93b33e 100644 --- a/common/boot.fs +++ b/common/boot.fs @@ -16,12 +16,6 @@ sp@ constant sp0 rp@ constant rp0 fp@ constant fp0 -: depth ( -- n ) sp@ sp0 - cell/ ; -: fdepth ( -- n ) fp@ fp0 - 4 / ; - -( Useful heap size words ) -: remaining ( -- n ) 'heap-start @ 'heap-size @ + 'heap @ - ; -: used ( -- n ) 'heap @ sp@ 'stack-cells @ cells + - 28 + ; ( Quoting Words ) : ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ; @@ -85,7 +79,7 @@ create RECSTACK 0 , 10 cells allot : postpone ( "name" -- ) bl parse RECSTACK RECOGNIZE @ execute ; immediate : +evaluate1 bl parse dup 0= if 2drop exit then - RECSTACK RECOGNIZE state @ 2 + cells + @ execute + RECSTACK RECOGNIZE state @ 1+ 1+ cells + @ execute ; ( Setup recognizing words. ) @@ -108,6 +102,14 @@ create RECSTACK 0 , 10 cells allot ; ' REC-NUM +RECOGNIZER +: interpret0 begin +evaluate1 again ; interpret0 + +( Useful stack/heap words ) +: depth ( -- n ) sp@ sp0 - cell/ ; +: fdepth ( -- n ) fp@ fp0 - 4 / ; +: remaining ( -- n ) 'heap-start @ 'heap-size @ + 'heap @ - ; +: used ( -- n ) 'heap @ sp@ 'stack-cells @ cells + - 28 + ; + ( DO..LOOP ) variable leaving : leaving, here leaving @ , leaving ! ; diff --git a/common/core.h b/common/core.h index c073043..aeb3633 100644 --- a/common/core.h +++ b/common/core.h @@ -188,35 +188,12 @@ static cell_t *evaluate1(cell_t *rp) { call = xt; } } else { - cell_t n; - if (convert((const char *) name, len, g_sys->base, &n)) { - if (g_sys->state) { - COMMA(g_sys->DOLIT_XT); - COMMA(n); - } else { - PUSH n; - } - } else { - float f; - if (fconvert((const char *) name, len, &f)) { - if (g_sys->state) { - COMMA(g_sys->DOFLIT_XT); - *(float *) g_sys->heap++ = f; - } else { - *++fp = f; - } - } else { #if PRINT_ERRORS - fprintf(stderr, "CANT FIND: "); - fwrite((void *) name, 1, len, stderr); - fprintf(stderr, "\n"); + fprintf(stderr, "CANT FIND: "); + fwrite((void *) name, 1, len, stderr); + fprintf(stderr, "\n"); #endif - PUSH name; - PUSH len; - PUSH -1; - call = g_sys->notfound; - } - } + return 0; } PUSH call; PARK; diff --git a/common/forth_namespace_tests.fs b/common/forth_namespace_tests.fs index 1a77f84..efd6312 100644 --- a/common/forth_namespace_tests.fs +++ b/common/forth_namespace_tests.fs @@ -115,6 +115,10 @@ e: check-boot out: UNLOOP out: ?do out: do + out: used + out: remaining + out: fdepth + out: depth out: postpone out: next out: for @@ -134,10 +138,6 @@ e: check-boot out: char out: ['] out: ' - out: used - out: remaining - out: fdepth - out: depth out: fp0 out: rp0 out: sp0 @@ -159,6 +159,11 @@ e: check-tier2-opcodes ;e e: check-tier1-opcodes + out: 0 + out: 1 + out: -1 + out: 10 + out: 41 out: nip out: rdrop out: */ diff --git a/common/tier1_opcodes.h b/common/tier1_opcodes.h index 5ff347f..b83833c 100644 --- a/common/tier1_opcodes.h +++ b/common/tier1_opcodes.h @@ -13,6 +13,11 @@ // limitations under the License. #define TIER1_OPCODE_LIST \ + X("0", ZERO, PUSH 0) \ + X("1", ONE, PUSH 1) \ + X("-1", NEGATIVEONE, PUSH -1) \ + X("10", TEN, PUSH 10) \ + X("41", FOURTYONE, PUSH 41) \ Y(nip, NIP) \ Y(rdrop, --rp) \ XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \ diff --git a/common/vocabulary.fs b/common/vocabulary.fs index db6ad3d..0686786 100644 --- a/common/vocabulary.fs +++ b/common/vocabulary.fs @@ -61,7 +61,7 @@ transfer{ tib-setup input-limit sp-limit ?stack [SKIP] [SKIP]' raw-ok boot-prompt free. $place zplace BUILTIN_MARK - nest-depth handler +evaluate1 do-notfound + nest-depth handler +evaluate1 do-notfound interpret0 }transfer ( Move branching opcodes to separate vocabulary. )