@@ -6,5 +6,5 @@ PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit ) | |||||
E (HL) LDrr, D 0 LDrn, | E (HL) LDrr, D 0 LDrn, | ||||
DE INCss, DE INCss, | DE INCss, DE INCss, | ||||
DE ADDIYss, | DE ADDIYss, | ||||
HL INCss, HL PUSHqq, | |||||
HL PUSHqq, | |||||
JPNEXT, | JPNEXT, |
@@ -1,5 +1,5 @@ | |||||
( Name of BOOT word ) | ( Name of BOOT word ) | ||||
4 A, L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, | |||||
L1 BSET 4 A, 'B' A, 'O' A, 'O' A, 'T' A, | |||||
PC ORG @ 1 + ! ( main ) | PC ORG @ 1 + ! ( main ) | ||||
( STACK OVERFLOW PROTECTION: See B76 ) | ( STACK OVERFLOW PROTECTION: See B76 ) | ||||
@@ -5,7 +5,7 @@ PC ORG @ 4 + ! ( find ) | |||||
BC PUSHqq, | BC PUSHqq, | ||||
HL PUSHqq, | HL PUSHqq, | ||||
( First, figure out string len ) | ( First, figure out string len ) | ||||
HL DECss, A (HL) LDrr, A ORr, | |||||
A (HL) LDrr, A ORr, | |||||
( special case. zero len? we never find anything. ) | ( special case. zero len? we never find anything. ) | ||||
IFNZ, ( fail-B296 ) | IFNZ, ( fail-B296 ) | ||||
( Let's do something weird: We'll hold HL by the *tail*. | ( Let's do something weird: We'll hold HL by the *tail*. | ||||
@@ -1,6 +1,6 @@ | |||||
6 A, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, | 6 A, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, | ||||
L2 BSET ( abortUnderflow ) | L2 BSET ( abortUnderflow ) | ||||
HL PC 6 - LDddnn, | |||||
HL PC 7 - LDddnn, | |||||
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT ) | DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT ) | ||||
0x03 BCALL, ( find ) | 0x03 BCALL, ( find ) | ||||
0x33 BJP, ( 33 == execute ) | 0x33 BJP, ( 33 == execute ) | ||||
@@ -1,6 +1,5 @@ | |||||
CODE S= | CODE S= | ||||
DE POPqq, HL POPqq, chkPS, | DE POPqq, HL POPqq, chkPS, | ||||
HL DECss, DE DECss, | |||||
LDA(DE), | LDA(DE), | ||||
(HL) CPr, | (HL) CPr, | ||||
IFZ, ( same size? ) | IFZ, ( same size? ) | ||||
@@ -1,4 +1,4 @@ | |||||
: _ ( a len -- n f ) | |||||
: _ ( a+1 len -- n f ) | |||||
OVER C@ ( a len c ) | OVER C@ ( a len c ) | ||||
'-' = IF | '-' = IF | ||||
1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n ) | 1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n ) | ||||
@@ -6,6 +6,6 @@ | |||||
THEN ( a len ) | THEN ( a len ) | ||||
0 SWAP ( len ) 0 DO ( a r ) | 0 SWAP ( len ) 0 DO ( a r ) | ||||
OVER I + C@ ( a r c ) _pdacc ( a r f ) | OVER I + C@ ( a r c ) _pdacc ( a r f ) | ||||
IF DROP 0 UNLOOP EXIT THEN LOOP ( a r ) | |||||
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r ) | |||||
NIP 1 ; | NIP 1 ; | ||||
: (parsed) ( a -- n f ) DUP 1- C@ ( a l ) _ ; | |||||
: (parsed) ( a -- n f ) C@+ ( a+1 l ) _ ; |
@@ -3,9 +3,9 @@ | |||||
: (parsec) ( a -- n f ) | : (parsec) ( a -- n f ) | ||||
( apostrophe is ASCII 39 ) | ( apostrophe is ASCII 39 ) | ||||
DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f ) | |||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f ) | |||||
NOT IF 0 EXIT THEN ( a 0 ) | NOT IF 0 EXIT THEN ( a 0 ) | ||||
( surrounded by apos, good, return ) | ( surrounded by apos, good, return ) | ||||
1+ C@ 1 ( n 1 ) | |||||
2+ C@ 1 ( n 1 ) | |||||
; | ; | ||||
@@ -1,9 +1,9 @@ | |||||
: (parseh) ( a -- n f ) | : (parseh) ( a -- n f ) | ||||
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) | |||||
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) | |||||
( '0': ASCII 0x30 'x': 0x78 0x7830 ) | |||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 ) | |||||
( We have "0x" prefix ) | ( We have "0x" prefix ) | ||||
DUP 1- C@ ( a len ) | |||||
0 SWAP ( len ) 2 DO ( a r ) | |||||
DUP C@ ( a len ) | |||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r ) | |||||
OVER I + C@ ( a r c ) _ ( a r n ) | OVER I + C@ ( a r c ) _ ( a r n ) | ||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN | DUP 0< IF 2DROP 0 UNLOOP EXIT THEN | ||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP | SWAP 4 LSHIFT + ( a r*16+n ) LOOP | ||||
@@ -1,9 +1,9 @@ | |||||
: (parseb) ( a -- n f ) | : (parseb) ( a -- n f ) | ||||
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) | |||||
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) | |||||
( '0': ASCII 0x30 'b': 0x62 0x6230 ) | |||||
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 ) | |||||
( We have "0b" prefix ) | ( We have "0b" prefix ) | ||||
DUP 1- C@ ( a len ) | |||||
0 SWAP ( len ) 2 DO ( a r ) | |||||
DUP C@ ( a len ) | |||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r ) | |||||
OVER I + C@ ( a r c ) _ ( a r n ) | OVER I + C@ ( a r c ) _ ( a r n ) | ||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN | DUP 0< IF 2DROP 0 UNLOOP EXIT THEN | ||||
SWAP 1 LSHIFT + ( a r*2+n ) LOOP | SWAP 1 LSHIFT + ( a r*2+n ) LOOP | ||||
@@ -1,15 +1,13 @@ | |||||
( Read word from C<, copy to WORDBUF, null-terminate, and | ( Read word from C<, copy to WORDBUF, null-terminate, and | ||||
return WORDBUF. ) | return WORDBUF. ) | ||||
: _wb 0x0e RAM+ ; | : _wb 0x0e RAM+ ; | ||||
: _eot 4 _wb ! _wb ; | |||||
: _eot 0x0401 _wb ! _wb ; | |||||
: WORD | : WORD | ||||
_wb 1+ TOWORD ( a c ) | _wb 1+ TOWORD ( a c ) | ||||
DUP EOT? IF 2DROP _eot EXIT THEN | DUP EOT? IF 2DROP _eot EXIT THEN | ||||
BEGIN | BEGIN | ||||
( We take advantage of the fact that char MSB is | |||||
always zero to pre-write our null-termination ) | |||||
OVER ! 1+ C< ( a c ) | |||||
OVER 0x2d ( 2e-1 for NULL ) RAM+ = OVER WS? OR | |||||
OVER C! 1+ C< ( a c ) | |||||
OVER 0x2e RAM+ = OVER WS? OR | |||||
UNTIL ( a c ) | UNTIL ( a c ) | ||||
SWAP _wb - 1- ( ws len ) _wb C! | SWAP _wb - 1- ( ws len ) _wb C! | ||||
EOT? IF _eot ELSE _wb 1+ THEN ; | |||||
EOT? IF _eot ELSE _wb THEN ; |
@@ -1,5 +1,5 @@ | |||||
: [entry] ( w -- ) | : [entry] ( w -- ) | ||||
1- C@+ ( w+1 len ) TUCK MOVE, ( len ) | |||||
C@+ ( w+1 len ) TUCK MOVE, ( len ) | |||||
( write prev value ) | ( write prev value ) | ||||
H@ CURRENT @ - , | H@ CURRENT @ - , | ||||
C, ( write size ) | C, ( write size ) | ||||
@@ -1,7 +1,7 @@ | |||||
: EMIT | : EMIT | ||||
( 0x53==(emit) override ) | ( 0x53==(emit) override ) | ||||
0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ; | 0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ; | ||||
: (print) 1- C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; | |||||
: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; | |||||
: 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 CRLF THEN ; | : NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ; | ||||
@@ -1,6 +1,6 @@ | |||||
: INTERPRET | : INTERPRET | ||||
BEGIN | BEGIN | ||||
WORD DUP C@ EOT? IF DROP EXIT THEN | |||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN | |||||
FIND NOT IF (parse) ELSE EXECUTE THEN | FIND NOT IF (parse) ELSE EXECUTE THEN | ||||
C<? NOT IF SPC LIT< ok (print) NL THEN | C<? NOT IF SPC LIT< ok (print) NL THEN | ||||
AGAIN ; | AGAIN ; | ||||
@@ -1,4 +1,4 @@ | |||||
: LIT< WORD 34 , 1- DUP C@ 1+ MOVE, 0 C, ; IMMEDIATE | |||||
: LIT< WORD 34 , DUP C@ 1+ MOVE, 0 C, ; IMMEDIATE | |||||
: BEGIN H@ ; IMMEDIATE | : BEGIN H@ ; IMMEDIATE | ||||
: AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE | : AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE | ||||
: UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE | : UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE | ||||