1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 04:30:54 +11:00

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. with a1, going up.
MOVE- a1 a2 u -- Copy u bytes from a1 to a2, starting MOVE- a1 a2 u -- Copy u bytes from a1 to a2, starting
with a1+u, going down. 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 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,

View File

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

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

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

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

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

View File

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

22
blk/357
View File

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

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

21
blk/360
View File

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

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

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

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 : '? 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
View File

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

23
blk/371
View File

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

View File

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

View File

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

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

Binary file not shown.

View File

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