First function application: Block explorer!

Saves quite a few bytes in the final binary.

blk/000

@@ -3,7 +3,8 @@ Collapse OS file system
 This is a Forth-style filesystems which is very simple. It is a
 list of 1024 bytes block, organised in 16 lines of 64 columns
 each. You refer to blocks by numbers. You show them with LIST.
-You interpret them with LOAD.
+You interpret them with LOAD. For a convenient way to browse
+blocks, see Block Explorer at B100.
 
 Conventions: When you see "(cont.)" at the bottom right of a
 block, it means that the next block continues the same kind of

blk/054

@@ -10,3 +10,5 @@ MOD         a b -- c        a % b -> c
 AND         a b -- c        a & b -> c
 OR          a b -- c        a | b -> c
 XOR         a b -- c        a ^ b -> c
+
+Shortcuts: 1+ 2+ 1- 2-

blk/077

@@ -6,7 +6,7 @@ A dictionary entry has this structure:
   bigger than input buffer, of course). not null-terminated
 - 2b prev offset
 - 1b size + IMMEDIATE flag
-- 2b code pointer
+- 1b code pointer (always jumps in the <0x100 range)
 - Parameter field (PF)
 
 The prev offset is the number of bytes between the prev field

blk/078

@@ -1,7 +1,9 @@
 (cont.) The code pointer point to "word routines". These
 routines expect to be called with IY pointing to the PF. They
 themselves are expected to end by jumping to the address at
-(IP). They will usually do so with "jp next".
+(IP). They will usually do so with "jp next". They are 1b
+because all those routines live in the first 0x100 bytes of
+the boot binary. The 0 MSB is assumed.
 
 That's for "regular" words (words that are part of the dict
 chain). There are also "special words", for example NUMBER,

blk/081

@@ -2,7 +2,7 @@
 RAMSTART  INITIAL_SP    +53       readln's variables
 +02       CURRENT       +55       adev's variables
 +04       HERE          +57       blk's variables
-+06       IP            +59       z80a's variables
++06       FUTURE USES   +59       z80a's variables
 +08       FLAGS         +5b       FUTURE USES
 +0a       PARSEPTR      +70       DRIVERS
 +0c       CINPTR        +80       RAMEND

blk/100

@@ -7,4 +7,4 @@ USAGE: When loaded, the Forth interpreter is replaced by the
 explorer interpreter. Typing "Q" quits the program.
 
 Typing a decimal number followed by space or return lists the
-contents of that block.
+contents of that block. B for previous block, N for next.

blk/102

@@ -1,2 +1,14 @@
-: foo ." Hello world! " 42 . ;
-foo
+103 LOAD
+VARIABLE _K
+
+: PGM
+    100 _LIST
+    BEGIN
+        KEY
+        DUP 'Q' = IF DROP EXIT THEN
+        DUP 58 ( '9'+1 ) < IF _NUM
+        ELSE
+            _K ! _K (find) IF EXECUTE THEN
+        THEN
+    AGAIN
+; PGM

blk/103

@@ -1 +1,9 @@
-42 . 102 LOAD 43 .
+VARIABLE ACC
+: _LIST ." Block " DUP . CRLF LIST ;
+: _NUM
+    ACC @ SWAP _pdacc
+    IF _LIST 0 THEN
+    ACC !
+;
+: B BLK> @ 1- DUP BLK> ! _LIST ;
+: N BLK> @ 1+ DUP BLK> ! _LIST ;

forth/boot.fs

@@ -1,6 +1,13 @@
 ( Configuration words: RAMSTART, RS_ADDR )
 H@ 256 /MOD 2 PC! 2 PC!
 
