Copy boot.z80 to blkfs

blk/001

@@ -3,8 +3,7 @@ MASTER INDEX
   3 Usage                      30 Dictionary
  70 Implementation notes      100 Block editor
 200 Z80 assembler             260 Cross compilation
-
+280 Z80 boot code
-
 
 
 

blk/064

@@ -1,10 +1,10 @@
 Disk
 
 BLK>  -- a      Address of the current block variable.
-LIST n -- Prints the contents of the block n on screen in the
+LIST  n --      Prints the contents of the block n on screen
-          form of 16 lines of 64 columns.
+                in the form of 16 lines of 64 columns.
 LOAD  n --      Interprets Forth code from block n
-
+LOADR n1 n2 --  Load block range between n1 and n2, inclusive.
 
 
 

blk/075

@@ -13,4 +13,4 @@ This return stack contain "Interpreter pointers", that is a
 pointer to the address of a word, as seen in a compiled list of
 words.
 
-
+                                                        (cont.)

blk/076

@@ -0,0 +1,6 @@
+STACK OVERFLOW PROTECTION: To avoid having to check for stack
+underflow after each pop operation (which can end up being
+prohibitive in terms of costs), we give ourselves a nice 6
+bytes buffer. 6 bytes because we seldom have words requiring
+more than 3 items from the stack. Then, at each "exit" call we
+check for stack underflow.

blk/087

@@ -5,10 +5,10 @@ null-terminated string. Upon execution, the address of that
 null-terminated string is pushed on the PSP and IP is advanced
 to the address following the null.
 
-
+Also note that word routines references in wordrefs are 1b.
-
+This means that all word routine reference must live below
-
+0x100 in boot binary. This is why numberWord and addrWord are
-
+squeezed where they are.
 
 
 

blk/102

@@ -1,10 +1,10 @@
-103 LOAD 104 LOAD 105 LOAD
+103 105 LOADR
 
 : BROWSE
     100 _LIST
     BEGIN
         KEY CASE
-            'Q' OF DROP EXIT ENDOF
+            'Q' OF EXIT ENDOF
             'B' OF B ENDOF
             'N' OF N ENDOF
             _NUM

blk/280

@@ -0,0 +1,16 @@
+Z80 boot code
+
+This assembles the boot binary. It requires the Z80 assembler
+(B200) and cross compilation setup (B260).
+
+On top of that, it requires RAMSTART to be defined as the
+beginning address of RAM. This is where system variables are
+placed. HERE is then placed at RAM+80 (ref B80).
+
+We also need RS_ADDR to be set to the bottom address of the
+Return Stack.
+
+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".                                          (cont.)

blk/281

@@ -0,0 +1,7 @@
+(cont.) STABLE ABI: The boot binary starts with a list of
+references. The address of these references have to stay to
+those addresses. The rest of the Collapse OS code depend on it.
+In fact, up until 0x67, the (?br) wordref, pretty much
+everything has to stay put.
+
+To assemble, run "282 LOAD".

blk/282

@@ -0,0 +1 @@
+283 333 LOADR

blk/283

@@ -0,0 +1,15 @@
+H@ ORG !
+0 JPnn,       ( 00, main )     0 JPnn,       ( 03, find )
+NOP, NOP,     ( 06, unused )   NOP, NOP,     ( 08, LATEST )
+NOP,          ( 0a, unused )   0 JPnn,       ( 0b, cellWord )
+0 JPnn,   ( 0e, compiledWord ) 0 JPnn,       ( 11, pushRS )
+0 JPnn,       ( 14, popRS )
+EXDEHL, JP(HL), NOP, ( 17, nativeWord )
+0 JPnn,       ( 1a, next )     0 JPnn,       ( 1d, chkPS )
+NOP, NOP,   ( 20, numberWord ) NOP, NOP,     ( 22, litWord )
+NOP, NOP,     ( 24, addrWord ) NOP, NOP,     ( 26, unused )
+RAMSTART 0x4e + JPnn, ( 28, RST 28 )
+0 JPnn,       ( 2b, doesWord ) NOP, NOP,     ( 2e, unused )
+RAMSTART 0x4e + JPnn, ( RST 30 )
+0 JPnn,       ( 33, execute )  NOP, NOP,     ( unused )
+RAMSTART 0x4e + JPnn, ( RST 38 )

