izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-23 22:18:07 +11:00
Code Issues Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

60
forth/forth.asm
View File

@ -1405,28 +1405,10 @@ SWAP:
push hl push hl
jp next 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 ) ; ( a -- a a )
.db "DUP" .db "DUP"
.fill 4 .fill 4
.dw $-SWAP2 .dw $-SWAP
.db 0 .db 0
DUP: DUP:
.dw nativeWord .dw nativeWord
@ -1436,26 +1418,10 @@ DUP:
push hl push hl
jp next 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 ) ; ( a b -- a b a )
.db "OVER" .db "OVER"
.fill 3 .fill 3
.dw $-DUP2 .dw $-DUP
.db 0 .db 0
OVER: OVER:
.dw nativeWord .dw nativeWord
@ -1467,29 +1433,9 @@ OVER:
push de push de
jp next 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" .db ">R"
.fill 5 .fill 5
.dw $-OVER2 .dw $-OVER
.db 0 .db 0
P2R: P2R:
.dw nativeWord .dw nativeWord

5
forth/z80a.fs
View File

@ -22,6 +22,11 @@
3 CONSTANT AF 3 CONSTANT AF
3 CONSTANT SP 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, ; : OP1 CREATE C, DOES> C@ A, ;
0xc9 OP1 RET, 0xc9 OP1 RET,

40
forth/z80c.fs
View File

@ -30,4 +30,44 @@ CODE ROT
BC PUSHqq, ( A ) BC PUSHqq, ( A )
;CODE ;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