1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-23 18:08:05 +11:00

forth: Forth-ify "2*" stack management words

This commit is contained in:
Virgil Dupras 2020-03-24 14:44:10 -04:00
parent 67c55b0b2f
commit d6516e2122
4 changed files with 48 additions and 57 deletions

Binary file not shown.

View File

@ -1405,28 +1405,10 @@ SWAP:
push hl
jp next
; ( a b c d -- c d a b )
.db "2SWAP"
.fill 2
.dw $-SWAP
.db 0
SWAP2:
.dw nativeWord
pop de ; D
pop hl ; C
pop bc ; B
call chkPS
ex (sp), hl ; A in HL
push de ; D
push hl ; A
push bc ; B
jp next
; ( a -- a a )
.db "DUP"
.fill 4
.dw $-SWAP2
.dw $-SWAP
.db 0
DUP:
.dw nativeWord
@ -1436,26 +1418,10 @@ DUP:
push hl
jp next
; ( a b -- a b a b )
.db "2DUP"
.fill 3
.dw $-DUP
.db 0
DUP2:
.dw nativeWord
pop hl ; B
pop de ; A
call chkPS
push de
push hl
push de
push hl
jp next
; ( a b -- a b a )
.db "OVER"
.fill 3
.dw $-DUP2
.dw $-DUP
.db 0
OVER:
.dw nativeWord
@ -1467,29 +1433,9 @@ OVER:
push de
jp next
; ( a b c d -- a b c d a b )
.db "2OVER"
.fill 2
.dw $-OVER
.db 0
OVER2:
.dw nativeWord
pop hl ; D
pop de ; C
pop bc ; B
pop iy ; A
call chkPS
push iy ; A
push bc ; B
push de ; C
push hl ; D
push iy ; A
push bc ; B
jp next
.db ">R"
.fill 5
.dw $-OVER2
.dw $-OVER
.db 0
P2R:
.dw nativeWord

View File

@ -22,6 +22,11 @@
3 CONSTANT AF
3 CONSTANT SP
( As a general rule, IX and IY are equivalent to spitting an
extra 0xdd / 0xfd and then spit the equivalent of HL )
: IX 0xdd A, HL ;
: IY 0xfd A, HL ;
( -- )
: OP1 CREATE C, DOES> C@ A, ;
0xc9 OP1 RET,

View File

@ -30,4 +30,44 @@ CODE ROT
BC PUSHqq, ( A )
;CODE
( a b -- a b a b )
CODE 2DUP
HL POPqq, ( B )
DE POPqq, ( A )
ROUTINE P CALLnn,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
HL PUSHqq, ( B )
;CODE
( a b c d -- a b c d a b )
CODE 2OVER
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
IY POPqq, ( A )
ROUTINE P CALLnn,
IY PUSHqq, ( A )
BC PUSHqq, ( B )
DE PUSHqq, ( C )
HL PUSHqq, ( D )
IY PUSHqq, ( A )
BC PUSHqq, ( B )
;CODE
( a b c d -- c d a b )
CODE 2SWAP
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
IY POPqq, ( A )
ROUTINE P CALLnn,
DE PUSHqq, ( C )
HL PUSHqq, ( D )
IY PUSHqq, ( A )
BC PUSHqq, ( B )
;CODE