blk/284

@@ -0,0 +1,12 @@
+( BOOT DICT: 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,
+H@ XCURRENT !        ( set current tip of dict, 0x42 )
+    0x17 A,          ( nativeWord )
+    0x14 CALLnn,     ( popRS )
+    HL PUSHqq, IY POPqq, ( --> IP )
+    JPNEXT,
+

blk/285

@@ -0,0 +1,6 @@
+CODE (br)            ( 0x53 )
+L2 BSET ( used in CBR )
+    E 0 IY+ LDrIXY,
+    D 1 IY+ LDrIXY,
+    DE ADDIYss,
+    JPNEXT,

blk/286

@@ -0,0 +1,13 @@
+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 )
+    IY INCss,
+    IY INCss,
+    JPNEXT,
+
+( END OF STABLE ABI )
+

blk/287

@@ -0,0 +1,14 @@
+( See B85 for word routine impl notes )
+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,

blk/288

@@ -0,0 +1,16 @@
+PC ORG @ 0x22 + ! ( litWord )
+( Like numberWord, but 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,

blk/289

@@ -0,0 +1,16 @@
+( Name of BOOT word )
+L1 BSET 'B' A, 'O' A, 'O' A, 'T' A, 0 A,
+
+PC ORG @ 1 + ! ( main )
+( STACK OVERFLOW PROTECTION: See B76 )
+    SP 0xfffa LDddnn,
+    RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP )
+    IX RS_ADDR LDddnn,
+( HERE begins at RAMEND )
+    HL RAMSTART 0x80 + LDddnn,
+    RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
+( LATEST is a label to the latest entry of the dict. It is
+  written at offset 0x08 by the process or person building
+  Forth. )
+    0x08 LDHL(nn),
+    RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT       cont. )

blk/290

@@ -0,0 +1,4 @@
+    EXDEHL,
+    HL L1 @ LDddnn,
+    0x03 CALLnn,        ( 03 == find )
+    0x33 JPnn,          ( 33 == execute )

blk/291

@@ -0,0 +1,16 @@
+PC ORG @ 4 + ! ( find )
+( Find the entry corresponding to word name where (HL) points
+  to in dictionary having its tip at DE and sets DE to point
+  to that entry. Z if found, NZ if not. )
+    BC PUSHqq,
+    HL PUSHqq,
+	( First, figure out string len )
+    BC 0 LDddnn,
+    A XORr,
+    CPIR,
+	( C has our length, negative, -1 )
+    A C LDrr,
+    NEG,
+    A DECr,
+	( special case. zero len? we never find anything. )
+    JRZ, L1 FWR ( fail-B296 )                         ( cont. )

blk/292

@@ -0,0 +1,16 @@
+    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 )
+    ( DE is a wordref, first step, do our len correspond? )
+        HL PUSHqq,          ( --> lvl 1 )
+        DE PUSHqq,          ( --> lvl 2 )
+        DE DECss,
+        LDA(DE),
+        0x7f ANDn,          ( remove IMMEDIATE flag )
+        C CPr,                                        ( cont. )

blk/293

