alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Reduce evaluate1.

Browse Source
This commit is contained in:
Brad Nelson
2024-04-20 22:20:26 -07:00
parent f08769855d
commit 3f6c7d1dbe
5 changed files with 28 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
common/boot.fs
View File

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