Make DO..LOOP stable

DO and LOOP now only compile words from stable ABI, which make them
suitable for xcomp. This will greatly simplify driver writing and
allow us to mostly avoid the low/high divide in drivers.

LEAVE is still xcomp-incompatible though.

This make us very very tight for "<0x100" limit for literal words.
Hopefully, we won't need more stuff in that area of the binary...

blk/058

@@ -4,10 +4,9 @@ LIT    --         Write a LIT entry. You're expected to write
                   actual string to HERE right afterwards.
 LIT< x --         Read following word and write to HERE as a
                   string literal.
-LITS   a --       Write word at addr a as a atring literal.
 S=     a1 a2 -- f Returns whether string a1 == a2.
-SCPY   a --       Copy string at addr a into HERE.
+SCPY   a --       Copy string at addr a into HERE, without
-
+                  NULL termination.
 
 
 

blk/208

@@ -8,9 +8,9 @@ LD [rr, rn, ddnn, (nn)HL, HL(nn), dd(nn), (nn)dd, rIXY, IXYr,
     (DE)A, A(DE)]
 ADD [r, n, HLss, IXss, IXIX, IYss, IYIY]
 ADC [r, HLss]
-CP  [r, n]
+CP  [r, n, (IXY+)]
 SBC [r, HLss]
 SUB [r, n]
 PUSH [qq]  POP [qq]
-INC [r, ss]            DEC [r, ss]
+INC [r, ss, (IXY+)]    DEC [r, ss, (IXY+)]
 AND [r, n] OR [r, n]   XOR [r, n]                       (cont.)

blk/218

@@ -8,3 +8,5 @@
     OR A,
 ;
 0x04 OP1r INCr,                0x05 OP1r DECr,
+: INC(IXY+), INCr, A, ;
+: DEC(IXY+), DECr, A, ;

blk/219

@@ -11,3 +11,4 @@
 0xa0 OP1r0 ANDr,               0xb8 OP1r0 CPr,
 0xb0 OP1r0 ORr,                0x90 OP1r0 SUBr,
 0x98 OP1r0 SBCr,               0xa8 OP1r0 XORr,
+: CP(IXY+), CPr, A, ;

blk/268

