mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 05:08:05 +11:00
forth: add words "2DUP", "2SWAP", "2OVER"
This commit is contained in:
parent
d8542f7cf7
commit
80f63cd185
@ -421,10 +421,26 @@ SWAP:
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
; ( a b c d -- c d a b )
|
||||
.db "2SWAP"
|
||||
.fill 3
|
||||
.dw SWAP
|
||||
SWAP2:
|
||||
.dw nativeWord
|
||||
pop de ; D
|
||||
pop hl ; C
|
||||
pop bc ; B
|
||||
|
||||
ex (sp), hl ; A in HL
|
||||
push de ; D
|
||||
push hl ; A
|
||||
push bc ; B
|
||||
jp exit
|
||||
|
||||
; ( a -- a a )
|
||||
.db "DUP"
|
||||
.fill 5
|
||||
.dw SWAP
|
||||
.dw SWAP2
|
||||
DUP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -432,10 +448,24 @@ DUP:
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
; ( a b -- a b a b )
|
||||
.db "2DUP"
|
||||
.fill 4
|
||||
.dw DUP
|
||||
DUP2:
|
||||
.dw nativeWord
|
||||
pop hl ; B
|
||||
pop de ; A
|
||||
push de
|
||||
push hl
|
||||
push de
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
; ( a b -- a b a )
|
||||
.db "OVER"
|
||||
.fill 4
|
||||
.dw DUP
|
||||
.dw DUP2
|
||||
OVER:
|
||||
.dw nativeWord
|
||||
pop hl ; B
|
||||
@ -445,10 +475,28 @@ OVER:
|
||||
push de
|
||||
jp exit
|
||||
|
||||
; ( a b c d -- a b c d a b )
|
||||
.db "2OVER"
|
||||
.fill 3
|
||||
.dw OVER
|
||||
OVER2:
|
||||
.dw nativeWord
|
||||
pop hl ; D
|
||||
pop de ; C
|
||||
pop bc ; B
|
||||
pop iy ; A
|
||||
push iy ; A
|
||||
push bc ; B
|
||||
push de ; C
|
||||
push hl ; D
|
||||
push iy ; A
|
||||
push bc ; B
|
||||
jp exit
|
||||
|
||||
; ( a b -- c ) A + B
|
||||
.db "+"
|
||||
.fill 7
|
||||
.dw OVER
|
||||
.dw OVER2
|
||||
PLUS:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -712,4 +760,3 @@ LATEST:
|
||||
.dw NUMBER
|
||||
.dw 1
|
||||
.dw EQ
|
||||
.dw EXIT
|
||||
|
@ -51,6 +51,9 @@ THEN -- Does nothing. Serves as a branching merker for IF
|
||||
DUP a -- a a
|
||||
OVER a b -- a b a
|
||||
SWAP a b -- b a
|
||||
2DUP a b -- a b a b
|
||||
2OVER a b c d -- a b c d a b
|
||||
2SWAP a b c d -- c d a b
|
||||
|
||||
*** Memory ***
|
||||
@ a -- n Set n to value at address a
|
||||
|
Loading…
Reference in New Issue
Block a user