izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-24 14:28:06 +11:00
Code Issues Releases Wiki Activity

Move all parsing words to Inner core

Browse Source 
This allows us to get rid of the (parse*) indirection.
This commit is contained in:
Virgil Dupras 2020-05-02 21:21:47 -04:00
parent 8009270e79
commit 3d908cef3a
32 changed files with 204 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
blk/060
View File

@ -4,8 +4,6 @@ I/O
result in n as well as whether parsing was a
success in f (false = failure, true =
success)
(parse*) -- a Variable holding the current pointer for
system number parsing. By default, (parse).
(print) a -- Print string at addr a.
. n -- Print n in its decimal form
.x n -- Print n's LSB in hex form. Always 2
@ -13,4 +11,6 @@ I/O
.X n -- Print n in hex form. Always 4 characters.
Numbers are never considered negative.
"-1 .X" --> ffff
(cont.)

2
blk/081
View File

@ -4,7 +4,7 @@ RAMSTART INITIAL_SP +55 (key) override
+04 HERE +59 blk's variables
+06 C<? +5b z80a's variables
+08 C<* override +5d adev's variables
+0a PARSEPTR +5f FUTURE USES
+0a RESERVED +5f FUTURE USES
+0c C<* +70 DRIVERS
+0e WORDBUF +80 RAMEND
+2e BOOT C< PTR

6
blk/089
View File

@ -10,7 +10,7 @@ very few things.
In a normal system, BOOT is in icore and does a few things:
1. Find "(parse)" and set "(parse*)" to it.
2. Find "(c<)" a set CINPTR to it (what C< calls).
3. Write LATEST in SYSTEM SCRATCHPAD ( see below )
1. Find "(c<)" a set CINPTR to it (what C< calls).
2. Initialize all overrides to 0.
3. Write LATEST in BOOT C< PTR ( see below )
4. Find "INIT". If found, execute. Otherwise, "INTERPRET"(cont)

8
blk/090
View File

@ -1,7 +1,7 @@
(cont.) On a bare system (only boot+icore), this sequence will
result in "(parse)" reading only decimals and (c<) reading
characters from memory starting from CURRENT (this is why we
put CURRENT in SYSTEM SCRATCHPAD, it tracks current pos ).
On a bare system (only boot+icore), this sequence will result
in (c<) reading characters from memory starting from CURRENT
(this is why we put CURRENT in BOOT C< PTR, it tracks current
pos ).
This means that you can put initialization code in source form
right into your binary, right after your last compiled dict

2
blk/265
View File

@ -8,7 +8,7 @@
ELSE ( w )
0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
IF DUP IMMED? NOT IF ABORT THEN EXECUTE
ELSE (parse*) @ EXECUTE LITN THEN
ELSE (parse) LITN THEN
THEN
AGAIN
;

3
blk/393
View File

