Add word ?DUP

This commit is contained in:
Virgil Dupras 2020-05-22 13:48:30 -04:00
parent 6f8cbadfb0
commit b08970ae8a
13 changed files with 24 additions and 20 deletions

View File

@ -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.)

View File

@ -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
View File

@ -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 -- )

View File

@ -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 ) ;

View File

@ -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 )

View File

@ -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 )

View File

@ -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 ! ;

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

Binary file not shown.