Move icore to blkfs

The way is clear for complete stage1 bootstrapping on the RC2014
target!

blk/001

@@ -4,7 +4,7 @@ MASTER INDEX
  70 Implementation notes      100 Block editor
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 ACIA driver
-370 SD Card driver
+370 SD Card driver            390 Inner core
 
 
 

blk/390

@@ -0,0 +1,16 @@
+Inner core
+
+This unit represents core definitions that happen right after
+native definitions. Before core.fs.
+
+Unlike core.fs and its followers, this unit isn't self-
+sustained. Like native defs it uses the machinery of a full
+Forth interpreter, notably for flow structures.
+
+Because of that, it has to obey specific rules:
+
+1. It cannot compile a word from higher layers. Using
+   immediates is fine though.
+
+
+                                                        (cont.)

blk/391

@@ -0,0 +1,16 @@
+2. If it references a word from this unit or from native
+   definitions, these need to be properly offsetted because
+   their offset at compile time are not the same as their
+   runtime offsets.
+3. Anything they refer to in the boot binary has to be properly
+   stabilized.
+4. Make sure that the words you compile are not overridden by
+   the full interpreter.
+5. When using words as immediates, make sure that they're not
+   defined in icore or, if they are, make sure that they are
+   *not* offsetted
+
+
+
+
+                                                        (cont.)

blk/392

@@ -0,0 +1,7 @@
+Those rules are mostly met by the "xcomp" unit, which is
+expected to have been loaded prior to icore and redefines ":"
+and other defining words. So, in other words, when compiling
+icore, ":" doesn't means what you think it means, go look in
+B260.
+
+To load, run "393 LOAD".

blk/393

@@ -0,0 +1,15 @@
+: RAM+ [ RAMSTART LITN ] + ;
+: FLAGS 0x08 RAM+ ;
+: (parse*) 0x0a RAM+ ;
+: HERE 0x04 RAM+ ;
+: CURRENT* 0x51 RAM+ ;
+: CURRENT CURRENT* @ ;
+
+( w -- a f )
+: (find) CURRENT @ SWAP _find ;
+
+: QUIT
+    0 FLAGS ! (resRS)
+    LIT< INTERPRET (find) DROP EXECUTE
+;
+394 407 LOADR

blk/394

@@ -0,0 +1,8 @@
+: ABORT (resSP) QUIT ;
+
+: = CMP NOT ;
+: < CMP -1 = ;
+: > CMP 1 = ;
+: 0< 32767 > ;
+
+

blk/395

@@ -0,0 +1,15 @@
+( r c -- r f )
+( Parse digit c and accumulate into result r.
+  Flag f is 0 when c was a valid digit, 1 when c was WS,
+  -1 when c was an invalid digit. )
+: _pdacc
+    DUP 0x21 < IF DROP 1 EXIT THEN
+    ( parse char )
+    '0' -
+    ( if bad, return "r -1" )
+    DUP 0< IF DROP -1 EXIT THEN    ( bad )
+    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
+    ( good, add to running result )
+    SWAP 10 * +                    ( r*10+n )
+    0                              ( good )
+;

blk/396

@@ -0,0 +1,11 @@
+( parsed is tight, all comments ahead. We read the first char
+  outside of the loop because it *has* to be nonzero, which
+  means _pdacc *has* to return 0.
+
+  Then, we check for '-'. If we get it, we advance by one,
+  recurse and invert result.
+
+  We loop until _pdacc is nonzero, which means either WS or
+  non-digit. 1 means WS, which means parsing was a success.
+  -1 means non-digit, which means we have a non-decimal. )
+

blk/397

@@ -0,0 +1,16 @@
+: (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 0 )
+        DROP 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 ) ;

blk/398

@@ -0,0 +1,11 @@
+( This is only the "early parser" in earlier stages. No need
+  for an abort message )
+: (parse) (parsed) NOT IF ABORT THEN ;
+
+: C< 0x0c RAM+ @ EXECUTE ( 0c == CINPTR ) ;
+
+: , HERE @ ! HERE @ 2+ HERE ! ;
+
+: C, HERE @ C! HERE @ 1+ HERE ! ;
+
+

