Parcourir la source

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.
pull/103/head
Virgil Dupras il y a 4 ans
Parent
révision
2d17b4e8ec
23 fichiers modifiés avec 116 ajouts et 150 suppressions
  1. +3
    -9
      blk/288
  2. +1
    -1
      blk/289
  3. +8
    -8
      blk/291
  4. +0
    -8
      blk/292
  5. +1
    -1
      blk/298
  6. +12
    -11
      blk/328
  7. +1
    -0
      blk/354
  8. +10
    -15
      blk/357
  9. +2
    -2
      blk/358
  10. +8
    -13
      blk/360
  11. +8
    -14
      blk/362
  12. +8
    -8
      blk/366
  13. +9
    -0
      blk/367
  14. +0
    -12
      blk/368
  15. +12
    -11
      blk/369
  16. +14
    -12
      blk/370
  17. +10
    -14
      blk/371
  18. +1
    -7
      blk/381
  19. +4
    -1
      blk/382
  20. +1
    -1
      blk/392
  21. +1
    -1
      blk/399
  22. BIN
      emul/forth.bin
  23. +2
    -1
      emul/stage.c

+ 3
- 9
blk/288 Voir le fichier

@@ -3,14 +3,8 @@ PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
IY PUSHqq, HL POPqq, ( <-- IP )
E (HL) LDrr, D 0 LDrn,
DE INCss,
DE ADDIYss,
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,

+ 1
- 1
blk/289 Voir le fichier

@@ -1,5 +1,5 @@
( 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 )
( STACK OVERFLOW PROTECTION: See B76 )


+ 8
- 8
blk/291 Voir le fichier

@@ -5,12 +5,12 @@ PC ORG @ 4 + ! ( find )
BC PUSHqq,
HL PUSHqq,
( First, figure out string len )
BC 0 LDddnn,
A XORr,
CPIR,
( C has our length, negative, -1 )
A C LDrr,
NEG,
A DECr,
A (HL) LDrr, A ORr,
( 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 . )

+ 0
- 8
blk/292 Voir le fichier

@@ -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 )
( DE is a wordref, first step, do our len correspond? )
HL PUSHqq, ( --> lvl 1 )


+ 1
- 1
blk/298 Voir le fichier

@@ -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 )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )


+ 12
- 11
blk/328 Voir le fichier

@@ -1,14 +1,15 @@
CODE S=
DE POPqq,
HL POPqq,
chkPS,
BEGIN,
LDA(DE),
(HL) CPr,
JRNZ, BREAK, ( not equal? break early. NZ is set. )
A ORr, ( if our char is null, stop )
HL INCss,
DE INCss,
JRNZ, AGAIN,
DE POPqq, HL POPqq, chkPS,
LDA(DE),
(HL) CPr,
IFZ, ( same size? )
B A LDrr, ( loop A times )
BEGIN,
HL INCss, DE INCss,
LDA(DE),
(HL) CPr,
JRNZ, BREAK, ( not equal? break early. NZ is set. )
DJNZ, AGAIN,
THEN,
PUSHZ,
;CODE

+ 1
- 0
blk/354 Voir le fichier

@@ -11,3 +11,4 @@
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
: C!- ( c a -- a-1 ) TUCK C! 1- ;
: LEAVE R> R> DROP I 1- >R >R ; : UNLOOP R> 2R> 2DROP >R ;

+ 10
- 15
blk/357 Voir le fichier

@@ -1,16 +1,11 @@
: (parsed) ( a -- n f )
DUP C@ ( a c )
DUP '-' = IF
DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
: _ ( a+1 len -- n f )
OVER C@ ( a len c )
'-' = IF
1- SWAP 1+ SWAP ( a+1 len-1 ) _ 0 ROT ( f 0 n )
- SWAP EXIT ( 0-n f )
THEN
0 SWAP _pdacc ( a r f )
?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
1 = ( a r f )
ROT DROP ( r f ) ;
THEN ( a len )
0 SWAP ( len ) 0 DO ( a r )
OVER I + C@ ( a r c ) _pdacc ( a r f )
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
NIP 1 ;
: (parsed) ( a -- n f ) C@+ ( a+1 l ) _ ;

+ 2
- 2
blk/358 Voir le fichier

@@ -3,9 +3,9 @@

: (parsec) ( a -- n f )
( 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 )
( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
2+ C@ 1 ( n 1 )
;


+ 8
- 13
blk/360 Voir le fichier

@@ -1,15 +1,10 @@
: (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 )
2+
0 ( a r )
BEGIN
SWAP C@+ ( r a+1 c )
?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 )
AGAIN
;

