Compare commits

...

3 Commits

Author SHA1 Message Date
Virgil Dupras
d8a6456206 (parsed): fix crash on parsing non-decimal staring with '-'
The address returned in the error condition would be off by one.
2020-05-25 21:15:07 -04:00
Virgil Dupras
2d17b4e8ec 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.
2020-05-25 20:34:52 -04:00
Virgil Dupras
6a507bcaac Add word MOVE, 2020-05-24 19:55:00 -04:00
24 changed files with 115 additions and 150 deletions

View File

@ -7,3 +7,4 @@ MOVE a1 a2 u -- Copy u bytes from a1 to a2, starting
with a1, going up.
MOVE- a1 a2 u -- Copy u bytes from a1 to a2, starting
with a1+u, going down.
MOVE, a u -- Copy u bytes from a to HERE.

12
blk/288
View File

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

View File

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

16
blk/291
View File

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

View File

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

View File

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

23
blk/328
View File

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

View File

@ -7,7 +7,9 @@
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
: NIP SWAP DROP ; : TUCK SWAP OVER ;
: -^ SWAP - ;
: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ;
: 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 ;

24
blk/357
View File

@ -1,16 +1,8 @@
: (parsed) ( a -- n f )
DUP C@ ( a c )
DUP '-' = IF
DROP 1+ ( a+1 ) (parsed) 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 ) ;
: (parsed) ( a -- n f )
C@+ OVER C@ 0 ( a len firstchar startat )
SWAP '-' = IF 1+ THEN ( a len startat )
0 ROT ROT ( len ) ( startat ) DO ( a r )
OVER I + C@ ( a r c ) _pdacc ( a r f )
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
( negate if needed )
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;

View File

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

21
blk/360
View File

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

22
blk/362
View File

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

16
blk/366
View File

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

8
blk/367 Normal file
View File

@ -0,0 +1,8 @@
: IMMEDIATE
CURRENT @ 1-
DUP C@ 128 OR SWAP C! ;
: IMMED? 1- C@ 0x80 AND ;
: +! TUCK @ + SWAP ! ;
: / /MOD NIP ;
: MOD /MOD DROP ;
: ALLOT HERE +! ;

12
blk/368
View File

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

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

26
blk/370
View File

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

23
blk/371
View File

@ -1,13 +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 ;
: 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 ;

View File

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

View File

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

View File

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

View File

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

Binary file not shown.

View File

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