mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-27 15:18:05 +11:00
forth: Forth-ify "DUP"
This commit is contained in:
parent
09cd25df29
commit
cc4700e389
Binary file not shown.
@ -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 $
|
||||||
|
@ -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
|
||||||
|
@ -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 )
|
||||||
|
Loading…
Reference in New Issue
Block a user