DUP C@ ( a len )
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
OVER I + C@ ( a r c ) _ ( a r n )
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
NIP 1 ;

+ 8
- 14
blk/362 Voir le fichier

@@ -1,16 +1,10 @@
: (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 )
2+
0 ( a r )
BEGIN
SWAP C@+ ( r a+1 c )
?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 )
AGAIN
;


DUP C@ ( a len )
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
OVER I + C@ ( a r c ) _ ( a r n )
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
NIP 1 ;

+ 8
- 8
blk/366 Voir le fichier

@@ -1,13 +1,13 @@
( Read word from C<, copy to WORDBUF, null-terminate, and
return WORDBUF. )
: _wb 0x0e RAM+ ;
: _eot 0x0401 _wb ! _wb ;
: WORD
0x0e RAM+ TOWORD ( a c )
DUP EOT? IF OVER ! EXIT THEN
_wb 1+ TOWORD ( a c )
DUP EOT? IF 2DROP _eot EXIT THEN
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 )
NIP 0x0e RAM+ ( ws a )
SWAP EOT? IF 4 OVER ! THEN ;
SWAP _wb - 1- ( ws len ) _wb C!
EOT? IF _eot ELSE _wb THEN ;

+ 9
- 0
blk/367 Voir le fichier

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

+ 0
- 12
blk/368 Voir le fichier

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

+ 12
- 11
blk/369 Voir le fichier

@@ -1,11 +1,12 @@
: IMMEDIATE
CURRENT @ 1-
DUP C@ 128 OR SWAP C! ;
: IMMED? 1- C@ 0x80 AND ;
: -^ SWAP - ;
: / /MOD NIP ;
: MOD /MOD DROP ;
: ALLOT HERE +! ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
: VARIABLE CREATE 2 ALLOT ;
: LEAVE R> R> DROP I 1- >R >R ;
: '? WORD FIND ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) FIND DROP EXECUTE
;
: ROLL
?DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
NIP ;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;

+ 14
- 12
blk/370 Voir le fichier

@@ -1,12 +1,14 @@
: '? WORD FIND ;
: '
'? (?br) [ 4 , ] EXIT
LIT< (wnf) FIND DROP EXECUTE
;
: ROLL
?DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val )
NIP ;
: 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ;
: MOVE ( a1 a2 u -- )
( u ) 0 DO ( a1 a2 )
SWAP C@+ ( a2 a1+1 x )
ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ;
: MOVE- ( a1 a2 u -- )
TUCK + 1- ( a1 u a2+u-1 )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
ROT ( u ) 0 DO ( a2 a1 )
C@- ( a2 a1-1 x )
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
LOOP 2DROP ;
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
: PREV 3 - DUP @ - ;

+ 10
- 14
blk/371 Voir le fichier

@@ -1,14 +1,10 @@
: MOVE ( a1 a2 u -- )
( u ) 0 DO ( a1 a2 )
SWAP C@+ ( a2 a1+1 x )
ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ;
: MOVE- ( a1 a2 u -- )
TUCK + 1- ( a1 u a2+u-1 )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
ROT ( u ) 0 DO ( a2 a1 )
C@- ( a2 a1-1 x )
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
LOOP 2DROP ;
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
: PREV 3 - DUP @ - ;
: [entry] ( w -- )
C@+ ( w+1 len ) TUCK MOVE, ( len )
( write prev value )
H@ CURRENT @ - ,
C, ( write size )
H@ CURRENT !
;
: (entry) WORD [entry] ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ;
: VARIABLE CREATE 2 ALLOT ;

+ 1
- 7
blk/381 Voir le fichier

@@ -1,13 +1,7 @@
: EMIT
( 0x53==(emit) override )
0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null or 0xd )
DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
EMIT ( a )
AGAIN ;
: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ;
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;


+ 4
- 1
blk/382 Voir le fichier

@@ -2,6 +2,9 @@
BEGIN
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
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
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

+ 1
- 1
blk/392 Voir le fichier

@@ -1,6 +1,6 @@
: INTERPRET
BEGIN
WORD DUP C@ EOT? IF DROP EXIT THEN
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
FIND NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF SPC LIT< ok (print) NL THEN
AGAIN ;


+ 1
- 1
blk/399 Voir le fichier

@@ -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
: AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE


BIN
emul/forth.bin Voir le fichier


+ 2
- 1
emul/stage.c Voir le fichier

@@ -42,7 +42,8 @@ static uint8_t iord_stdio()

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)


Chargement…
Annuler
Enregistrer