add 2VALUE, modify TO to support it

This commit is contained in:
mgcaret 2020-10-29 17:58:09 -07:00
parent b15d48228e
commit 494acab881
1 changed files with 26 additions and 3 deletions

View File

@ -5911,7 +5911,7 @@ dword dTWOVALUE,"$2VALUE"
eword
; H: ( n [name< >] -- ) Create a definition that pushes n on the stack,
; H: n can be changed with TO.
; H: n can be changed with TO.
dword VALUE,"VALUE"
ENTER
.dword PARSE_WORD
@ -5919,6 +5919,15 @@ dword VALUE,"VALUE"
EXIT
eword
; H: ( n1 n2 [name< >] -- ) Create a definition that pushes n1 and n2 on the stack,
; H: n1 and n2 can be changed with TO.
dword TWOVALUE,"2VALUE"
ENTER
.dword PARSE_WORD
.dword dTWOVALUE
EXIT
eword
; H: ( n [name< >] -- ) Allocate n bytes of memory, create definition that
; H: returns the address of the allocated memory.
dword BUFFERC,"BUFFER:"
@ -6002,10 +6011,24 @@ dword ALIAS,"ALIAS"
NEXT
eword
; ( n xt -- ) change the first cell of the body of xt to n
hword _TO,"_TO"
; H: ( n xt | n1 n2 xt -- ) change the first cell or two of the body of xt
; H: if xt is a 2VALUE, change the first two cells of the body
; H: if xt is any other created word, change the first cell of the body
dword _TO,"(TO)"
ENTER
.dword DUP
.dword INCR
.dword FETCH
ONLIT (_push2value << 8) | opJSL
.dword EQUAL
.dword _IF
.dword just1
.dword rBODY
.dword TUCK
.dword STORE
.dword CELLPLUS
.dword _SKIP
just1: .dword rBODY
.dword STORE
EXIT
eword