+( RESERVED REGISTERS
+
+  At all times, IX points to RSP TOS and IY is IP. SP points
+  to PSP TOS, but you can still use the stack in native code.
+  you just have to make sure you've restored it before "next".
+)
+
 ( STABLE ABI
   Those jumps below are supposed to stay at these offsets,
   always. If they change bootstrap binaries have to be
@@ -20,7 +27,7 @@ NOP,              ( 0a, unused )
 0 JPnn,           ( 0e, compiledWord )
 0 JPnn,           ( 11, pushRS )
 0 JPnn,           ( 14, popRS )
-JP(IY), NOP,      ( 17, nativeWord )
+EXDEHL, JP(HL), NOP, ( 17, nativeWord )
 0 JPnn,           ( 1a, next )
 0 JPnn,           ( 1d, chkPS )
 NOP, NOP,         ( 20, numberWord )
@@ -31,77 +38,82 @@ RAMSTART 0x4e + JPnn, ( 28, RST 28 )
 0 JPnn,           ( 2b, doesWord )
 NOP, NOP,         ( 2e, unused )
 RAMSTART 0x4e + JPnn, ( RST 30 )
-NOP, NOP, NOP,    ( unused )
+0 JPnn,           ( 33, execute )
 NOP, NOP,         ( unused )
 RAMSTART 0x4e + JPnn, ( RST 38 )
-NOP,              ( unused )
 
 ( BOOT DICT
-  There are only 5 words in the boot dict, but these words'
+  There are only 3 words in the boot dict, but these words'
   offset need to be stable, so they're part of the "stable
   ABI"
 )
 'E' A, 'X' A, 'I' A, 'T' A,
 0 A,,   ( prev )
 4 A,
-L1 BSET ( EXIT )
-    0x17 A,,         ( nativeWord )
+H@ XCURRENT !        ( set current tip of dict, 0x42 )
+    0x17 A,         ( nativeWord )
     0x14 CALLnn,    ( popRS )
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
+    HL PUSHqq, IY POPqq, ( --> IP )
     JPNEXT,
 
-NOP, NOP, NOP,   ( unused )
-
-'(' A, 'b' A, 'r' A, ')' A,
-PC L1 @ - A,, ( prev )
-4 A,
-L1 BSET ( BR )
-    0x17 A,,         ( nativeWord )
+CODE (br)            ( 0x53 )
 L2 BSET ( used in CBR )
-    RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
-    E (HL) LDrr,
-    HL INCss,
-    D (HL) LDrr,
-    HL DECss,
-    DE ADDHLss,
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
+    E 0 IY+ LDrIXY,
+    D 1 IY+ LDrIXY,
+    DE ADDIYss,
     JPNEXT,
 
-'(' A, '?' A, 'b' A, 'r' A, ')' A,
-PC L1 @ - A,, ( prev )
-5 A,
-L1 BSET ( CBR )
-    0x17 A,,         ( nativeWord )
+CODE (?br)           ( 0x67 )
     HL POPqq,
     chkPS,
     A H LDrr,
     L ORr,
     JRZ, L2 BWR ( BR + 2. False, branch )
     ( True, skip next 2 bytes and don't branch )
-    RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
-    HL INCss,
-    HL INCss,
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
+    IY INCss,
+    IY INCss,
     JPNEXT,
 
-'E' A, 'X' A, 'E' A, 'C' A, 'U' A, 'T' A, 'E' A,
-PC L1 @ - A,, ( prev )
-7 A,
-H@ XCURRENT !        ( set current tip of dict )
-L2 BSET ( used frequently below )
-    0x17 A,,         ( nativeWord )
-    IY POPqq,        ( is a wordref )
-    chkPS,
-    L 0 IY+ LDrIXY,
-    H 1 IY+ LDrIXY,
-    ( HL points to code pointer )
-    IY INCss,
-    IY INCss,
-    ( IY points to PFA )
-    JP(HL),
-
 ( END OF STABLE ABI )
 
+( We want numberWord and litWord routine to be below the 0x100
+  offset so that we can reduce the size of the routine field
+  in words to 1 byte. )
+( addrWord is the exact same thing as a numberWord except that
+  it is treated differently by meta-tools. See notes.txt )
+PC ORG @ 0x20 + ! ( numberWord )
+PC ORG @ 0x24 + ! ( addrWord )
+( This is not a word, but a number literal. This works a bit
+  differently than others: PF means nothing and the actual
+  number is placed next to the numberWord reference in the
+  compiled word list. What we need to do to fetch that number
+  is to play with the IP.
+)
+    E 0 IY+ LDrIXY,
+    D 1 IY+ LDrIXY,
+    IY INCss,
+    IY INCss,
+    DE PUSHqq,
+    JPNEXT,
+
+PC ORG @ 0x22 + ! ( litWord )
+( Similarly to numberWord, this is not a real word, but a
+  string literal. Instead of being followed by a 2 bytes
+  number, it's followed by a null-terminated string. When
+  called, puts the string's address on PS )
+    IY PUSHqq, HL POPqq, ( <-- IP )
+    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,
+
 ( Name of BOOT word )
 L1 BSET
 'B' A, 'O' A, 'O' A, 'T' A, 0 A,
@@ -129,8 +141,7 @@ PC ORG @ 1 + ! ( main )
     EXDEHL,
     HL L1 @ LDddnn,
     0x03 CALLnn,        ( 03 == find )
-    DE PUSHqq,
-    L2 @ 2 + JPnn,
+    0x33 JPnn,          ( 33 == execute )
 
 PC ORG @ 4 + ! ( find )
 ( Find the entry corresponding to word name where (HL) points
@@ -167,7 +178,7 @@ BEGIN, ( inner )
     LDA(DE),
     0x7f ANDn,          ( remove IMMEDIATE flag )
     C CPr,
-    JRNZ, L4 FWR ( loopend )
+    JRNZ, L2 FWR ( loopend )
     ( match, let's compare the string then )
     DE DECss, ( Skip prev field. One less because we )
     DE DECss, ( pre-decrement )
@@ -180,12 +191,12 @@ BEGIN, ( loop )
     (HL) CPr,
     JRNZ, L3 FWR ( loopend )
     DJNZ, AGAIN, ( loop )
-L4 FSET L3 FSET ( loopend )
+L2 FSET L3 FSET ( loopend )
 ( At this point, Z is set if we have a match. In all cases,
   we want to pop HL and DE )
     DE POPqq,           ( <-- lvl 2 )
     HL POPqq,           ( <-- lvl 1 )
-    JRZ, L4 FWR ( end, match? we're done! )
+    JRZ, L2 FWR ( end, match? we're done! )
     ( no match, go to prev and continue )
     HL PUSHqq,          ( --> lvl 1 )
     DE DECss,
@@ -213,7 +224,7 @@ L4 FSET L3 FSET ( loopend )
 L1 FSET ( fail )
     A XORr,
     A INCr,
-L4 FSET ( end )
+L2 FSET ( end )
     HL POPqq,
     BC POPqq,
     RET,
@@ -237,8 +248,7 @@ L1 BSET ( abortUnderflow )
     HL PC 7 - LDddnn,
     DE RAMSTART 0x02 + LDdd(nn),   ( RAM+02 == CURRENT )
     0x03 CALLnn, ( find )
-    DE PUSHqq,
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    0x33 JPnn,          ( 33 == execute )
 
 
 PC ORG @ 0x1e + ! ( chkPS )
@@ -255,7 +265,7 @@ PC ORG @ 0x1e + ! ( chkPS )
     CNC RETcc,      ( INITIAL_SP >= SP? good )
     JR, L1 BWR ( abortUnderflow )
 
-L3 BSET ( chkRS )
+L2 BSET ( chkRS )
     IX PUSHqq, HL POPqq,
     DE RS_ADDR LDddnn,
     DE SUBHLss,
@@ -269,44 +279,45 @@ PC ORG @ 0x1b + ! ( next )
   it by 2 before jumping. )
 	( Before we continue: are stacks within bounds? )
     0x1d CALLnn, ( chkPS )
-    L3 @ CALLnn, ( chkRS )
-    DE RAMSTART 0x06 + LDdd(nn), ( RAMSTART+0x06 == IP )
-    H D LDrr,
-    L E LDrr,
-    DE INCss,
-    DE INCss,
-    RAMSTART 0x06 + DE LD(nn)dd, ( RAMSTART+0x06 == IP )
-	( HL is an atom list pointer. We need to go into it to
-      have a wordref )
-    E (HL) LDrr,
-    HL INCss,
-    D (HL) LDrr,
-    DE PUSHqq,
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    L2 @ CALLnn, ( chkRS )
+    E 0 IY+ LDrIXY,
+    D 1 IY+ LDrIXY,
+    IY INCss,
+    IY INCss,
+    ( continue to execute )
 
-( WORD ROUTINES )
+PC ORG @ 0x34 + ! ( execute )
+    ( DE points to wordref )
+    EXDEHL,
+    E (HL) LDrr,
+    D 0 LDrn,
+    EXDEHL,
+    ( HL points to code pointer )
+    DE INCss,
+    ( DE points to PFA )
+    JP(HL),
 
 PC ORG @ 0x0f + ! ( compiledWord )
 ( Execute a list of atoms, which always end with EXIT.
-  IY points to that list. What do we do:
+  DE points to that list. What do we do:
   1. Push current IP to RS
   2. Set new IP to the second atom of the list
   3. Execute the first atom of the list. )
-    RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
+    IY PUSHqq, HL POPqq, ( <-- IP )
     0x11 CALLnn,     ( 11 == pushRS )
-    IY PUSHqq, HL POPqq,
+    EXDEHL,          ( HL points to PFA )
+    ( While we increase, dereference into DE for execute call
+      later. )
+    E (HL) LDrr,
     HL INCss,
+    D (HL) LDrr,
     HL INCss,
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
-	( IY still is our atom reference )
-    L 0 IY+ LDrIXY,
-    H 1 IY+ LDrIXY,
-    HL PUSHqq,      ( arg for EXECUTE )
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    HL PUSHqq, IY POPqq, ( --> IP )
+    0x33 JPnn,      ( 33 == execute )
 
 PC ORG @ 0x0c + ! ( cellWord )
-( Pushes the PFA directly )
-    IY PUSHqq,
+( Pushes PFA directly )
+    DE PUSHqq,
     JPNEXT,
 
 PC ORG @ 0x2c + ! ( doesWord )
@@ -317,46 +328,11 @@ PC ORG @ 0x2c + ! ( doesWord )
   linkfrom the PFA, and then continue as a regular
   compiledWord.
 )
-    IY PUSHqq, ( like a regular cell )
-    L 2 IY+ LDrIXY,
-    H 3 IY+ LDrIXY,
-    HL PUSHqq, IY POPqq,
-    0x0e JPnn, ( 0e == compiledWord )
-
-
-( addrWord is the exact same thing as a numberWord except that
-  it is treated differently by meta-tools. See notes.txt )
-PC ORG @ 0x20 + ! ( numberWord )
-PC ORG @ 0x24 + ! ( addrWord )
-( This is not a word, but a number literal. This works a bit
-  differently than others: PF means nothing and the actual
-  number is placed next to the numberWord reference in the
-  compiled word list. What we need to do to fetch that number
-  is to play with the IP.
-)
-    RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
+    DE PUSHqq, ( like a regular cell )
+    EXDEHL,
+    HL INCss,
+    HL INCss,
     E (HL) LDrr,
     HL INCss,
     D (HL) LDrr,
-    HL INCss,
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
-    DE PUSHqq,
-    JPNEXT,
-
-PC ORG @ 0x22 + ! ( litWord )
-( Similarly to numberWord, this is not a real word, but a
-  string literal. Instead of being followed by a 2 bytes
-  number, it's followed by a null-terminated string. When
-  called, puts the string's address on PS )
-    RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
-    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... )
-    RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
-    JPNEXT,
+    0x0e JPnn, ( 0e == compiledWord )

forth/core.fs

@@ -58,7 +58,7 @@
 : CREATE
     (entry)            ( empty header with name )
     11                 ( 11 == cellWord )
-    ,                  ( write it )
+    C,                 ( write it )
 ;
 
 ( We run this when we're in an entry creation context. Many
@@ -71,11 +71,11 @@
 : DOES>
     ( Overwrite cellWord in CURRENT )
     ( 43 == doesWord )
-    43 CURRENT @ !
+    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 @ 4 + HERE !
+    CURRENT @ 3 + HERE !
     ( HERE points to where we should write R> )
     R> ,
     ( We're done. Because we've popped RS, we'll exit parent

forth/icore.fs

@@ -237,7 +237,7 @@ XCURRENT @ ( to PSP )
     ( 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 ] ,
+    [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
     BEGIN
     WORD
     (find)

forth/link.fs

@@ -82,7 +82,7 @@
 )
 ( ol o a1 a2 -- )
 : RLWORD
-    SWAP DUP @              ( ol o a2 a1 n )
+    SWAP DUP C@             ( ol o a2 a1 n )
     ( 0e == compiledWord, 2b == doesWord )
     DUP <>{ 0x0e &= 0x2b |= <>} NOT IF
         ( unwind all args )
@@ -95,7 +95,7 @@
     ( ol o a2 a1 n )
     0x2b = IF 2+ THEN
     ( ol o a2 a1 )
-    2 +                         ( ol o a2 a1+2 )
+    1+                          ( ol o a2 a1+1 )
     BEGIN                       ( ol o a2 a1 )
         2OVER                   ( ol o a2 a1 ol o )
         SWAP                    ( ol o a2 a1 o ol )

forth/xcomp.fs

@@ -34,7 +34,7 @@ VARIABLE XOFF
 : X:
     (xentry)
     ( 0e == compiledWord )
-    [ 0x0e LITN ] ,
+    [ 0x0e LITN ] C,
     BEGIN
     WORD
     ( cross compile CURRENT )

forth/z80a.fs

@@ -158,6 +158,11 @@
 0x0b OP1qq DECss,
 0x09 OP1qq ADDHLss,
 
+: ADDIXss, 0xdd A, ADDHLss, ;
+: ADDIXIX, HL ADDIXss, ;
+: ADDIYss, 0xfd A, ADDHLss, ;
+: ADDIYIY, HL ADDIYss, ;
+
 : _1rr
     C@              ( rd rr op )
     ROT             ( rr op rd )
@@ -324,7 +329,7 @@
     ( same as CREATE, but with native word )
     (entry)
     ( 23 == nativeWord )
-    23 ,
+    23 C,
 ;
 
 : ;CODE JPNEXT, ;
@@ -385,4 +390,3 @@
 ;
 : FWR BSET 0 A, ;
 : FSET @ THEN, ;
-

forth/z80c.fs

@@ -14,6 +14,11 @@
   This unit expects the same conf as boot.fs.
 )
 
+CODE EXECUTE
+    DE POPqq,
+    chkPS,
+    0x33 JPnn,      ( 33 == execute )
+
 ( a b c -- b c a )
 CODE ROT
     HL POPqq,       ( C )
@@ -80,13 +85,13 @@ CODE 2OVER
     HL POPqq,       ( D )
     DE POPqq,       ( C )
     BC POPqq,       ( B )
-    IY POPqq,       ( A )
+    EXX, HL POPqq, EXX, ( A )
     chkPS,
-    IY PUSHqq,      ( A )
+    EXX, HL PUSHqq, EXX, ( A )
     BC PUSHqq,      ( B )
     DE PUSHqq,      ( C )
     HL PUSHqq,      ( D )
-    IY PUSHqq,      ( A )
+    EXX, HL PUSHqq, EXX, ( A )
     BC PUSHqq,      ( B )
 ;CODE
 
@@ -96,11 +101,11 @@ CODE 2SWAP
     HL POPqq,       ( D )
     DE POPqq,       ( C )
     BC POPqq,       ( B )
-    IY POPqq,       ( A )
+    EXX, HL POPqq, EXX, ( A )
     chkPS,
     DE PUSHqq,      ( C )
     HL PUSHqq,      ( D )
-    IY PUSHqq,      ( A )
+    EXX, HL PUSHqq, EXX, ( A )
     BC PUSHqq,      ( B )
 ;CODE
 
@@ -376,3 +381,48 @@ CODE (im1)
     IM1,
     EI,
 ;CODE
+
+CODE 0
+    HL 0 LDddnn,
+    HL PUSHqq,
+;CODE
+
+CODE 1
+    HL 1 LDddnn,
+    HL PUSHqq,
+;CODE
+
+CODE -1
+    HL -1 LDddnn,
+    HL PUSHqq,
+;CODE
+
+CODE 1+
+    HL POPqq,
+    chkPS,
+    HL INCss,
+    HL PUSHqq,
+;CODE
+
+CODE 1-
+    HL POPqq,
+    chkPS,
+    HL DECss,
+    HL PUSHqq,
+;CODE
+
+CODE 2+
+    HL POPqq,
+    chkPS,
+    HL INCss,
+    HL INCss,
+    HL PUSHqq,
+;CODE
+
+CODE 2-
+    HL POPqq,
+    chkPS,
+    HL DECss,
+    HL DECss,
+    HL PUSHqq,
+;CODE