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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

Binary file not shown.