izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-27 14:08:05 +11:00
Code Issues Releases Wiki Activity

Forth-ify 2DUP 2OVER 2SWAP

Browse Source 
2DROP was left in boot.z80 because it's used in icore.
This commit is contained in:
Virgil Dupras 2020-04-20 23:18:57 -04:00
parent 0438cb92fe
commit e569e40665
3 changed files with 11 additions and 48 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.

41
forth/boot.z80
View File

@ -424,17 +424,6 @@ CODE (roll)
LDDR, LDDR,
;CODE ;CODE
( a b -- a b a b )
CODE 2DUP
HL POPqq, ( B )
DE POPqq, ( A )
chkPS,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
HL PUSHqq, ( B )
;CODE
( a b -- ) ( a b -- )
CODE 2DROP CODE 2DROP
HL POPqq, HL POPqq,
@ -442,36 +431,6 @@ CODE 2DROP
chkPS, chkPS,
;CODE ;CODE
( a b c d -- a b c d a b )
CODE 2OVER
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A )
chkPS,
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
DE PUSHqq, ( C )
HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
;CODE
( a b c d -- c d a b )
CODE 2SWAP
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A )
chkPS,
DE PUSHqq, ( C )
HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A )
BC PUSHqq, ( B )
;CODE
CODE AND CODE AND
HL POPqq, HL POPqq,
DE POPqq, DE POPqq,

18
forth/core.fs
View File

@ -55,13 +55,6 @@
H@ 2- ( push a. -2 for allot offset ) H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE ; IMMEDIATE
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
;
( During a CASE, the stack grows by 1 at each ENDOF so that ( During a CASE, the stack grows by 1 at each ENDOF so that
we can fill all those ENDOF branching addrs. So that we we can fill all those ENDOF branching addrs. So that we
know when to stop, we put a 0 on PSP. That's our stopgap. ) know when to stop, we put a 0 on PSP. That's our stopgap. )
@ -143,6 +136,17 @@
: LEAVE R> R> DROP I 1- >R >R ; : LEAVE R> R> DROP I 1- >R >R ;
: ROLL
DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
SWAP DROP
;
: 2DUP OVER OVER ;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;
( a1 a2 u -- ) ( a1 a2 u -- )
: MOVE : MOVE
( u ) 0 DO ( u ) 0 DO