Reduce evaluate1.
This commit is contained in:
@ -16,12 +16,6 @@
|
|||||||
sp@ constant sp0
|
sp@ constant sp0
|
||||||
rp@ constant rp0
|
rp@ constant rp0
|
||||||
fp@ constant fp0
|
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 )
|
( Quoting Words )
|
||||||
: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
|
: ' 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
|
: postpone ( "name" -- ) bl parse RECSTACK RECOGNIZE @ execute ; immediate
|
||||||
: +evaluate1
|
: +evaluate1
|
||||||
bl parse dup 0= if 2drop exit then
|
bl parse dup 0= if 2drop exit then
|
||||||
RECSTACK RECOGNIZE state @ 2 + cells + @ execute
|
RECSTACK RECOGNIZE state @ 1+ 1+ cells + @ execute
|
||||||
;
|
;
|
||||||
|
|
||||||
( Setup recognizing words. )
|
( Setup recognizing words. )
|
||||||
@ -108,6 +102,14 @@ create RECSTACK 0 , 10 cells allot
|
|||||||
;
|
;
|
||||||
' REC-NUM +RECOGNIZER
|
' 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 )
|
( DO..LOOP )
|
||||||
variable leaving
|
variable leaving
|
||||||
: leaving, here leaving @ , leaving ! ;
|
: leaving, here leaving @ , leaving ! ;
|
||||||
|
|||||||
@ -188,35 +188,12 @@ static cell_t *evaluate1(cell_t *rp) {
|
|||||||
call = xt;
|
call = xt;
|
||||||
}
|
}
|
||||||
} else {
|
} 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
|
#if PRINT_ERRORS
|
||||||
fprintf(stderr, "CANT FIND: ");
|
fprintf(stderr, "CANT FIND: ");
|
||||||
fwrite((void *) name, 1, len, stderr);
|
fwrite((void *) name, 1, len, stderr);
|
||||||
fprintf(stderr, "\n");
|
fprintf(stderr, "\n");
|
||||||
#endif
|
#endif
|
||||||
PUSH name;
|
return 0;
|
||||||
PUSH len;
|
|
||||||
PUSH -1;
|
|
||||||
call = g_sys->notfound;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
PUSH call;
|
PUSH call;
|
||||||
PARK;
|
PARK;
|
||||||
|
|||||||
@ -115,6 +115,10 @@ e: check-boot
|
|||||||
out: UNLOOP
|
out: UNLOOP
|
||||||
out: ?do
|
out: ?do
|
||||||
out: do
|
out: do
|
||||||
|
out: used
|
||||||
|
out: remaining
|
||||||
|
out: fdepth
|
||||||
|
out: depth
|
||||||
out: postpone
|
out: postpone
|
||||||
out: next
|
out: next
|
||||||
out: for
|
out: for
|
||||||
@ -134,10 +138,6 @@ e: check-boot
|
|||||||
out: char
|
out: char
|
||||||
out: [']
|
out: [']
|
||||||
out: '
|
out: '
|
||||||
out: used
|
|
||||||
out: remaining
|
|
||||||
out: fdepth
|
|
||||||
out: depth
|
|
||||||
out: fp0
|
out: fp0
|
||||||
out: rp0
|
out: rp0
|
||||||
out: sp0
|
out: sp0
|
||||||
@ -159,6 +159,11 @@ e: check-tier2-opcodes
|
|||||||
;e
|
;e
|
||||||
|
|
||||||
e: check-tier1-opcodes
|
e: check-tier1-opcodes
|
||||||
|
out: 0
|
||||||
|
out: 1
|
||||||
|
out: -1
|
||||||
|
out: 10
|
||||||
|
out: 41
|
||||||
out: nip
|
out: nip
|
||||||
out: rdrop
|
out: rdrop
|
||||||
out: */
|
out: */
|
||||||
|
|||||||
@ -13,6 +13,11 @@
|
|||||||
// limitations under the License.
|
// limitations under the License.
|
||||||
|
|
||||||
#define TIER1_OPCODE_LIST \
|
#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(nip, NIP) \
|
||||||
Y(rdrop, --rp) \
|
Y(rdrop, --rp) \
|
||||||
XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \
|
XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \
|
||||||
|
|||||||
@ -61,7 +61,7 @@ transfer{
|
|||||||
tib-setup input-limit sp-limit ?stack
|
tib-setup input-limit sp-limit ?stack
|
||||||
[SKIP] [SKIP]' raw-ok boot-prompt free.
|
[SKIP] [SKIP]' raw-ok boot-prompt free.
|
||||||
$place zplace BUILTIN_MARK
|
$place zplace BUILTIN_MARK
|
||||||
nest-depth handler +evaluate1 do-notfound
|
nest-depth handler +evaluate1 do-notfound interpret0
|
||||||
}transfer
|
}transfer
|
||||||
|
|
||||||
( Move branching opcodes to separate vocabulary. )
|
( Move branching opcodes to separate vocabulary. )
|
||||||
|
|||||||
Reference in New Issue
Block a user