@@ -0,0 +1,16 @@
+        JRNZ, L2 FWR ( loopend )
+        ( match, let's compare the string then )
+        DE DECss, ( Skip prev field. One less because we )
+        DE DECss, ( pre-decrement )
+        B C LDrr, ( loop C times )
+        BEGIN, ( loop )
+            ( pre-decrement for easier Z matching )
+            DE DECss,
+            HL DECss,
+            LDA(DE),
+            (HL) CPr,
+            JRNZ, L3 FWR ( loopend )
+        DJNZ, AGAIN, ( loop )
+        L2 FSET L3 FSET ( loopend )
+
+                                                      ( cont. )

blk/294

@@ -0,0 +1,16 @@
+( 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, L2 FWR ( end-B296, match? we're done! )
+        ( no match, go to prev and continue )
+        HL PUSHqq,          ( --> lvl 1 )
+        DE DECss,
+        DE DECss,
+        DE DECss,           ( prev field )
+        DE PUSHqq,          ( --> lvl 2 )
+        EXDEHL,
+        E (HL) LDrr,
+        HL INCss,
+        D (HL) LDrr,
+                                                      ( cont. )

blk/295

@@ -0,0 +1,16 @@
+        ( DE contains prev offset )
+        HL POPqq,           ( <-- lvl 2 )
+        ( HL is prev field's addr. Is offset zero? )
+        A D LDrr,
+        E ORr,
+        IFNZ,
+            ( get absolute addr from offset )
+            ( carry cleared from "or e" )
+            DE SBCHLss,
+            EXDEHL,             ( result in DE )
+        THEN,
+        HL POPqq,           ( <-- lvl 1 )
+    JRNZ, AGAIN, ( inner-B292, try to match again )
+    ( Z set? end of dict, unset Z )
+
+                                                      ( cont. )

blk/296

@@ -0,0 +1,7 @@
+    L1 FSET ( fail )
+    A XORr,
+    A INCr,
+    L2 FSET ( end )
+    HL POPqq,
+    BC POPqq,
+    RET,

blk/297

@@ -0,0 +1,13 @@
+PC ORG @ 0x12 + ! ( pushRS )
+    IX INCss,
+    IX INCss,
+    0 IX+ L LDIXYr,
+    1 IX+ H LDIXYr,
+    RET,
+
+PC ORG @ 0x15 + ! ( popRS )
+    L 0 IX+ LDrIXY,
+    H 1 IX+ LDrIXY,
+    IX DECss,
+    IX DECss,
+    RET,

blk/298

@@ -0,0 +1,7 @@
+'(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A,
+L2 BSET ( abortUnderflow )
+    HL PC 7 - LDddnn,
+    DE RAMSTART 0x02 + LDdd(nn),   ( RAM+02 == CURRENT )
+    0x03 CALLnn, ( find )
+    0x33 JPnn,          ( 33 == execute )
+

blk/299

@@ -0,0 +1,14 @@
+PC ORG @ 0x1e + ! ( chkPS )
+    HL PUSHqq,
+    RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
+( We have the return address for this very call on the stack
+  and protected registers. Let's compensate )
+    HL DECss,
+    HL DECss,
+    HL DECss,
+    HL DECss,
+    SP SUBHLss,
+    HL POPqq,
+    CNC RETcc,      ( INITIAL_SP >= SP? good )
+    JR, L2 BWR      ( abortUnderflow-B298 )
+

blk/300

@@ -0,0 +1,16 @@
+PC ORG @ 0x1b + ! ( next )
+( This routine is jumped to at the end of every word. In it,
+  we jump to current IP, but we also take care of increasing
+  it by 2 before jumping. )
+	( Before we continue: are stacks within bounds? )
+    0x1d CALLnn, ( chkPS )
+    ( check RS )
+    IX PUSHqq, HL POPqq,
+    DE RS_ADDR LDddnn,
+    DE SUBHLss,
+    JRC, L2 BWR ( IX < RS_ADDR? abortUnderflow-B298 )
+    E 0 IY+ LDrIXY,
+    D 1 IY+ LDrIXY,
+    IY INCss,
+    IY INCss,
+    ( continue to execute )

blk/301

@@ -0,0 +1,12 @@
+L3 BSET
+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),
+

blk/302

@@ -0,0 +1,16 @@
+L1 BSET
+PC ORG @ 0x0f + ! ( compiledWord )
+( 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. )
+    IY PUSHqq, HL POPqq, ( <-- IP )
+    0x11 CALLnn,     ( 11 == pushRS )
+    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,
+    HL PUSHqq, IY POPqq, ( --> IP )
+    JR, L3 BWR      ( execute-B301 )

blk/303

@@ -0,0 +1,5 @@
+PC ORG @ 0x0c + ! ( cellWord )
+( Pushes PFA directly )
+    DE PUSHqq,
+    JPNEXT,
+

blk/304

@@ -0,0 +1,16 @@
+PC ORG @ 0x2c + ! ( doesWord )
+( The word was spawned from a definition word that has a
+  DOES>. PFA+2 (right after the actual cell) is a link to the
+  slot right after that DOES>. Therefore, what we need to do
+  push the cell addr like a regular cell, then follow the
+  linkfrom the PFA, and then continue as a regular
+  compiledWord. )
+    DE PUSHqq, ( like a regular cell )
+    EXDEHL,
+    HL INCss,
+    HL INCss,
+    E (HL) LDrr,
+    HL INCss,
+    D (HL) LDrr,
+    JR, L1 BWR   ( compiledWord-B302 )
+

blk/305

@@ -0,0 +1,9 @@
+( Core words )
+( KEY and EMIT are not defined here. There're
+  expected to be defined in platform-specific code. )
+
+
+CODE EXECUTE
+    DE POPqq,
+    chkPS,
+    JR, L3 BWR      ( execute-B301 )

blk/306

@@ -0,0 +1,11 @@
+( a b c -- b c a )
+CODE ROT
+    HL POPqq,       ( C )
+    DE POPqq,       ( B )
+    BC POPqq,       ( A )
+    chkPS,
+    DE PUSHqq,      ( B )
+    HL PUSHqq,      ( C )
+    BC PUSHqq,      ( A )
+;CODE
+

blk/307

@@ -0,0 +1,13 @@
+( a -- a a )
+CODE DUP
+    HL POPqq,       ( A )
+    chkPS,
+    HL PUSHqq,      ( A )
+    HL PUSHqq,      ( A )
+;CODE
+
+( a -- )
+CODE DROP
+    HL POPqq,
+;CODE
+

blk/308

@@ -0,0 +1,10 @@
+( a b -- b a )
+CODE SWAP
+    HL POPqq,       ( B )
+    DE POPqq,       ( A )
+    chkPS,
+    HL PUSHqq,      ( B )
+    DE PUSHqq,      ( A )
+;CODE
+
+

blk/309

@@ -0,0 +1,11 @@
+( a b -- a b a )
+CODE OVER
+    HL POPqq,       ( B )
+    DE POPqq,       ( A )
+    chkPS,
+    DE PUSHqq,      ( A )
+    HL PUSHqq,      ( B )
+    DE PUSHqq,      ( A )
+;CODE
+
+

blk/310

@@ -0,0 +1,16 @@
+CODE PICK
+    HL POPqq,
+    chkPS,
+    ( x2 )
+    L SLAr, H RLr,
+    SP ADDHLss,
+    C (HL) LDrr,
+    HL INCss,
+    B (HL) LDrr,
+    ( check PS range before returning )
+    EXDEHL,
+    RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
+    DE SUBHLss,
+    CC L2 @ JPccnn,    ( abortUnderflow-B298 )
+    BC PUSHqq,
+;CODE

blk/311

@@ -0,0 +1,15 @@
+( Low-level part of ROLL. Example:
+  "1 2 3 4 4 (roll)" --> "1 3 4 4". No sanity checks, never
+  call with 0. )
+CODE (roll)
+    HL POPqq,
+    B H LDrr,
+    C L LDrr,
+    SP ADDHLss,
+    HL INCss,
+    D H LDrr,
+    E L LDrr,
+    HL DECss,
+    HL DECss,
+    LDDR,
+;CODE

blk/312

@@ -0,0 +1,8 @@
+( a b -- )
+CODE 2DROP
+    HL POPqq,
+    HL POPqq,
+    chkPS,
+;CODE
+
+

blk/313

@@ -0,0 +1,11 @@
+CODE S0
+    RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP )
+    HL PUSHqq,
+;CODE
+
+CODE 'S
+    HL 0 LDddnn,
+    SP ADDHLss,
+    HL PUSHqq,
+;CODE
+

blk/314

@@ -0,0 +1,14 @@
+CODE AND
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    A E LDrr,
+    L ANDr,
+    L A LDrr,
+    A D LDrr,
+    H ANDr,
+    H A LDrr,
+    HL PUSHqq,
+;CODE
+
+

blk/315

@@ -0,0 +1,12 @@
+CODE OR
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    A E LDrr,
+    L ORr,
+    L A LDrr,
+    A D LDrr,
+    H ORr,
+    H A LDrr,
+    HL PUSHqq,
+;CODE

blk/316

@@ -0,0 +1,12 @@
+CODE XOR
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    A E LDrr,
+    L XORr,
+    L A LDrr,
+    A D LDrr,
+    H XORr,
+    H A LDrr,
+    HL PUSHqq,
+;CODE

blk/317

@@ -0,0 +1,8 @@
+CODE NOT
+    HL POPqq,
+    chkPS,
+    A L LDrr,
+    H ORr,
+    PUSHZ,
+;CODE
+

blk/318

@@ -0,0 +1,15 @@
+CODE +
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    DE ADDHLss,
+    HL PUSHqq,
+;CODE
+
+CODE -
+    DE POPqq,
+    HL POPqq,
+    chkPS,
+    DE SUBHLss,
+    HL PUSHqq,
+;CODE

blk/319

@@ -0,0 +1,16 @@
+CODE *  ( DE * BC -> DE (high) and HL (low) )
+    DE POPqq, BC POPqq, chkPS,
+    HL 0 LDddnn,
+    A 0x10 LDrn,
+( loop )
+    HL ADDHLss,
+    E RLr, D RLr,
+    JRNC, 4 A, ( noinc )
+    BC ADDHLss,
+    JRNC, 1 A, ( noinc )
+    DE INCss,
+( noinc )
+    A DECr,
+    JRNZ, -14 A, ( loop )
+    HL PUSHqq,
+;CODE

blk/320

@@ -0,0 +1,16 @@
+( Borrowed from http://wikiti.brandonw.net/ )
+( Divides AC by DE and places the quotient in AC and the
+  remainder in HL )
+CODE /MOD
+    DE POPqq,
+    BC POPqq,
+    chkPS,
+    A B LDrr,
+    B 16 LDrn,
+    HL 0 LDddnn,
+
+
+
+
+
+                                                      ( cont. )

blk/321

@@ -0,0 +1,15 @@
+    BEGIN, ( loop )
+        SCF,
+        C RLr,
+        RLA,
+        HL ADCHLss,
+        DE SBCHLss,
+        IFC,
+            DE ADDHLss,
+            C DECr,
+        THEN,
+    DJNZ, AGAIN, ( loop )
+    B A LDrr,
+    HL PUSHqq,
+    BC PUSHqq,
+;CODE

blk/322

@@ -0,0 +1,16 @@
+CODE !
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    (HL) E LDrr,
+    HL INCss,
+    (HL) D LDrr,
+;CODE
+CODE @
+    HL POPqq,
+    chkPS,
+    E (HL) LDrr,
+    HL INCss,
+    D (HL) LDrr,
+    DE PUSHqq,
+;CODE

blk/323

@@ -0,0 +1,14 @@
+CODE C!
+    HL POPqq,
+    DE POPqq,
+    chkPS,
+    (HL) E LDrr,
+;CODE
+
+CODE C@
+    HL POPqq,
+    chkPS,
+    L (HL) LDrr,
+    H 0 LDrn,
+    HL PUSHqq,
+;CODE

blk/324

@@ -0,0 +1,15 @@
+CODE PC!
+    BC POPqq,
+    HL POPqq,
+    chkPS,
+    L OUT(C)r,
+;CODE
+
+CODE PC@
+    BC POPqq,
+    chkPS,
+    H 0 LDrn,
+    L INr(C),
+    HL PUSHqq,
+;CODE
+

blk/325

@@ -0,0 +1,16 @@
+CODE I
+    L 0 IX+ LDrIXY,
+    H 1 IX+ LDrIXY,
+    HL PUSHqq,
+;CODE
+CODE I'
+    L 2 IX- LDrIXY,
+    H 1 IX- LDrIXY,
+    HL PUSHqq,
+;CODE
+CODE J
+    L 4 IX- LDrIXY,
+    H 3 IX- LDrIXY,
+    HL PUSHqq,
+;CODE
+

blk/326

@@ -0,0 +1,13 @@
+CODE >R
+    HL POPqq,
+    chkPS,
+    ( 17 == pushRS )
+    17 CALLnn,
+;CODE
+
+CODE R>
+    ( 20 == popRS )
+    20 CALLnn,
+    HL PUSHqq,
+;CODE
+

blk/327

@@ -0,0 +1,14 @@
+CODE BYE
+    HALT,
+;CODE
+
+CODE (resSP)
+    ( INITIAL_SP == RAM+0 )
+    SP RAMSTART LDdd(nn),
+;CODE
+
+CODE (resRS)
+    IX RS_ADDR LDddnn,
+;CODE
+
+

blk/328

@@ -0,0 +1,16 @@
+CODE S=
+    DE  POPqq,
+    HL  POPqq,
+    chkPS,
+    BEGIN, ( loop )
+        LDA(DE),
+        (HL) CPr,
+        JRNZ, L1 FWR ( not equal? break early to "end".
+                       NZ is set. )
+        A ORr,   ( if our char is null, stop )
+        HL INCss,
+        DE INCss,
+    JRNZ, AGAIN, ( loop )
+L1 FSET ( end )
+    PUSHZ,
+;CODE

blk/329

@@ -0,0 +1,16 @@
+CODE CMP
+    HL  POPqq,
+    DE  POPqq,
+    chkPS,
+    DE SUBHLss,
+    BC 0 LDddnn,
+    IFNZ, ( < or > )
+        BC INCss,
+        IFNC, ( < )
+            BC DECss,
+            BC DECss,
+        THEN,
+    THEN,
+    BC PUSHqq,
+;CODE
+

blk/330

@@ -0,0 +1,16 @@
+CODE _find  ( cur w -- a f )
+    HL POPqq,       ( w )
+    DE POPqq,       ( cur )
+    chkPS,
+    ( 3 == find )
+    3 CALLnn,
+    IFNZ,
+        ( not found )
+        HL PUSHqq,
+        PUSH0,
+        JPNEXT,
+    THEN,
+    ( found )
+    DE PUSHqq,
+    PUSH1,
+;CODE

blk/331

@@ -0,0 +1,14 @@
+CODE (im1)
+    IM1,
+    EI,
+;CODE
+
+CODE 0 PUSH0, ;CODE
+CODE 1 PUSH1, ;CODE
+
+CODE -1
+    HL -1 LDddnn,
+    HL PUSHqq,
+;CODE
+
+

blk/332

@@ -0,0 +1,14 @@
+CODE 1+
+    HL POPqq,
+    chkPS,
+    HL INCss,
+    HL PUSHqq,
+;CODE
+
+CODE 1-
+    HL POPqq,
+    chkPS,
+    HL DECss,
+    HL PUSHqq,
+;CODE
+

blk/333

@@ -0,0 +1,16 @@
+CODE 2+
+    HL POPqq,
+    chkPS,
+    HL INCss,
+    HL INCss,
+    HL PUSHqq,
+;CODE
+
+CODE 2-
+    HL POPqq,
+    chkPS,
+    HL DECss,
+    HL DECss,
+    HL PUSHqq,
+;CODE
+

forth/blk.fs

@@ -86,3 +86,6 @@
         R> DROP ( BLK> )
     THEN
 ;
+
+( b1 b2 -- )
+: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;