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

Enhance see to support immediate.

Browse Source
This commit is contained in:
Brad Nelson
2022-07-14 16:59:06 -07:00
parent 50e77e3b3d
commit fb2366c5f4
2 changed files with 9 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
common/utils.fs
View File

@ -27,6 +27,7 @@
internals definitions internals definitions
2 constant SMUDGE 2 constant SMUDGE
4 constant BUILTIN_FORK 4 constant BUILTIN_FORK
1 constant IMMEDIATE_MARK
16 constant NONAMED 16 constant NONAMED
: mem= ( a a n -- f) : mem= ( a a n -- f)
for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ; for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
@ -56,9 +57,10 @@ internals definitions
see. ; see. ;
: see-loop dup >body swap >params 1- cells over + : see-loop dup >body swap >params 1- cells over +
begin 2dup < while swap see-one swap repeat 2drop ; begin 2dup < while swap see-one swap repeat 2drop ;
: ?see-flags >flags IMMEDIATE_MARK and if ." IMMEDIATE " then ;
: see-xt ( xt -- ) : see-xt ( xt -- )
dup @ ['] see-loop @ = if dup @ ['] see-loop @ = if
['] : see. dup see. space see-loop ['] ; see. cr exit ['] : see. dup see. space dup see-loop ['] ; see. ?see-flags cr exit
then then
dup >flags BUILTIN_FORK and if ." Built-in fork: " see. exit then dup >flags BUILTIN_FORK and if ." Built-in fork: " see. exit then
dup @ ['] input-buffer @ = if ." CREATE/VARIABLE: " see. cr exit then dup @ ['] input-buffer @ = if ." CREATE/VARIABLE: " see. cr exit then

6
common/utils_tests.fs
View File

@ -136,3 +136,9 @@ e: test-see-to
see bar see bar
out: : bar 123 TO foo ; out: : bar 123 TO foo ;
;e ;e
e: test-see-immediate
: foo 123 ; immediate
see foo
out: : foo 123 ; IMMEDIATE
;e