@@ -8,7 +8,7 @@
             DUP LIT< ( S= IF
                 DROP [COMPILE] (
             ELSE
-                SCPY 0x20 H@ 1- C!
+                SCPY 0x20 C,
             THEN 0 ( loop again )
         ELSE 1 ( stop looping ) THEN
     UNTIL

blk/284

@@ -2,11 +2,15 @@
   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 )
+0 A,, ( prev )
 4 A,
 H@ XCURRENT !        ( set current tip of dict, 0x42 )
     0x17 A,          ( nativeWord )
     0x14 BCALL,      ( popRS )
     HL PUSHqq, IY POPqq, ( --> IP )
     JPNEXT,
-
+CODE (br)            ( 0x53 )
+L2 BSET ( used in CBR )
+    E 0 IY+ LDrIXY, D 1 IY+ LDrIXY,
+    DE ADDIYss,
+    JPNEXT,

blk/285

@@ -1,6 +1,15 @@
-CODE (br)            ( 0x53 )
+CODE (?br)           ( 0x67 )
-L2 BSET ( used in CBR )
+    HL POPqq, chkPS,
-    E 0 IY+ LDrIXY,
+    HLZ,
-    D 1 IY+ LDrIXY,
+    JRZ, L2 BWR ( BR + 2. False, branch )
-    DE ADDIYss,
+    L1 BSET ( loop will jump here )
+    ( True, skip next 2 bytes and don't branch )
+    IY INCss, IY INCss,
     JPNEXT,
+CODE (loop) ( 0x77 )
+    0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ )
+    ( Jump if I <> I' )
+    A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L2 BWR ( branch )
+    A 1 IX+ LDrIXY, 1 IX- CP(IXY+), JRNZ, L2 BWR ( branch )
+    ( don't branch )
+    IX DECss, IX DECss, IX DECss, IX DECss, JR, L1 BWR

blk/286

@@ -1,12 +1,16 @@
-CODE (?br)           ( 0x67 )
+CODE >R ( 0xa8 )
-    HL POPqq,
+    HL POPqq, chkPS,
-    chkPS,
+    17 BCALL, ( 17 == pushRS )
-    HLZ,
+;CODE
-    JRZ, L2 BWR ( BR + 2. False, branch )
+CODE 2>R ( 0xb9 )
-    ( True, skip next 2 bytes and don't branch )
+    DE POPqq, HL POPqq, chkPS,
-    IY INCss,
+    17 BCALL, ( 17 == pushRS ) EXDEHL, 17 BCALL,
-    IY INCss,
+;CODE
-    JPNEXT,
+CODE R> ( 0xce )
-
+    20 BCALL, ( 20 == popRS )
-( END OF STABLE ABI )
+    HL PUSHqq,
-
+;CODE
+CODE 2R> ( 0xdc )
+    20 BCALL, ( 20 == popRS ) EXDEHL, 20 BCALL,
+    HL PUSHqq, DE PUSHqq,
+;CODE ( END OF STABLE ABI )

blk/288

@@ -1,4 +1,4 @@
-PC ORG @ 0x22 + ! ( litWord )
+PC ORG @ 0x22 + ! ( litWord, 0xf7, very tight on the 0x100 limit )
 ( 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 )

blk/326

@@ -1,17 +0,0 @@
-CODE >R
-    HL POPqq, chkPS,
-    17 BCALL, ( 17 == pushRS )
-;CODE
-CODE 2>R
-    DE POPqq, HL POPqq, chkPS,
-    17 BCALL, ( 17 == pushRS ) EXDEHL, 17 BCALL,
-;CODE
-CODE R>
-    20 BCALL, ( 20 == popRS )
-    HL PUSHqq,
-;CODE
-CODE 2R>
-    20 BCALL, ( 20 == popRS ) EXDEHL, 20 BCALL,
-    HL PUSHqq, DE PUSHqq,
-;CODE
-

blk/391

@@ -9,8 +9,8 @@ unusable directly. For the same reason, any reference to a word
 in the host system will obviously be wrong in the target
 system. More details in B260.
 
-This unit is loaded in two "low" and "high" parts. The low part
+These rules result in some practicals do's and dont's:
-is the biggest chunk and has the most definitions. The high
+
-part is the "sensitive" chunk and contains "LITN", ":" and ";"
+1. No LEAVE in DO..LOOP
-definitions which, once defined, kind of make any more defs
+
-impossible.                                             (cont.)
+                                                        (cont.)

blk/392

@@ -1,3 +1,9 @@
+This unit is loaded in two "low" and "high" parts. The low part
+is the biggest chunk and has the most definitions. The high
+part is the "sensitive" chunk and contains "LITN", ":" and ";"
+definitions which, once defined, kind of make any more defs
+impossible.
+
 The gap between these 2 parts is the ideal place to put device
 driver code. Load the low part with "393 LOAD", the high part
 with "415 LOAD"

blk/407

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

blk/408

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

blk/412

@@ -1,3 +1,6 @@
+( Words here until the end of the low part, unlike words
+  preceeding them, aren't immediately needed for boot. But its
+  better to have as many words as possible in the xcomp part. )
 : H@ HERE @ ;
 : IMMEDIATE
     CURRENT @ 1-
@@ -5,4 +8,8 @@
 ;
 : +! SWAP OVER @ + SWAP ! ;
 : -^ SWAP - ;
+: / /MOD SWAP DROP ;
+: MOD /MOD DROP ;
+
 : ALLOT HERE +! ;
+: CREATE (entry) 11 ( 11 == cellWord ) C, ;

blk/422

@@ -1,7 +1,6 @@
 : [ INTERPRET ; IMMEDIATE
 : ] R> DROP ;
-: LITS 34 , SCPY ;
+: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
-: LIT< WORD LITS ; IMMEDIATE
 : LITA 36 , , ;
 : '? WORD (find) ;
 : '

blk/424

@@ -7,7 +7,7 @@
 
   40 is ASCII for '('. We do this to simplify XPACK's task of
   not mistakenly consider '(' definition as a comment.
-  LITS: 34 == litWord
+  LIT<: 34 == litWord
   LITA: 36 == addrWord
   COMPILE: Tough one. Get addr of caller word (example above
   (br)) and then call LITA on it. )

blk/429

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

blk/431

@@ -1,10 +1,8 @@
 : 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 2>R H@ ; IMMEDIATE
-
+: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
-
+: LEAVE R> R> DROP I 1- >R >R ;

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 2R> COMPILE 2DROP
-; IMMEDIATE

blk/433

@@ -1,5 +1,3 @@
-: LEAVE R> R> DROP I 1- >R >R ;
-
 : ROLL
     DUP NOT IF EXIT THEN
     1+ DUP PICK          ( n val )