blk/399

@@ -0,0 +1,12 @@
+( 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
+;
+
+

blk/400

@@ -0,0 +1,16 @@
+( 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+ ;

blk/401

@@ -0,0 +1,10 @@
+: SCPY
+    BEGIN         ( a )
+        DUP C@    ( a c )
+        DUP C,    ( a c )
+        NOT IF DROP EXIT THEN
+        1+        ( a+1 )
+    AGAIN
+;
+
+

blk/402

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

blk/403

@@ -0,0 +1,14 @@
+: INTERPRET
+    BEGIN
+    WORD
+    (find)
+    IF
+        1 FLAGS !
+        EXECUTE
+        0 FLAGS !
+    ELSE
+        (parse*) @ EXECUTE
+    THEN
+    AGAIN
+;
+

blk/404

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

blk/405

@@ -0,0 +1,12 @@
+: BOOT
+    0x02 RAM+ CURRENT* !
+    LIT< (parse) (find) DROP (parse*) !
+    ( 2e == SYSTEM SCRATCHPAD )
+    CURRENT @ 0x2e RAM+ !
+    ( 0c == CINPTR )
+    LIT< (boot<) (find) DROP 0x0c RAM+ !
+    LIT< INIT (find)
+    IF EXECUTE
+    ELSE DROP INTERPRET THEN
+;
+

blk/406

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

blk/407

@@ -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*) @ EXECUTE LITN THEN
+    AGAIN ;
+( from PSP ) ';' SWAP 4 - C!

emul/Makefile

@@ -1,10 +1,5 @@
-TARGETS = forth/forth
+TARGETS = forth/forth forth/stage2
 # Those Forth source files are in a particular order
-BOOTSRCS = ./forth/conf.fs \
-	./forth/xcomp.fs \
-	../forth/icore.fs \
-	./forth/stop.fs
-
 FORTHSRCS = core.fs cmp.fs print.fs parse.fs readln.fs fmt.fs blk.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
 OBJS = emul.o libz80/libz80.o
@@ -76,7 +71,7 @@ emul.o: emul.c
 
 .PHONY: updatebootstrap
 updatebootstrap: forth/stage2
-	cat $(BOOTSRCS) | ./forth/stage2 > ./forth/z80c.bin
+	cat ./forth/xcomp.fs | ./forth/stage2 > ./forth/z80c.bin
 
 .PHONY: pack
 pack:

emul/forth/conf.fs

@@ -1,3 +0,0 @@
-212 LOAD  ( z80 assembler )
-0xe800 CONSTANT RAMSTART
-0xf000 CONSTANT RS_ADDR

emul/forth/xcomp.fs

@@ -1,3 +1,6 @@
+0xe800 CONSTANT RAMSTART
+0xf000 CONSTANT RS_ADDR
+212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
 : IMMEDIATE XIMM ;
@@ -9,3 +12,6 @@ CURRENT @ XCURRENT !
 H@ 256 /MOD 2 PC! 2 PC!
 H@ XOFF !
 282 LOAD  ( boot.z80 )
+393 LOAD  ( icore )
+(entry) _
+H@ 256 /MOD 2 PC! 2 PC!

forth/icore.fs

@@ -1,252 +0,0 @@
-( Inner core. This unit represents core definitions that
-  happen right after native definitions. Before core.fs.
-
-  Unlike core.fs and its followers, this unit isn't self-
-  sustained. Like native defs it uses the machinery of a
-  full Forth interpreter, notably for flow structures.
-
-  Because of that, it has to obey specific rules:
-
-  1. It cannot compile a word from higher layers. Using
-     immediates is fine though.
-  2. If it references a word from this unit or from native
-     definitions, these need to be properly offsetted
-     because their offset at compile time are not the same
-     as their runtime offsets.
-  3. Anything they refer to in the boot binary has to be
-     properly stabilized.
-  4. Make sure that the words you compile are not overridden
-     by the full interpreter.
-  5. When using words as immediates, make sure that they're
-     not defined in icore or, if they are, make sure that
-     they are *not* offsetted
-
-  Those rules are mostly met by the "xcomp" unit, which is
-  expected to have been loaded prior to icore and redefines
-  ":" and other defining words. So, in other words, when
-  compiling icore, ":" doesn't means what you think it means,
-  go look in B260.
-)
-
-: RAM+
-    [ RAMSTART LITN ] +
-;
-
-: FLAGS 0x08 RAM+ ;
-: (parse*) 0x0a RAM+ ;
-: HERE 0x04 RAM+ ;
-: CURRENT* 0x51 RAM+ ;
-: CURRENT CURRENT* @ ;
-
-( w -- a f )
-: (find) CURRENT @ SWAP _find ;
-
-: QUIT
-    0 FLAGS ! (resRS)
-    LIT< INTERPRET (find) DROP EXECUTE
-;
-
-: ABORT (resSP) QUIT ;
-
-: = CMP NOT ;
-: < CMP -1 = ;
-: > CMP 1 = ;
-: 0< 32767 > ;
-
-( r c -- r f )
-( Parse digit c and accumulate into result r.
-  Flag f is 0 when c was a valid digit, 1 when c was WS,
-  -1 when c was an invalid digit. )
-: _pdacc
-    DUP 0x21 < IF DROP 1 EXIT THEN
-    ( parse char )
-    '0' -
-    ( if bad, return "r -1" )
-    DUP 0< IF DROP -1 EXIT THEN    ( bad )
-    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
-    ( good, add to running result )
-    SWAP 10 * +                    ( r*10+n )
-    0                              ( good )
-;
-
-: (parsed)      ( a -- n f )
-    ( read first char outside of the loop. it *has* to be
-      nonzero. )
-    DUP C@                        ( a c )
-    ( special case: do we have a negative? )
-    DUP '-' = IF
-        ( Oh, a negative, let's recurse and reverse )
-        DROP 1+                   ( a+1 )
-        (parsed)                  ( n f )
-        0 ROT                     ( f 0 n )
-        - SWAP EXIT               ( 0-n f )
-    THEN
-    ( running result from first char )
-    0 SWAP                               ( a r c )
-    _pdacc                               ( a r f )
-    DUP IF
-        ( first char was not a valid digit )
-        2DROP 0 EXIT                     ( a 0 )
-    THEN
-    BEGIN                         ( a r 0 )
-        DROP SWAP 1+              ( r a+1 )
-        DUP C@                    ( r a c )
-        ROT SWAP                  ( a r c )
-        _pdacc                    ( a r f )
-    DUP UNTIL
-    ( a r f -- f is 1 on success, -1 on error, normalize
-      to bool. )
-    1 =         ( a r f )
-    ( we want "r f" )
-    ROT DROP
-;
-
-( This is only the "early parser" in earlier stages. No need
-  for an abort message )
-: (parse)
-    (parsed) NOT IF ABORT THEN
-;
-
-: C<
-    ( 0c == CINPTR )
-    0x0c RAM+ @ EXECUTE
-;
-
-: ,
-    HERE @ !
-    HERE @ 2+ HERE !
-;
-
-: C,
-    HERE @ C!
-    HERE @ 1+ HERE !
-;
-
-( 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
-;
-
-( Read word from C<, copy to WORDBUF, null-terminate, and
-  return, make HL point to WORDBUF. )
-: WORD
-    ( 0e == WORDBUF )
-    0x0e RAM+        ( a )
-    TOWORD                   ( a c )
-    BEGIN
-        ( We take advantage of the fact that char MSB is
-          always zero to pre-write our null-termination )
-        OVER !               ( a )
-        1+                   ( a+1 )
-        C<                   ( a c )
-        DUP WS?
-    UNTIL
-    ( a this point, PS is: a WS )
-    ( null-termination is already written )
-    2DROP
-    0x0e RAM+
-;
-
-: SCPY
-    BEGIN               ( a )
-        DUP C@    ( a c )
-        DUP C,    ( a c )
-        NOT IF DROP EXIT THEN
-        1+        ( a+1 )
-    AGAIN
-;
-
-: [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] ;
-
-: INTERPRET
-    BEGIN
-    WORD
-    (find)
-    IF
-        1 FLAGS !
-        EXECUTE
-        0 FLAGS !
-    ELSE
-        (parse*) @ EXECUTE
-    THEN
-    AGAIN
-;
-
-( 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 )
-;
-
-: BOOT
-    0x02 RAM+ CURRENT* !
-    LIT< (parse) (find) DROP (parse*) !
-    ( 2e == SYSTEM SCRATCHPAD )
-    CURRENT @ 0x2e RAM+ !
-    ( 0c == CINPTR )
-    LIT< (boot<) (find) DROP 0x0c RAM+ !
-    LIT< INIT (find)
-    IF EXECUTE
-    ELSE DROP INTERPRET THEN
-;
-
-( LITN has to be defined after the last immediate usage of
-  it to avoid bootstrapping issues )
-: LITN
-    ( 32 == NUMBER )
-    32 , ,
-;
-
-: 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
-
-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!

recipes/rc2014/Makefile

@@ -4,11 +4,6 @@ FDIR = $(BASEDIR)/forth
 EDIR = $(BASEDIR)/emul/forth
 STAGE2 = $(EDIR)/stage2
 EMUL = $(BASEDIR)/emul/hw/rc2014/classic
-BOOTSRCS = conf.fs \
-	$(EDIR)/xcomp.fs \
-	drvz80.fs \
-	$(FDIR)/icore.fs \
-	$(EDIR)/stop.fs
 
 PATHS = \
 	$(FDIR)/core.fs \
@@ -29,8 +24,8 @@ $(TARGET): z80c.bin $(SLATEST) $(PATHS)
 	$(SLATEST) $@
 	cat $(PATHS) | $(STRIPFC) >> $@
 
-z80c.bin: conf.fs
+z80c.bin: xcomp.fs
-	cat $(BOOTSRCS) | $(STAGE2) > $@
+	cat xcomp.fs | $(STAGE2) > $@
 
 $(SLATEST):
 	$(MAKE) -C $(BASEDIR)/tools

recipes/rc2014/conf.fs

@@ -1,10 +0,0 @@
-212 LOAD        ( z80a )
-0x8000 CONSTANT RAMSTART
-0xf000 CONSTANT RS_ADDR
-0x80   CONSTANT ACIA_CTL
-0x81   CONSTANT ACIA_IO
-4      CONSTANT SDC_SPI
-5      CONSTANT SDC_CSLOW
-6      CONSTANT SDC_CSHIGH
-RAMSTART 0x70 + CONSTANT ACIA_MEM
-

recipes/rc2014/drvz80.fs

@@ -1,2 +0,0 @@
-352 LOAD    ( acia.z80 )
-372 LOAD    ( sdc.z80 )

recipes/rc2014/xcomp.fs

@@ -0,0 +1,25 @@
+0x8000 CONSTANT RAMSTART
+0xf000 CONSTANT RS_ADDR
+0x80   CONSTANT ACIA_CTL
+0x81   CONSTANT ACIA_IO
+4      CONSTANT SDC_SPI
+5      CONSTANT SDC_CSLOW
+6      CONSTANT SDC_CSHIGH
+RAMSTART 0x70 + CONSTANT ACIA_MEM
+212 LOAD  ( z80 assembler )
+262 LOAD  ( xcomp )
+: CODE XCODE ;
+: IMMEDIATE XIMM ;
+: (entry) (xentry) ;
+: : [ ' X: , ] ;
+
+CURRENT @ XCURRENT !
+
+H@ 256 /MOD 2 PC! 2 PC!
+H@ XOFF !
+282 LOAD  ( boot.z80 )
+352 LOAD  ( acia.z80 )
+372 LOAD  ( sdc.z80 )
+393 LOAD  ( icore )
+(entry) _
+H@ 256 /MOD 2 PC! 2 PC!