blk/001

@@ -5,7 +5,7 @@ MASTER INDEX
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 ACIA driver
 370 SD Card driver            390 Inner core
-420 Core words
+
 
 
 

blk/269

@@ -1,3 +0,0 @@
-( b1 b2 -- )
-: XPACKR 1+ SWAP DO I DUP . CRLF XPACK LOOP ;
-

blk/420

@@ -1,14 +0,0 @@
-Core words
-
-These words follow Inner core words, but unlike them, these are
-self-bootstrapping and don't depend on the Cross Compiler. They
-will typically be included in source form right after a stage1
-binary which will interpret it on boot and bootstrap itself to
-a full intepreter, which can then be relinked with the
-Relinker. There is no loader for these libraries because you
-will typically XPACK (B267) them.
-
-422 core                       438 cmp
-442 print                      446 parse
-453 readln                     459 fmt
-464 blk

blk/422

@@ -1,16 +0,0 @@
-: H@ HERE @ ;
-: IMMEDIATE
-    CURRENT @ 1-
-    DUP C@ 128 OR SWAP C!
-;
-: [ INTERPRET ; IMMEDIATE
-: ] R> DROP ;
-: LITS 34 , SCPY ;
-: LIT< WORD LITS ; IMMEDIATE
-: LITA 36 , , ;
-: '
-    WORD (find) (?br) [ 4 , ] EXIT
-    LIT< (wnf) (find) DROP EXECUTE
-;
-: ['] ' LITA ; IMMEDIATE
-

blk/423

@@ -1,5 +0,0 @@
-: COMPILE ' LITA ['] , , ; IMMEDIATE
-: [COMPILE] ' , ; IMMEDIATE
-: BEGIN H@ ; IMMEDIATE
-: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
-: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

blk/424

@@ -1,13 +0,0 @@
-: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
-40 CURRENT @ 4 - C!
-( Hello, hello, krkrkrkr... do you hear me?
-  Ah, voice at last! Some lines above need comments
-  BTW: Forth lines limited to 64 cols because of default
-  input buffer size in Collapse OS
-
-  40 is ASCII for '('. We do this to simplify XPACK's task of
-  not mistakenly consider '(' definition as a comment.
-  LITS: 34 == litWord
-  LITA: 36 == addrWord
-  COMPILE: Tough one. Get addr of caller word (example above
-  (br)) and then call LITA on it. )

blk/425

@@ -1,15 +0,0 @@
-: +! SWAP OVER @ + SWAP ! ;
-: -^ SWAP - ;
-: ALLOT HERE +! ;
-
-: IF                ( -- a | a: br cell addr )
-    COMPILE (?br)
-    H@              ( push a )
-    2 ALLOT         ( br cell allot )
-; IMMEDIATE
-
-: THEN              ( a -- | a: br cell addr )
-    DUP H@ -^ SWAP   ( a-H a )
-    !
-; IMMEDIATE
-

blk/426

@@ -1,8 +0,0 @@
-: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
-    COMPILE (br)
-    2 ALLOT
-    DUP H@ -^ SWAP  ( a-H a )
-    !
-    H@ 2-          ( push a. -2 for allot offset )
-; IMMEDIATE
-

blk/427

