Make CONTEXT work like gforth and SLOF

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

View File

@ -36,7 +36,7 @@ dword SET_ORDER,"SET-ORDER"
.dword _IF .dword _IF
.dword empty .dword empty
.dword DUP ; ( ... widn ... wid1 n n' ) .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 SLT ; ( ... widn ... wid1 n f )
.dword _IF ; ( ... widn ... wid1 n ) .dword _IF ; ( ... widn ... wid1 n )
.dword dolist .dword dolist
@ -128,26 +128,31 @@ hword dCURRENT,"$CURRENT"
eword eword
.if max_search_order > 0 .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" dword CONTEXT,"CONTEXT"
.else .else
hword CONTEXT,"CONTEXT" hword CONTEXT,"CONTEXT"
.endif .endif
ENTER
.if max_search_order > 0 .if max_search_order > 0
.dword dORDER ENTER
.dword FETCH .dword dORDER ; ( - addr )
.dword QDUP .dword DUP ; ( .. addr addr )
.dword _IF .dword FETCH ; ( .. addr u )
.dword empty .dword SCELLMULT ; ( .. addr u' )
.dword DECR .dword QDUP ; ( .. addr u' u' | addr u' )
.dword WLNUM .dword _IF ; ( .. addr u' | addr )
.dword FETCH .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 EXIT
.endif .endif
empty: .dword dCURRENT
.dword FETCH
EXIT
eword eword
.if max_search_order > 0 .if max_search_order > 0
@ -254,6 +259,7 @@ eword
dword SEAL,"SEAL" dword SEAL,"SEAL"
ENTER ENTER
.dword CONTEXT .dword CONTEXT
.dword FETCH
.dword ONE .dword ONE
.dword SET_ORDER .dword SET_ORDER
EXIT EXIT
@ -305,6 +311,7 @@ eword
dword DEFINITIONS,"DEFINITIONS" dword DEFINITIONS,"DEFINITIONS"
ENTER ENTER
.dword CONTEXT .dword CONTEXT
.dword FETCH
.dword SET_CURRENT .dword SET_CURRENT
EXIT EXIT
eword eword
@ -5626,6 +5633,7 @@ dword WORDS,"WORDS"
ENTER ENTER
.dword CONTEXT .dword CONTEXT
.dword FETCH .dword FETCH
.dword FETCH
lp: .dword DUP ; ( h -- h h ) lp: .dword DUP ; ( h -- h h )
.dword _IF ; ( h h -- h ) .dword _IF ; ( h h -- h )
.dword done .dword done