@ -1,6 +1,5 @@
: RAM+ [ RAMSTART LITN ] + ;
: BIN+ [ BIN( @ LITN ] + ;
: (parse*) 0x0a RAM+ ;
: HERE 0x04 RAM+ ;
: CURRENT* 0x51 RAM+ ;
: CURRENT CURRENT* @ ;
@ -13,4 +12,4 @@
0 0x08 RAM+ ! ( 08 == C<* override )
LIT< INTERPRET (find) DROP EXECUTE
;
394 407 LOADR
394 413 LOADR

8
blk/394
View File

@ -4,5 +4,11 @@
: < CMP -1 = ;
: > CMP 1 = ;
: 0< 32767 > ;
: >= < NOT ;
: <= > NOT ;
: 0>= 0< NOT ;
( a -- a+1 c )
: C@+ DUP C@ SWAP 1+ SWAP ;
( c a -- a+1 )
: C!+ SWAP OVER C! 1+ ;

21
blk/398
View File

@ -1,16 +1,11 @@
( This is only the "early parser" in earlier stages. No need
for an abort message )
: (parse) (parsed) NOT IF ABORT THEN ;
( strings being sent to parse routines are always null
terminated )
: C<? 0x06 RAM+ @ ;
: C<
0x08 RAM+ @ ( 08 == C<* override )
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* )
EXECUTE
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f )
NOT IF 0 EXIT THEN ( a 0 )
( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
;
: , HERE @ ! HERE @ 2+ HERE ! ;
: C, HERE @ C! HERE @ 1+ HERE ! ;

20
blk/399
View File

@ -1,12 +1,14 @@
( The NOT is to normalize the negative/positive numbers to 1
or 0. Hadn't we wanted to normalize, we'd have written:
32 CMP 1 - )
: WS? 33 CMP 1+ NOT ;
: TOWORD
BEGIN
C< DUP WS? NOT IF EXIT THEN DROP
AGAIN
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN
( 'a' is ASCII 97. 59 = 97 - 48 )
49 -
DUP 0< IF EXIT THEN ( bad )
DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
;

29
blk/400
View File

@ -1,16 +1,15 @@
( Read word from C<, copy to WORDBUF, null-terminate, and
return, make HL point to WORDBUF. )
: WORD
0x0e RAM+ ( 0e == WORDBUF )
TOWORD ( a c )
: (parseh) ( a -- n f )
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0x" prefix )
2+
0 ( a r )
BEGIN
( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination )
OVER ! 1+ ( a+1 )
C< ( a c )
DUP WS?
UNTIL
( a this point, PS is: a WS )
( null-termination is already written )
2DROP
0x0e RAM+ ;
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 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
;

14
blk/401
View File

@ -1,10 +1,10 @@
: SCPY
BEGIN ( a )
DUP C@ ( a c )
DUP C, ( a c )
NOT IF DROP EXIT THEN
1+ ( a+1 )
AGAIN
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN
( bad )
255 -
;

27
blk/402
View File

@ -1,15 +1,16 @@
: [entry]
HERE @ ( w h )
SWAP SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1- ( h h' )
DUP HERE ! ( h h' )
SWAP - ( sz )
( write prev value )
HERE @ CURRENT @ - ,
( write size )
C,
HERE @ CURRENT !
: (parseb) ( a -- n f )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
DUP @ 25136 = 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 2DROP 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
;
: (entry) WORD [entry] ;

15
blk/403
View File

@ -1,9 +1,8 @@
: INTERPRET
BEGIN
WORD
(find)
NOT IF (parse*) @ THEN EXECUTE
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
AGAIN
: (parse) ( a -- n )
(parsec) IF EXIT THEN
(parseh) IF EXIT THEN
(parseb) IF EXIT THEN
(parsed) IF EXIT THEN
( nothing works )
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
;

17
blk/404
View File

@ -1,11 +1,12 @@
( system c< simply reads source from binary, starting at
LATEST. Convenient way to bootstrap a new system. )
: (boot<)
( 2e == BOOT C< PTR )
0x2e RAM+ @ ( a )
DUP C@ ( a c )
SWAP 1 + ( c a+1 )
0x2e RAM+ ! ( c )
: C<? 0x06 RAM+ @ ;
: C<
0x08 RAM+ @ ( 08 == C<* override )
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* )
EXECUTE
;
: , HERE @ ! HERE @ 2+ HERE ! ;
: C, HERE @ C! HERE @ 1+ HERE ! ;

23
blk/405
View File

@ -1,15 +1,12 @@
: BOOT
0x02 RAM+ CURRENT* !
LIT< (parse) (find) DROP (parse*) !
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
0 0x08 RAM+ ! ( 08 == C<* override )
0 0x53 RAM+ ! ( 53 == (emit) override )
0 0x55 RAM+ ! ( 55 == (key) override )
( 0c == C<* )
LIT< (boot<) (find) DROP 0x0c RAM+ !
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ !
LIT< INIT (find)
IF EXECUTE ELSE DROP INTERPRET THEN
( The NOT is to normalize the negative/positive numbers to 1
or 0. Hadn't we wanted to normalize, we'd have written:
32 CMP 1 - )
: WS? 33 CMP 1+ NOT ;
: TOWORD
BEGIN
C< DUP WS? NOT IF EXIT THEN DROP
AGAIN
;

30
blk/406
View File

@ -1,14 +1,16 @@
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: IMMED? 1- C@ 0x80 AND ;
( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by
xcomp. )
: _
['] EXIT ,
R> DROP ( exit : )
; IMMEDIATE
( Read word from C<, copy to WORDBUF, null-terminate, and
return, make HL point to WORDBUF. )
: WORD
0x0e RAM+ ( 0e == WORDBUF )
TOWORD ( a c )
BEGIN
( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination )
OVER ! 1+ ( a+1 )
C< ( a c )
DUP WS?
UNTIL
( a this point, PS is: a WS )
( null-termination is already written )
2DROP
0x0e RAM+ ;

26
blk/407
View File

@ -1,16 +1,10 @@
XCURRENT @ ( to PSP )
: :
(entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",".
32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
BEGIN
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse*) @ EXECUTE LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!
: SCPY
BEGIN ( a )
DUP C@ ( a c )
DUP C, ( a c )
NOT IF DROP EXIT THEN
1+ ( a+1 )
AGAIN
;

15
blk/408 Normal file
View File

@ -0,0 +1,15 @@
: [entry]
HERE @ ( w h )
SWAP SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1- ( h h' )
DUP HERE ! ( h h' )
SWAP - ( sz )
( write prev value )
HERE @ CURRENT @ - ,
( write size )
C,
HERE @ CURRENT !
;
: (entry) WORD [entry] ;

9
blk/409 Normal file
View File

@ -0,0 +1,9 @@
: INTERPRET
BEGIN
WORD
(find)
NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
AGAIN
;

11
blk/410 Normal file
View File

@ -0,0 +1,11 @@
( system c< simply reads source from binary, starting at
LATEST. Convenient way to bootstrap a new system. )
: (boot<)
( 2e == BOOT C< PTR )
0x2e RAM+ @ ( a )
DUP C@ ( a c )
SWAP 1 + ( c a+1 )
0x2e RAM+ ! ( c )
;

14
blk/411 Normal file
View File

@ -0,0 +1,14 @@
: BOOT
0x02 RAM+ CURRENT* !
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
0 0x08 RAM+ ! ( 08 == C<* override )
0 0x53 RAM+ ! ( 53 == (emit) override )
0 0x55 RAM+ ! ( 55 == (key) override )
( 0c == C<* )
LIT< (boot<) (find) DROP 0x0c RAM+ !
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ !
LIT< INIT (find)
IF EXECUTE ELSE DROP INTERPRET THEN
;

14
blk/412 Normal file
View File

@ -0,0 +1,14 @@
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: IMMED? 1- C@ 0x80 AND ;
( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by
xcomp. )
: _
['] EXIT ,
R> DROP ( exit : )
; IMMEDIATE

16
blk/413 Normal file
View File

@ -0,0 +1,16 @@
XCURRENT @ ( to PSP )
: :
(entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",".
32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
BEGIN
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!

4
blk/436
View File

@ -8,7 +8,3 @@
DROP
;
( a -- a+1 c )
: C@+ DUP C@ SWAP 1+ SWAP ;
( c a -- a+1 )
: C!+ SWAP OVER C! 1+ ;

3
blk/438
View File

@ -1,3 +0,0 @@
: >= < NOT ;
: <= > NOT ;
: 0>= 0< NOT ;

11
blk/446
View File

@ -1,11 +0,0 @@
( strings being sent to parse routines are always null
terminated )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f )
NOT IF 0 EXIT THEN ( a 0 )
( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
;

14
blk/447
View File

@ -1,14 +0,0 @@
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN
( 'a' is ASCII 97. 59 = 97 - 48 )
49 -
DUP 0< IF EXIT THEN ( bad )
DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
;

15
blk/448
View File

@ -1,15 +0,0 @@
: (parseh) ( a -- n f )
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
DUP @ 30768 = 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 2DROP 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
;

10
blk/449
View File

@ -1,10 +0,0 @@
( returns negative value on error )
: _ ( c -- n )
( '0' is ASCII 48 )
48 -
DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN
( bad )
255 -
;

16
blk/450
View File

@ -1,16 +0,0 @@
: (parseb) ( a -- n f )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
DUP @ 25136 = 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 2DROP 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
;

10
blk/451
View File

@ -1,10 +0,0 @@
: (parse) ( a -- n )
(parsec) IF EXIT THEN
(parseh) IF EXIT THEN
(parseb) IF EXIT THEN
(parsed) IF EXIT THEN
( nothing works )
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
;
' (parse) (parse*) !

BIN
emul/forth.bin
View File

Binary file not shown.