mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-05 08:40:54 +11:00
Add word ?DUP
This commit is contained in:
parent
6f8cbadfb0
commit
b08970ae8a
4
blk/046
4
blk/046
@ -2,6 +2,7 @@ Parameter Stack
|
|||||||
|
|
||||||
DROP a --
|
DROP a --
|
||||||
DUP a -- a a
|
DUP a -- a a
|
||||||
|
?DUP DUP if a is nonzero
|
||||||
OVER a b -- a b a
|
OVER a b -- a b a
|
||||||
ROT a b c -- b c a
|
ROT a b c -- b c a
|
||||||
SWAP a b -- b a
|
SWAP a b -- b a
|
||||||
@ -12,5 +13,4 @@ SWAP a b -- b a
|
|||||||
'S Returns current stack pointer, not counting the
|
'S Returns current stack pointer, not counting the
|
||||||
push it's making right now.
|
push it's making right now.
|
||||||
S0 Returns address of PSP TOS. When PSP is empty,
|
S0 Returns address of PSP TOS. When PSP is empty,
|
||||||
'S == S0
|
'S == S0 (cont.)
|
||||||
(cont.)
|
|
||||||
|
2
blk/154
2
blk/154
@ -3,7 +3,7 @@
|
|||||||
hit 0. )
|
hit 0. )
|
||||||
: ENDCASE
|
: ENDCASE
|
||||||
BEGIN
|
BEGIN
|
||||||
DUP NOT IF DROP EXIT THEN
|
?DUP NOT IF EXIT THEN
|
||||||
[COMPILE] THEN
|
[COMPILE] THEN
|
||||||
AGAIN
|
AGAIN
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
12
blk/307
12
blk/307
@ -1,9 +1,13 @@
|
|||||||
( a -- a a )
|
( a -- a a )
|
||||||
CODE DUP
|
CODE DUP
|
||||||
HL POPqq, ( A )
|
HL POPqq, chkPS,
|
||||||
chkPS,
|
HL PUSHqq, HL PUSHqq,
|
||||||
HL PUSHqq, ( A )
|
;CODE
|
||||||
HL PUSHqq, ( A )
|
|
||||||
|
CODE ?DUP
|
||||||
|
HL POPqq, chkPS,
|
||||||
|
HL PUSHqq,
|
||||||
|
HLZ, IFNZ, HL PUSHqq, THEN,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
( a -- )
|
( a -- )
|
||||||
|
8
blk/357
8
blk/357
@ -5,12 +5,12 @@
|
|||||||
- SWAP EXIT ( 0-n f )
|
- SWAP EXIT ( 0-n f )
|
||||||
THEN
|
THEN
|
||||||
0 SWAP _pdacc ( a r f )
|
0 SWAP _pdacc ( a r f )
|
||||||
DUP IF 2DROP 0 EXIT THEN
|
?DUP IF 2DROP 0 EXIT THEN
|
||||||
BEGIN ( a r 0 )
|
BEGIN ( a r )
|
||||||
DROP SWAP 1+ ( r a+1 )
|
SWAP 1+ ( r a+1 )
|
||||||
DUP C@ ( r a c )
|
DUP C@ ( r a c )
|
||||||
ROT SWAP ( a r c )
|
ROT SWAP ( a r c )
|
||||||
_pdacc ( a r f )
|
_pdacc ( a r f )
|
||||||
DUP UNTIL
|
?DUP UNTIL
|
||||||
1 = ( a r f )
|
1 = ( a r f )
|
||||||
ROT DROP ( r f ) ;
|
ROT DROP ( r f ) ;
|
||||||
|
2
blk/360
2
blk/360
@ -6,7 +6,7 @@
|
|||||||
0 ( a r )
|
0 ( a r )
|
||||||
BEGIN
|
BEGIN
|
||||||
SWAP C@+ ( r a+1 c )
|
SWAP C@+ ( r a+1 c )
|
||||||
DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
|
?DUP NOT IF DROP 1 EXIT THEN ( r, 1 )
|
||||||
_ ( r a n )
|
_ ( r a n )
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
||||||
ROT 16 * + ( a r*16+n )
|
ROT 16 * + ( a r*16+n )
|
||||||
|
2
blk/362
2
blk/362
@ -6,7 +6,7 @@
|
|||||||
0 ( a r )
|
0 ( a r )
|
||||||
BEGIN
|
BEGIN
|
||||||
SWAP C@+ ( r a+1 c )
|
SWAP C@+ ( r a+1 c )
|
||||||
DUP NOT IF 2DROP 1 EXIT THEN ( r 1 )
|
?DUP NOT IF DROP 1 EXIT THEN ( r 1 )
|
||||||
_ ( r a n )
|
_ ( r a n )
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
||||||
ROT 2 * + ( a r*2+n )
|
ROT 2 * + ( a r*2+n )
|
||||||
|
2
blk/364
2
blk/364
@ -1,7 +1,7 @@
|
|||||||
: C<? 0x06 RAM+ @ ;
|
: C<? 0x06 RAM+ @ ;
|
||||||
: C<
|
: C<
|
||||||
0x08 RAM+ @ ( 08 == C<* override )
|
0x08 RAM+ @ ( 08 == C<* override )
|
||||||
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* )
|
?DUP NOT IF 0x0c RAM+ @ THEN ( 0c == C<* )
|
||||||
EXECUTE
|
EXECUTE
|
||||||
;
|
;
|
||||||
: , H@ ! H@ 2+ HERE ! ;
|
: , H@ ! H@ 2+ HERE ! ;
|
||||||
|
2
blk/367
2
blk/367
@ -1,6 +1,6 @@
|
|||||||
: SCPY
|
: SCPY
|
||||||
BEGIN ( a )
|
BEGIN ( a )
|
||||||
C@+ ( a+1 c )
|
C@+ ( a+1 c )
|
||||||
DUP NOT IF 2DROP EXIT THEN
|
?DUP NOT IF DROP EXIT THEN
|
||||||
C, ( a c )
|
C, ( a c )
|
||||||
AGAIN ;
|
AGAIN ;
|
||||||
|
2
blk/370
2
blk/370
@ -4,7 +4,7 @@
|
|||||||
LIT< (wnf) FIND DROP EXECUTE
|
LIT< (wnf) FIND DROP EXECUTE
|
||||||
;
|
;
|
||||||
: ROLL
|
: ROLL
|
||||||
DUP NOT IF EXIT THEN
|
?DUP NOT IF EXIT THEN
|
||||||
1+ DUP PICK ( n val )
|
1+ DUP PICK ( n val )
|
||||||
SWAP 2 * (roll) ( val )
|
SWAP 2 * (roll) ( val )
|
||||||
SWAP DROP
|
SWAP DROP
|
||||||
|
4
blk/381
4
blk/381
@ -1,6 +1,6 @@
|
|||||||
: EMIT
|
: EMIT
|
||||||
( 0x53==(emit) override )
|
( 0x53==(emit) override )
|
||||||
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
|
0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ;
|
||||||
: (print)
|
: (print)
|
||||||
BEGIN
|
BEGIN
|
||||||
C@+ ( a+1 c )
|
C@+ ( a+1 c )
|
||||||
@ -10,6 +10,6 @@
|
|||||||
AGAIN ;
|
AGAIN ;
|
||||||
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
|
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
|
||||||
: CRLF CR LF ; : SPC 32 EMIT ;
|
: CRLF CR LF ; : SPC 32 EMIT ;
|
||||||
: NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ;
|
: NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;
|
||||||
: (uflw) LIT" stack underflow" ERR ;
|
: (uflw) LIT" stack underflow" ERR ;
|
||||||
: (wnf) (print) SPC LIT" word not found" ERR ;
|
: (wnf) (print) SPC LIT" word not found" ERR ;
|
||||||
|
2
blk/387
2
blk/387
@ -9,7 +9,7 @@
|
|||||||
|
|
||||||
: KEY
|
: KEY
|
||||||
85 RAM+ @ ( (key) override )
|
85 RAM+ @ ( (key) override )
|
||||||
DUP IF EXECUTE ELSE DROP (key) THEN ;
|
?DUP IF EXECUTE ELSE (key) THEN ;
|
||||||
|
|
||||||
|
|
||||||
( cont.: read one char into input buffer and returns whether we
|
( cont.: read one char into input buffer and returns whether we
|
||||||
|
2
blk/414
2
blk/414
@ -11,5 +11,5 @@
|
|||||||
DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN
|
DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN
|
||||||
( ah, finally, we have a gentle run-of-the-mill KC )
|
( ah, finally, we have a gentle run-of-the-mill KC )
|
||||||
PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@
|
PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@
|
||||||
DUP NOT IF DROP (key) THEN ;
|
?DUP NOT IF (key) THEN ;
|
||||||
|
|
||||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user