Add word ?DUP
This commit is contained in:
parent
986249cf5e
commit
f75b1c8864
4
blk/046
4
blk/046
@ -2,6 +2,7 @@ Parameter Stack
|
||||
|
||||
DROP a --
|
||||
DUP a -- a a
|
||||
?DUP DUP if a is nonzero
|
||||
OVER a b -- a b a
|
||||
ROT a b c -- b c a
|
||||
SWAP a b -- b a
|
||||
@ -12,5 +13,4 @@ SWAP a b -- b a
|
||||
'S Returns current stack pointer, not counting the
|
||||
push it's making right now.
|
||||
S0 Returns address of PSP TOS. When PSP is empty,
|
||||
'S == S0
|
||||
(cont.)
|
||||
'S == S0 (cont.)
|
||||
|
2
blk/154
2
blk/154
@ -3,7 +3,7 @@
|
||||
hit 0. )
|
||||
: ENDCASE
|
||||
BEGIN
|
||||
DUP NOT IF DROP EXIT THEN
|
||||
?DUP NOT IF EXIT THEN
|
||||
[COMPILE] THEN
|
||||
AGAIN
|
||||
; IMMEDIATE
|
||||
|
12
blk/307
12
blk/307
@ -1,9 +1,13 @@
|
||||
( a -- a a )
|
||||
CODE DUP
|
||||
HL POPqq, ( A )
|
||||
chkPS,
|
||||
HL PUSHqq, ( A )
|
||||
HL PUSHqq, ( A )
|
||||
HL POPqq, chkPS,
|
||||
HL PUSHqq, HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE ?DUP
|
||||
HL POPqq, chkPS,
|
||||
HL PUSHqq,
|
||||
HLZ, IFNZ, HL PUSHqq, THEN,
|
||||
;CODE
|
||||
|
||||
( a -- )
|
||||
|
8
blk/357
8
blk/357
@ -5,12 +5,12 @@
|
||||
- SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
0 SWAP _pdacc ( a r f )
|
||||
DUP IF 2DROP 0 EXIT THEN
|
||||
BEGIN ( a r 0 )
|
||||
DROP SWAP 1+ ( r a+1 )
|
||||
?DUP IF 2DROP 0 EXIT THEN
|
||||
BEGIN ( a r )
|
||||
SWAP 1+ ( r a+1 )
|
||||
DUP C@ ( r a c )
|
||||
ROT SWAP ( a r c )
|
||||
_pdacc ( a r f )
|
||||
DUP UNTIL
|
||||
?DUP UNTIL
|
||||
1 = ( a r f )
|
||||
ROT DROP ( r f ) ;
|
||||
|
2
blk/360
2
blk/360
@ -6,7 +6,7 @@
|
||||
0 ( a r )
|
||||
BEGIN
|
||||
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 )
|
||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
||||
ROT 16 * + ( a r*16+n )
|
||||
|
2
blk/362
2
blk/362
@ -6,7 +6,7 @@
|
||||
0 ( a r )
|
||||
BEGIN
|
||||
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 )
|
||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
||||
ROT 2 * + ( a r*2+n )
|
||||
|
2
blk/364
2
blk/364
@ -1,7 +1,7 @@
|
||||
: C<? 0x06 RAM+ @ ;
|
||||
: C<
|
||||
0x08 RAM+ @ ( 08 == C<* override )
|
||||
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* )
|
||||
?DUP NOT IF 0x0c RAM+ @ THEN ( 0c == C<* )
|
||||
EXECUTE
|
||||
;
|
||||
: , H@ ! H@ 2+ HERE ! ;
|
||||
|
2
blk/367
2
blk/367
@ -1,6 +1,6 @@
|
||||
: SCPY
|
||||
BEGIN ( a )
|
||||
C@+ ( a+1 c )
|
||||
DUP NOT IF 2DROP EXIT THEN
|
||||
?DUP NOT IF DROP EXIT THEN
|
||||
C, ( a c )
|
||||
AGAIN ;
|
||||
|
2
blk/370
2
blk/370
@ -4,7 +4,7 @@
|
||||
LIT< (wnf) FIND DROP EXECUTE
|
||||
;
|
||||
: ROLL
|
||||
DUP NOT IF EXIT THEN
|
||||
?DUP NOT IF EXIT THEN
|
||||
1+ DUP PICK ( n val )
|
||||
SWAP 2 * (roll) ( val )
|
||||
SWAP DROP
|
||||
|
4
blk/381
4
blk/381
@ -1,6 +1,6 @@
|
||||
: EMIT
|
||||
( 0x53==(emit) override )
|
||||
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
|
||||
0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ;
|
||||
: (print)
|
||||
BEGIN
|
||||
C@+ ( a+1 c )
|
||||
@ -10,6 +10,6 @@
|
||||
AGAIN ;
|
||||
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 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 ;
|
||||
: (wnf) (print) SPC LIT" word not found" ERR ;
|
||||
|
2
blk/387
2
blk/387
@ -9,7 +9,7 @@
|
||||
|
||||
: KEY
|
||||
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
|
||||
|
2
blk/414
2
blk/414
@ -11,5 +11,5 @@
|
||||
DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN
|
||||
( ah, finally, we have a gentle run-of-the-mill KC )
|
||||
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