This commit is contained in:
Virgil Dupras 2020-05-25 20:16:07 -04:00
parent 53c9580944
commit 00401077f0
15 changed files with 25 additions and 28 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,9 +1,9 @@
: (parseh) ( a -- n f ) : (parseh) ( a -- n f )
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) ( '0': ASCII 0x30 'x': 0x78 0x7830 )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0x" prefix ) ( We have "0x" prefix )
DUP 1- C@ ( a len ) DUP C@ ( a len )
0 SWAP ( len ) 2 DO ( a r ) 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

View File

@ -1,9 +1,9 @@
: (parseb) ( a -- n f ) : (parseb) ( a -- n f )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) ( '0': ASCII 0x30 'b': 0x62 0x6230 )
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0b" prefix ) ( We have "0b" prefix )
DUP 1- C@ ( a len ) DUP C@ ( a len )
0 SWAP ( len ) 2 DO ( a r ) 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

10
blk/366
View File

@ -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 OVER C! 1+ C< ( a c )
always zero to pre-write our null-termination ) OVER 0x2e RAM+ = OVER WS? OR
OVER ! 1+ C< ( a c )
OVER 0x2d ( 2e-1 for NULL ) 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 ;

View File

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

View File

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

View File

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

View File

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

Binary file not shown.