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

forth: Forth-ify "DUP"

This commit is contained in:
Virgil Dupras 2020-03-30 08:02:20 -04:00
parent 09cd25df29
commit cc4700e389
4 changed files with 16 additions and 20 deletions

Binary file not shown.

View File

@ -940,22 +940,10 @@ SWAP:
push hl push hl
jp next jp next
; ( a -- a a ) .fill 149
.db "DUP"
.dw $-SWAP
.db 3
DUP:
.dw nativeWord
pop hl
call chkPS
push hl
push hl
jp next
.fill 132
.db "_bend" .db "_bend"
.dw $-DUP .dw $-SWAP
.db 5 .db 5
; Offset: 06ee ; Offset: 06ee
.out $ .out $

View File

@ -60,10 +60,10 @@
( a -- ) ( a -- )
: (print) : (print)
BEGIN BEGIN
DUP ( a a ) _c DUP ( a a )
_c C@ ( a c ) _c C@ ( a c )
( exit if null ) ( exit if null )
DUP NOT IF DROP DROP EXIT THEN _c DUP NOT IF DROP DROP EXIT THEN
_c EMIT ( a ) _c EMIT ( a )
1 _c + ( a+1 ) 1 _c + ( a+1 )
AGAIN AGAIN
@ -85,7 +85,7 @@
: TOWORD : TOWORD
BEGIN BEGIN
C< DUP _c WS? NOT IF EXIT THEN DROP C< _c DUP _c WS? NOT IF EXIT THEN DROP
AGAIN AGAIN
; ;
@ -101,7 +101,7 @@
_c OVER ! ( a ) _c OVER ! ( a )
1 _c + ( a+1 ) 1 _c + ( a+1 )
C< ( a c ) C< ( a c )
DUP _c WS? _c DUP _c WS?
UNTIL UNTIL
( a this point, PS is: a WS ) ( a this point, PS is: a WS )
( null-termination is already written ) ( null-termination is already written )
@ -121,7 +121,7 @@
SCPY ( h ) SCPY ( h )
( Adjust HERE -1 because SCPY copies the null ) ( Adjust HERE -1 because SCPY copies the null )
HERE @ 1 _c - ( h h' ) HERE @ 1 _c - ( h h' )
DUP HERE ! ( h h' ) _c DUP HERE ! ( h h' )
SWAP _c - ( sz ) SWAP _c - ( sz )
( write prev value ) ( write prev value )
HERE @ CURRENT @ _c - , HERE @ CURRENT @ _c - ,
@ -162,7 +162,7 @@
_c WORD _c WORD
(find) (find)
( is word ) ( is word )
IF DUP _c IMMED? IF EXECUTE ELSE , THEN IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
( maybe number ) ( maybe number )
ELSE (parse*) @ EXECUTE _c LITN THEN ELSE (parse*) @ EXECUTE _c LITN THEN
AGAIN AGAIN

View File

@ -31,6 +31,14 @@ CODE ROT
BC PUSHqq, ( A ) BC PUSHqq, ( A )
;CODE ;CODE
( a -- a a )
CODE DUP
HL POPqq, ( A )
chkPS,
HL PUSHqq, ( A )
HL PUSHqq, ( A )
;CODE
( a b -- a b a ) ( a b -- a b a )
CODE OVER CODE OVER
HL POPqq, ( B ) HL POPqq, ( B )