Make string length-prefixed instead of null-terminated
I'm not sure why I chose null-terminated initially. Probably because the z80asm version had null-terminated strings. Length-prefixes strings are the traditional form of strings in Forth and it's a bit easier to work with them with traditional forth words when they're under this form.
This commit is contained in:
parent
6a507bcaac
commit
2d17b4e8ec
12
blk/288
12
blk/288
@ -3,14 +3,8 @@ PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
|
|||||||
number, it's followed by a null-terminated string. When
|
number, it's followed by a null-terminated string. When
|
||||||
called, puts the string's address on PS )
|
called, puts the string's address on PS )
|
||||||
IY PUSHqq, HL POPqq, ( <-- IP )
|
IY PUSHqq, HL POPqq, ( <-- IP )
|
||||||
|
E (HL) LDrr, D 0 LDrn,
|
||||||
|
DE INCss,
|
||||||
|
DE ADDIYss,
|
||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
( skip to null char )
|
|
||||||
A XORr, ( look for null )
|
|
||||||
B A LDrr,
|
|
||||||
C A LDrr,
|
|
||||||
CPIR,
|
|
||||||
( CPIR advances HL regardless of comparison, so goes one
|
|
||||||
char after NULL. This is good, because that's what we
|
|
||||||
want... )
|
|
||||||
HL PUSHqq, IY POPqq, ( --> IP )
|
|
||||||
JPNEXT,
|
JPNEXT,
|
||||||
|
2
blk/289
2
blk/289
@ -1,5 +1,5 @@
|
|||||||
( Name of BOOT word )
|
( Name of BOOT word )
|
||||||
L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, 0 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 )
|
||||||
|
16
blk/291
16
blk/291
@ -5,12 +5,12 @@ PC ORG @ 4 + ! ( find )
|
|||||||
BC PUSHqq,
|
BC PUSHqq,
|
||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
( First, figure out string len )
|
( First, figure out string len )
|
||||||
BC 0 LDddnn,
|
A (HL) LDrr, A ORr,
|
||||||
A XORr,
|
|
||||||
CPIR,
|
|
||||||
( C has our length, negative, -1 )
|
|
||||||
A C LDrr,
|
|
||||||
NEG,
|
|
||||||
A DECr,
|
|
||||||
( special case. zero len? we never find anything. )
|
( special case. zero len? we never find anything. )
|
||||||
IFNZ, ( fail-B296 ) ( cont. )
|
IFNZ, ( fail-B296 )
|
||||||
|
( Let's do something weird: We'll hold HL by the *tail*.
|
||||||
|
Because of our dict structure and because we know our
|
||||||
|
lengths, it's easier to compare starting from the end. )
|
||||||
|
C A LDrr, B 0 LDrn, ( C holds our length )
|
||||||
|
BC ADDHLss, HL INCss, ( HL points to after-last-char )
|
||||||
|
( cont . )
|
||||||
|
8
blk/292
8
blk/292
@ -1,11 +1,3 @@
|
|||||||
C A LDrr, ( C holds our length )
|
|
||||||
( Let's do something weird: We'll hold HL by the *tail*.
|
|
||||||
Because of our dict structure and because we know our
|
|
||||||
lengths, it's easier to compare starting from the end.
|
|
||||||
Currently, after CPIR, HL points to char after null. Let's
|
|
||||||
adjust. Because the compare loop pre-decrements, instead
|
|
||||||
of DECing HL twice, we DEC it once. )
|
|
||||||
HL DECss,
|
|
||||||
BEGIN, ( inner )
|
BEGIN, ( inner )
|
||||||
( DE is a wordref, first step, do our len correspond? )
|
( DE is a wordref, first step, do our len correspond? )
|
||||||
HL PUSHqq, ( --> lvl 1 )
|
HL PUSHqq, ( --> lvl 1 )
|
||||||
|
2
blk/298
2
blk/298
@ -1,4 +1,4 @@
|
|||||||
'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
|
6 A, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A,
|
||||||
L2 BSET ( abortUnderflow )
|
L2 BSET ( abortUnderflow )
|
||||||
HL PC 7 - LDddnn,
|
HL PC 7 - LDddnn,
|
||||||
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
|
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
|
||||||
|
15
blk/328
15
blk/328
@ -1,14 +1,15 @@
|
|||||||
CODE S=
|
CODE S=
|
||||||
DE POPqq,
|
DE POPqq, HL POPqq, chkPS,
|
||||||
HL POPqq,
|
LDA(DE),
|
||||||
chkPS,
|
(HL) CPr,
|
||||||
|
IFZ, ( same size? )
|
||||||
|
B A LDrr, ( loop A times )
|
||||||
BEGIN,
|
BEGIN,
|
||||||
|
HL INCss, DE INCss,
|
||||||
LDA(DE),
|
LDA(DE),
|
||||||
(HL) CPr,
|
(HL) CPr,
|
||||||
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
JRNZ, BREAK, ( not equal? break early. NZ is set. )
|
||||||
A ORr, ( if our char is null, stop )
|
DJNZ, AGAIN,
|
||||||
HL INCss,
|
THEN,
|
||||||
DE INCss,
|
|
||||||
JRNZ, AGAIN,
|
|
||||||
PUSHZ,
|
PUSHZ,
|
||||||
;CODE
|
;CODE
|
||||||
|
1
blk/354
1
blk/354
@ -11,3 +11,4 @@
|
|||||||
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
||||||
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
||||||
: C!- ( c a -- a-1 ) TUCK C! 1- ;
|
: C!- ( c a -- a-1 ) TUCK C! 1- ;
|
||||||
|
: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ;
|
||||||
|
25
blk/357
25
blk/357
@ -1,16 +1,11 @@
|
|||||||
: (parsed) ( a -- n f )
|
: _ ( a+1 len -- n f )
|
||||||
DUP C@ ( a c )
|
OVER C@ ( a len c )
|
||||||
DUP '-' = IF
|
'-' = IF
|
||||||
DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
|
1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n )
|
||||||
- SWAP EXIT ( 0-n f )
|
- SWAP EXIT ( 0-n f )
|
||||||
THEN
|
THEN ( a len )
|
||||||
0 SWAP _pdacc ( a r f )
|
0 SWAP ( len ) 0 DO ( a r )
|
||||||
?DUP IF 2DROP 0 EXIT THEN
|
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||||
BEGIN ( a r )
|
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||||
SWAP 1+ ( r a+1 )
|
NIP 1 ;
|
||||||
DUP C@ ( r a c )
|
: (parsed) ( a -- n f ) C@+ ( a+1 l ) _ ;
|
||||||
ROT SWAP ( a r c )
|
|
||||||
_pdacc ( a r f )
|
|
||||||
?DUP UNTIL
|
|
||||||
1 = ( a r f )
|
|
||||||
ROT DROP ( r f ) ;
|
|
||||||
|
4
blk/358
4
blk/358
@ -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 )
|
||||||
;
|
;
|
||||||
|
|
||||||
|
21
blk/360
21
blk/360
@ -1,15 +1,10 @@
|
|||||||
: (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 )
|
||||||
2+
|
DUP C@ ( a len )
|
||||||
0 ( a r )
|
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||||
BEGIN
|
OVER I + C@ ( a r c ) _ ( a r n )
|
||||||
SWAP C@+ ( r a+1 c )
|
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||||
?DUP NOT IF DROP 1 EXIT THEN ( r, 1 )
|
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||||
_ ( r a n )
|
NIP 1 ;
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
|
||||||
ROT 16 * + ( a r*16+n )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
22
blk/362
22
blk/362
@ -1,16 +1,10 @@
|
|||||||
: (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 )
|
||||||
2+
|
DUP C@ ( a len )
|
||||||
0 ( a r )
|
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||||
BEGIN
|
OVER I + C@ ( a r c ) _ ( a r n )
|
||||||
SWAP C@+ ( r a+1 c )
|
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||||
?DUP NOT IF DROP 1 EXIT THEN ( r 1 )
|
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||||
_ ( r a n )
|
NIP 1 ;
|
||||||
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
|
|
||||||
ROT 2 * + ( a r*2+n )
|
|
||||||
AGAIN
|
|
||||||
;
|
|
||||||
|
|
||||||
|
|
||||||
|
16
blk/366
16
blk/366
@ -1,13 +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+ ;
|
||||||
|
: _eot 0x0401 _wb ! _wb ;
|
||||||
: WORD
|
: WORD
|
||||||
0x0e RAM+ TOWORD ( a c )
|
_wb 1+ TOWORD ( a c )
|
||||||
DUP EOT? IF OVER ! 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 )
|
||||||
NIP 0x0e RAM+ ( ws a )
|
SWAP _wb - 1- ( ws len ) _wb C!
|
||||||
SWAP EOT? IF 4 OVER ! THEN ;
|
EOT? IF _eot ELSE _wb THEN ;
|
||||||
|
9
blk/367
Normal file
9
blk/367
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
: IMMEDIATE
|
||||||
|
CURRENT @ 1-
|
||||||
|
DUP C@ 128 OR SWAP C! ;
|
||||||
|
: IMMED? 1- C@ 0x80 AND ;
|
||||||
|
: +! TUCK @ + SWAP ! ;
|
||||||
|
: -^ SWAP - ;
|
||||||
|
: / /MOD NIP ;
|
||||||
|
: MOD /MOD DROP ;
|
||||||
|
: ALLOT HERE +! ;
|
12
blk/368
12
blk/368
@ -1,12 +0,0 @@
|
|||||||
: +! TUCK @ + SWAP ! ;
|
|
||||||
: [entry] ( w -- )
|
|
||||||
H@ SWAP
|
|
||||||
BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP
|
|
||||||
H@ SWAP - ( sz )
|
|
||||||
( write prev value )
|
|
||||||
H@ CURRENT @ - ,
|
|
||||||
C, ( write size )
|
|
||||||
H@ CURRENT !
|
|
||||||
;
|
|
||||||
|
|
||||||
: (entry) WORD [entry] ;
|
|
23
blk/369
23
blk/369
@ -1,11 +1,12 @@
|
|||||||
: IMMEDIATE
|
: '? WORD FIND ;
|
||||||
CURRENT @ 1-
|
: '
|
||||||
DUP C@ 128 OR SWAP C! ;
|
'? (?br) [ 4 , ] EXIT
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
LIT< (wnf) FIND DROP EXECUTE
|
||||||
: -^ SWAP - ;
|
;
|
||||||
: / /MOD NIP ;
|
: ROLL
|
||||||
: MOD /MOD DROP ;
|
?DUP NOT IF EXIT THEN
|
||||||
: ALLOT HERE +! ;
|
1+ DUP PICK ( n val )
|
||||||
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
SWAP 2 * (roll) ( val )
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
NIP ;
|
||||||
: LEAVE R> R> DROP I 1- >R >R ;
|
: 2OVER 3 PICK 3 PICK ;
|
||||||
|
: 2SWAP 3 ROLL 3 ROLL ;
|
||||||
|
26
blk/370
26
blk/370
@ -1,12 +1,14 @@
|
|||||||
: '? WORD FIND ;
|
: MOVE ( a1 a2 u -- )
|
||||||
: '
|
( u ) 0 DO ( a1 a2 )
|
||||||
'? (?br) [ 4 , ] EXIT
|
SWAP C@+ ( a2 a1+1 x )
|
||||||
LIT< (wnf) FIND DROP EXECUTE
|
ROT C!+ ( a1+1 a2+1 )
|
||||||
;
|
LOOP 2DROP ;
|
||||||
: ROLL
|
: MOVE- ( a1 a2 u -- )
|
||||||
?DUP NOT IF EXIT THEN
|
TUCK + 1- ( a1 u a2+u-1 )
|
||||||
1+ DUP PICK ( n val )
|
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||||
SWAP 2 * (roll) ( val )
|
ROT ( u ) 0 DO ( a2 a1 )
|
||||||
NIP ;
|
C@- ( a2 a1-1 x )
|
||||||
: 2OVER 3 PICK 3 PICK ;
|
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||||
: 2SWAP 3 ROLL 3 ROLL ;
|
LOOP 2DROP ;
|
||||||
|
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
||||||
|
: PREV 3 - DUP @ - ;
|
||||||
|
24
blk/371
24
blk/371
@ -1,14 +1,10 @@
|
|||||||
: MOVE ( a1 a2 u -- )
|
: [entry] ( w -- )
|
||||||
( u ) 0 DO ( a1 a2 )
|
C@+ ( w+1 len ) TUCK MOVE, ( len )
|
||||||
SWAP C@+ ( a2 a1+1 x )
|
( write prev value )
|
||||||
ROT C!+ ( a1+1 a2+1 )
|
H@ CURRENT @ - ,
|
||||||
LOOP 2DROP ;
|
C, ( write size )
|
||||||
: MOVE- ( a1 a2 u -- )
|
H@ CURRENT !
|
||||||
TUCK + 1- ( a1 u a2+u-1 )
|
;
|
||||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
: (entry) WORD [entry] ;
|
||||||
ROT ( u ) 0 DO ( a2 a1 )
|
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
|
||||||
C@- ( a2 a1-1 x )
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
|
||||||
LOOP 2DROP ;
|
|
||||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
|
||||||
: PREV 3 - DUP @ - ;
|
|
||||||
|
8
blk/381
8
blk/381
@ -1,13 +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)
|
: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ;
|
||||||
BEGIN
|
|
||||||
C@+ ( a+1 c )
|
|
||||||
( exit if null or 0xd )
|
|
||||||
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
|
|
||||||
EMIT ( a )
|
|
||||||
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 CRLF THEN ;
|
: NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;
|
||||||
|
5
blk/382
5
blk/382
@ -2,6 +2,9 @@
|
|||||||
BEGIN
|
BEGIN
|
||||||
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
||||||
AGAIN ;
|
AGAIN ;
|
||||||
: LIT" 34 , ( litWord ) ," 0 C, ; IMMEDIATE
|
: LIT"
|
||||||
|
34 , ( litWord ) H@ 0 C, ,"
|
||||||
|
DUP H@ -^ 1- ( a len ) SWAP C!
|
||||||
|
; IMMEDIATE
|
||||||
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
|
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
|
||||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
||||||
|
2
blk/392
2
blk/392
@ -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 ;
|
||||||
|
2
blk/399
2
blk/399
@ -1,4 +1,4 @@
|
|||||||
: LIT< WORD 34 , BEGIN C@+ DUP C, NOT UNTIL DROP ; IMMEDIATE
|
: LIT< WORD 34 , DUP C@ 1+ MOVE, ; 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
|
||||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
@ -42,7 +42,8 @@ static uint8_t iord_stdio()
|
|||||||
|
|
||||||
static void iowr_stdio(uint8_t val)
|
static void iowr_stdio(uint8_t val)
|
||||||
{
|
{
|
||||||
// we don't output stdout in stage0
|
// uncomment when you need to debug staging
|
||||||
|
// putc(val, stderr);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void iowr_here(uint8_t val)
|
static void iowr_here(uint8_t val)
|
||||||
|
Loading…
Reference in New Issue
Block a user