@@ -1,10 +0,0 @@
-( During a CASE, the stack grows by 1 at each ENDOF so that
-  we can fill all those ENDOF branching addrs. So that we
-  know when to stop, we put a 0 on PSP. That's our stopgap. )
-: CASE 0 COMPILE >R ; IMMEDIATE
-: OF
-    COMPILE I COMPILE =
-    [COMPILE] IF
-; IMMEDIATE
-: ENDOF [COMPILE] ELSE ; IMMEDIATE
-

blk/428

@@ -1,13 +0,0 @@
-( At this point, we have something like "0 e1 e2 e3 val". We
-  want top drop val, and then call THEN as long as we don't
-  hit 0. )
-: ENDCASE
-    BEGIN
-        DUP NOT IF
-            DROP COMPILE R> COMPILE DROP EXIT
-        THEN
-        [COMPILE] THEN
-    AGAIN
-; IMMEDIATE
-
-

blk/429

@@ -1,7 +0,0 @@
-: CREATE
-    (entry)            ( empty header with name )
-    11                 ( 11 == cellWord )
-    C,                 ( write it )
-;
-
-

blk/430

@@ -1,14 +0,0 @@
-: DOES>
-    ( Overwrite cellWord in CURRENT )
-    ( 43 == doesWord )
-    43 CURRENT @ C!
-    ( When we have a DOES>, we forcefully place HERE to 4
-      bytes after CURRENT. This allows a DOES word to use ","
-      and "C," without messing everything up. )
-    CURRENT @ 3 + HERE !
-    ( HERE points to where we should write R> )
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
-;
-

blk/431

@@ -1,13 +0,0 @@
-: VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE , DOES> @ ;
-: / /MOD SWAP DROP ;
-: MOD /MOD DROP ;
-
-( In addition to pushing H@ this compiles 2 >R so that loop
-  variables are sent to PS at runtime )
-: DO
-    COMPILE SWAP COMPILE >R COMPILE >R
-    H@
-; IMMEDIATE
-
-

blk/432

@@ -1,16 +0,0 @@
-( Increase loop counter and returns whether we should loop. )
-: _
-    R>          ( IP, keep for later )
-    R> 1+       ( ip i+1 )
-    DUP >R      ( ip i )
-    I' =        ( ip f )
-    SWAP >R     ( f )
-;
-( One could think that we should have a sub word to avoid all
-  these COMPILE, but we can't because otherwise it messes with
-  the RS )
-: LOOP
-    COMPILE _ COMPILE (?br)
-    H@ - ,
-    COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
-; IMMEDIATE

blk/433

@@ -1,14 +0,0 @@
-: LEAVE R> R> DROP I 1- >R >R ;
-
-: ROLL
-    DUP NOT IF EXIT THEN
-    1+ DUP PICK          ( n val )
-    SWAP 2 * (roll)      ( val )
-    SWAP DROP
-;
-
-: 2DUP OVER OVER ;
-: 2OVER 3 PICK 3 PICK ;
-: 2SWAP 3 ROLL 3 ROLL ;
-
-

blk/434

@@ -1,16 +0,0 @@
-( a1 a2 u -- )
-: MOVE
-    ( u ) 0 DO
-        SWAP DUP I + C@   ( a2 a1 x )
-        ROT SWAP OVER I + ( a1 a2 x a2 )
-        C!                ( a1 a2 )
-    LOOP
-    2DROP
-;
-
-: DELW 1- 0 SWAP C! ;
-
-: PREV
-    3 - DUP @                   ( a o )
-    -                           ( a-o )
-;

blk/435

@@ -1,16 +0,0 @@
-: WORD(
-    DUP 1- C@   ( name len field )
-    127 AND     ( 0x7f. remove IMMEDIATE flag )
-    3 +         ( fixed header len )
-    -
-;
-: FORGET
-    ' DUP               ( w w )
-    ( HERE must be at the end of prev's word, that is, at the
-      beginning of w. )
-    WORD( HERE !  ( w )
-    PREV CURRENT !
-;
-: EMPTY
-    LIT< _sys (find) NOT IF ABORT THEN
-    DUP HERE ! CURRENT ! ;

blk/436

@@ -1,12 +0,0 @@
-( Drop RSP until I-2 == INTERPRET. )
-: EXIT!
-    ['] INTERPRET       ( I )
-    BEGIN               ( I )
-    DUP                 ( I I )
-    R> DROP I 2- @     ( I I a )
-    = UNTIL
-    DROP
-;
-
-( a -- a+1 c )
-: C@+ DUP C@ SWAP 1+ SWAP ;

blk/438

@@ -1,13 +0,0 @@
-( Words useful for complex comparison operations )
-
-: >= < NOT ;
-: <= > NOT ;
-: 0>= 0< NOT ;
-
-( n1 -- n1 true )
-: <>{ 1 ;
-
-( n1 f -- f )
-: <>} SWAP DROP ;
-
-

blk/439

@@ -1,15 +0,0 @@
-
-: _|&
-    ( n1 n2 cell )
-    >R >R DUP R> R>          ( n1 n1 n2 cell )
-    @ EXECUTE                ( n1 f )
-;
-
-( n1 f n2 -- n1 f )
-: _|
-    CREATE , DOES>
-    ( n1 f n2 cell )
-    ROT IF 2DROP 1 EXIT THEN ( n1 true )
-    _|&
-;
-

blk/440

@@ -1,15 +0,0 @@
-: _&
-    CREATE , DOES>
-    ( n1 f n2 cell )
-    ROT NOT IF 2DROP 0 EXIT THEN ( n1 true )
-    _|&
-;
-
-( All words below have this signature:
-  n1 f n2 -- n1 f )
-' = _| |=
-' = _& &=
-' > _| |>
-' > _& &>
-' < _| |<
-' < _& &<

blk/442

@@ -1,11 +0,0 @@
-( EMIT is needed for this unit to compile )
-
-: (print)
-    BEGIN
-    C@+      ( a+1 c )
-    ( exit if null )
-    DUP NOT IF 2DROP EXIT THEN
-    EMIT     ( a )
-    AGAIN
-;
-

blk/443

@@ -1,15 +0,0 @@
-: ."
-    34 ,        ( 34 == litWord )
-    BEGIN
-        C<
-        ( 34 is ASCII for " )
-        DUP 34 = IF DROP 0 THEN
-        DUP C,
-    NOT UNTIL
-    COMPILE (print)
-; IMMEDIATE
-
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-
-: (uflw) ABORT" stack underflow" ;
-

blk/444

@@ -1,9 +0,0 @@
-: BS 8 EMIT ;
-: LF 10 EMIT ;
-: CR 13 EMIT ;
-: CRLF CR LF ;
-: SPC 32 EMIT ;
-
-: (wnf) (print) SPC ABORT" word not found" ;
-: (ok) SPC ." ok" CRLF ;
-

blk/446

@@ -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 = NOT IF 0 EXIT THEN      ( a 0 )
-    DUP 2+ C@ 39 = NOT IF 0 EXIT THEN   ( a 0 )
-    ( surrounded by apos, good, return )
-    1+ C@ 1                             ( n 1 )
-;
-

blk/447

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

blk/448

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

blk/449

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

blk/450

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

blk/451

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

blk/453

@@ -1,13 +0,0 @@
-64 CONSTANT INBUFSZ
-: RDLNMEM+ 0x53 RAM+ @ + ;
-( current position in INBUF )
-: IN> 0 RDLNMEM+ ;
-( points to INBUF )
-: IN( 2 RDLNMEM+ ;
-( points to INBUF's end )
-: IN) INBUFSZ 2+ RDLNMEM+ ;
-
-( flush input buffer )
-( set IN> to IN( and set IN> @ to null )
-: (infl) 0 IN( DUP IN> ! ! ;
-

blk/454

@@ -1,16 +0,0 @@
-( handle backspace: go back one char in IN>, if possible, then
-  emit SPC + BS )
-: (inbs)
-    ( already at IN( ? )
-    IN> @ IN( = IF EXIT THEN
-    IN> @ 1- IN> !
-    SPC BS
-;
-
-
-
-
-
-
-( cont.: read one char into input buffer and returns whether we
-  should continue, that is, whether CR was not met. )

blk/455

@@ -1,16 +0,0 @@
-: (rdlnc)                   ( -- f )
-    ( buffer overflow? same as if we typed a newline )
-    IN> @ IN) = IF 0x0a ELSE KEY THEN     ( c )
-    DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
-    DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
-    ( echo back )
-    DUP EMIT                    ( c )
-    ( bacspace? handle and exit )
-    DUP 0x8 = IF (inbs) EXIT THEN
-    ( write and advance )
-    DUP     ( keep as result )  ( c c )
-( We take advantage of the fact that c's MSB is always zero and
-  thus ! automatically null-terminates our string )
-    IN> @ ! 1 IN> +!            ( c )
-    ( if newline, replace with zero to indicate EOL )
-    DUP 0xd = IF DROP 0 THEN ;

blk/456

@@ -1,16 +0,0 @@
-( Read one line in input buffer and make IN> point to it )
-: (rdln)
-    (infl) BEGIN (rdlnc) NOT UNTIL
-    LF IN( IN> ! ;
-
-( And finally, implement C<* )
-: RDLN<
-    IN> @ C@
-    DUP IF ( not EOL? good, inc and return )
-        1 IN> +!
-    ELSE ( EOL ? readline. we still return null though )
-        (rdln)
-    THEN
-    ( update C<? flag )
-    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
-;

blk/457

@@ -1,12 +0,0 @@
-( Initializes the readln subsystem )
-: RDLN$
-    ( 53 == rdln's memory )
-    H@ 0x53 RAM+ !
-    ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
-      the last typed 0x0a and one for the following NULL. )
-    INBUFSZ 4 + ALLOT
-    (infl)
-    ['] RDLN< 0x0c RAM+ !
-    1 0x06 RAM+ !  ( 06 == C<? )
-;
-

blk/459

@@ -1,16 +0,0 @@
-: _
-    999 SWAP        ( stop indicator )
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-    BEGIN
-        DUP 0 = IF DROP EXIT THEN
-        10 /MOD         ( r q )
-        SWAP '0' + SWAP ( d q )
-    AGAIN ;
-: . ( n -- )
-    ( handle negative )
-    DUP 0< IF '-' EMIT -1 * THEN
-    _
-    BEGIN
-        DUP '9' > IF DROP EXIT THEN  ( stop indicator )
-        EMIT
-    AGAIN ;

blk/460

@@ -1,16 +0,0 @@
-: ? @ . ;
-: _
-    DUP 9 > IF 10 - 'a' +
-    ELSE '0' + THEN
-;
-( For hex display, there are no negatives )
-: .x
-    256 MOD     ( ensure < 0x100 )
-    16 /MOD     ( l h )
-    _ EMIT      ( l )
-    _ EMIT
-;
-: .X
-    256 /MOD    ( l h )
-    .x .x
-;

blk/461

@@ -1,16 +0,0 @@
-: _ ( a -- a+8 )
-    DUP         ( save for 2nd loop )
-    ':' EMIT DUP .x SPC
-    4 0 DO
-        DUP @ 256 /MOD SWAP
-        .x .x SPC 2+
-    LOOP
-    DROP
-    8 0 DO
-        C@+
-        DUP <>{ 0x20 &< 0x7e |> <>}
-        IF DROP '.' THEN
-        EMIT
-    LOOP
-    CRLF
-;

blk/462

@@ -1,9 +0,0 @@
-: DUMP ( n a -- )
-    LF
-    BEGIN
-        OVER 1 < IF 2DROP EXIT THEN
-        _
-        SWAP 8 - SWAP
-    AGAIN
-;
-

blk/464

@@ -1,12 +0,0 @@
-: BLKMEM+ 0x57 RAM+ @ + ;
-( n -- Fetches block n and write it to BLK( )
-: BLK@* 0 BLKMEM+ ;
-( n -- Write back BLK( to storage at block n )
-: BLK!* 2 BLKMEM+ ;
-( Current blk pointer in ( )
-: BLK> 4 BLKMEM+ ;
-( Whether buffer is dirty )
-: BLKDTY 6 BLKMEM+ ;
-: BLK( 8 BLKMEM+ ;
-
-

blk/465

@@ -1,12 +0,0 @@
-: BLK$
-    H@ 0x57 RAM+ !
-    ( 1024 for the block, 8 for variables )
-    1032 ALLOT
-    ( LOAD detects end of block with ASCII EOT. This is why
-      we write it there. EOT == 0x04 )
-    4 C,
-    0 BLKDTY !
-    -1 BLK> !
-;
-
-

blk/466

@@ -1,13 +0,0 @@
-: BLK! ( -- )
-    BLK> @ BLK!* @ EXECUTE
-    0 BLKDTY !
-;
-
-: BLK@ ( n -- )
-    DUP BLK> @ = IF DROP EXIT THEN
-    BLKDTY @ IF BLK! THEN
-    DUP BLK> ! BLK@* @ EXECUTE
-;
-
-: BLK!! 1 BLKDTY ! ;
-

blk/467

@@ -1,11 +0,0 @@
-: .2 DUP 10 < IF SPC THEN . ;
-
-: LIST
-    BLK@
-    16 0 DO
-        I 1+ .2 SPC
-        64 I * BLK( + (print)
-        CRLF
-    LOOP
-;
-

blk/468

@@ -1,16 +0,0 @@
-: _
-    (boot<)
-    DUP 4 = IF
-        ( We drop our char, but also "a" from WORD: it won't
-          have the opportunity to balance PSP because we're
-          EXIT!ing. )
-        2DROP
-        ( We're finished interpreting )
-        EXIT!
-    THEN
-;
-
-( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
-  is to check whether we're restoring to "_", the word above.
-  if yes, then we're in a nested load. Also, the 1 in 0x06 is
-  to avoid tons of "ok" displays. )

blk/469

@@ -1,16 +0,0 @@
-: LOAD
-    BLK> @ >R ( save restorable variables to RSP )
-    0x08 RAM+ @ >R
-    0x06 RAM+ @ >R  ( C<? )
-    0x2e RAM+ @ >R  ( boot ptr )
-    BLK@
-    BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
-    ['] _ 0x08 RAM+ ! ( 08 == C<* override )
-    1 0x06 RAM+ !  ( 06 == C<? )
-    INTERPRET
-    R> 0x2e RAM+ ! R> 0x06 RAM+ !
-    I 0x08 RAM+ @ = IF ( nested load )
-        R> DROP ( C<* ) R> BLK@
-    ELSE ( not nested )
-        R> 0x08 RAM+ ! R> DROP ( BLK> )
-    THEN ;

blk/470

@@ -1,2 +0,0 @@
-( b1 b2 -- )
-: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

emul/Makefile

@@ -23,9 +23,10 @@ $(BLKUNPACK): $(BLKPACK)
 
 # z80c.bin is not in the prerequisites because it's a bootstrap
 # binary that should be updated manually through make updatebootstrap.
-forth0.bin:
+forth0.bin: $(SLATEST)
 	cp z80c.bin $@
-	cat stage1.fs >> $@
+	$(SLATEST) $@
+	cat pre.fs emul.fs >> $@
 
 forth0-bin.h: forth0.bin $(BIN2C)
 	$(BIN2C) KERNEL < forth0.bin | tee $@ > /dev/null

emul/emul.fs

@@ -1,4 +1,3 @@
-CURRENT @ HERE !
 HERE @ 256 /MOD 2 PC! 2 PC!
 : EMIT 0 PC! ;
 : KEY 0 PC@ ;

emul/pre.fs

@@ -0,0 +1,2 @@
+CURRENT @ HERE !
+

emul/xcomp.fs

@@ -14,6 +14,4 @@ H@ XOFF !
 282 LOAD  ( boot.z80 )
 393 LOAD  ( icore )
 (entry) _
-( Update LATEST )
-H@ XOFF @ - XOFF @ 8 + !
 H@ 256 /MOD 2 PC! 2 PC!