6502/of816
1
0
Fork 0
mirror of https://github.com/mgcaret/of816.git synced 2024-12-27 19:29:58 +00:00
Code Issues Projects Releases Wiki Activity

Make CONTEXT work like gforth and SLOF

Browse Source
This commit is contained in:
mgcaret 2020-10-31 15:01:58 -07:00
parent a8cde5abd9
commit 24e2927fd3
1 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
asm/forth-dictionary.s
View File

@ -36,7 +36,7 @@ dword SET_ORDER,"SET-ORDER"
.dword _IF
.dword empty
.dword DUP ; ( ... widn ... wid1 n n' )
ONLIT 0 ; ( ... widn ... wid1 n n' 1 )
ONLIT 0 ; ( ... widn ... wid1 n n' 0 )
.dword SLT ; ( ... widn ... wid1 n f )
.dword _IF ; ( ... widn ... wid1 n )
.dword dolist
@ -128,26 +128,31 @@ hword dCURRENT,"$CURRENT"
eword
.if max_search_order > 0
; H: ( -- wid ) Return first wordlist in search order.
; H: ( -- addr ) Return address of cell with first wid in the search order.
; H: if search order is empty, sets the search order to contain the CURRENT word list.
dword CONTEXT,"CONTEXT"
.else
hword CONTEXT,"CONTEXT"
.endif
ENTER
.if max_search_order > 0
.dword dORDER
.dword FETCH
.dword QDUP
.dword _IF
.dword empty
.dword DECR
.dword WLNUM
.dword FETCH
ENTER
.dword dORDER ; ( - addr )
.dword DUP ; ( .. addr addr )
.dword FETCH ; ( .. addr u )
.dword SCELLMULT ; ( .. addr u' )
.dword QDUP ; ( .. addr u' u' | addr u' )
.dword _IF ; ( .. addr u' | addr )
.dword empty ; false branch ( .. addr )
.dword PLUS ; ( addr u' - addr' )
EXIT
empty: .dword CELLPLUS ; ( addr - addr' )
.dword GET_CURRENT ; ( .. addr' wid )
.dword TOP_OF_ORDER ; ( .. addr' )
EXIT
.else
.dword dCURRENT
EXIT
.endif
empty: .dword dCURRENT
.dword FETCH
EXIT
eword
.if max_search_order > 0
@ -254,6 +259,7 @@ eword
dword SEAL,"SEAL"
ENTER
.dword CONTEXT
.dword FETCH
.dword ONE
.dword SET_ORDER
EXIT
@ -305,6 +311,7 @@ eword
dword DEFINITIONS,"DEFINITIONS"
ENTER
.dword CONTEXT
.dword FETCH
.dword SET_CURRENT
EXIT
eword
@ -5626,6 +5633,7 @@ dword WORDS,"WORDS"
ENTER
.dword CONTEXT
.dword FETCH
.dword FETCH
lp: .dword DUP ; ( h -- h h )
.dword _IF ; ( h h -- h )
.dword done