Inline SCPY

I'm planning a string reform and it's standing in the way.

blk/001

@@ -2,7 +2,7 @@ MASTER INDEX
 
   3 Usage                      30 Dictionary
  70 Implementation notes      100 Block editor
-120 Linker                    150 Extra words
+150 Extra words
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 Core words
 410 PS/2 keyboard subsystem   420 Bootstrap guide

blk/004

@@ -1 +1,2 @@
 21 How blocks are organized    22 Addressed devices
+23 Branching

blk/023

@@ -0,0 +1,11 @@
+Branching
+
+Branching in Collapse OS is limited to 8-bit. This represents
+64 word references forward or backward. While this might seem
+a bit tight at first, having this limit saves us a non-
+negligible amount of resource usage.
+
+The reasoning behind this intentional limit is that huge
+branches are generally a indicator that a logic ought to be
+simplified. So here's one more constraint for you to help you
+towards simplicity.

blk/058

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

blk/120

@@ -1,16 +0,0 @@
-Linker
-
-Relink a dictionary by applying offsets to all word references
-in words of the "compiled" type.
-
-A typical usage of this unit would be to, right after a
-bootstrap-from-icore-from-source operation, identify the root
-word of the source part, probably "H@", and run " ' thatword
-RLDICT ". Then, take the resulting relinked binary, concatenate
-it to the boot binary, and write to boot media.
-
-LIMITATIONS
-
-This unit can't automatically detect all offsets needing
-relinking. This is a list of situations that aren't handled:
-                                                        (cont.)

blk/121

@@ -1,8 +0,0 @@
-Cells: It's not possible to know for sure whether a cellWord
-contains an address or a number. They are therefore not
-automatically relinked. You have to manually relink each of
-them with RLCELL. In the case of a DOES> word, PFA+2, which
-is always an offset, is automatically relinked, but not
-PFA+0.
-
-Load with "122 LOAD"

blk/122

@@ -1 +0,0 @@
-1 9 LOADR+

blk/123

@@ -1,15 +0,0 @@
-( Skip atom, considering special atom types. )
-: ASKIP ( a -- a+n )
-    DUP @       ( a n )
-    ( ?br or br or NUMBER )
-    DUP 0x67 = OVER 0x53 = OR OVER 0x20 = OR OVER 0x24 = OR
-    IF DROP 4 + EXIT THEN
-    ( regular word )
-    0x22 = NOT IF 2+ EXIT THEN
-    ( it's a lit, skip to null char )
-    ( a )
-    1+  ( we skip by 2, but the loop below is pre-inc... )
-    BEGIN 1+ DUP C@ NOT UNTIL
-    ( skip null char )
-    1+
-;

blk/124

@@ -1,11 +0,0 @@
-( RLATOM pre-comment
-
-  Relink atom at a, applying offset o with limit ol.
-  Returns a, appropriately skipped.
-
-  0x24 = IF: 0x24 is an addrWord, which should be offsetted in
-  the same way that a regular word would. To achieve this, we
-  skip ASKIP and instead of skipping 4 bytes like a numberWord,
-  we skip only 2, which means that our number will be treated
-  like a regular wordref. )
-

blk/125

@@ -1,16 +0,0 @@
-: RLATOM ( a o ol -- a+n )
-    ROT             ( o ol a )
-    DUP @           ( o ol a n )
-    DUP 0x24 = IF
-        DROP 2+     ( o ol a+2 )
-        ROT ROT 2DROP ( a ) EXIT
-    THEN
-    ROT             ( o a n ol )
-    < IF  ( under limit, do nothing )
-        NIP          ( a )
-    ELSE ( o a )
-        TUCK @       ( a o n )
-        -^           ( a n-o )
-        OVER !       ( a )
-    THEN
-    ASKIP ;

blk/126

@@ -1,15 +0,0 @@
-( RLWORD pre-comment
-
-  Relink a word with specified offset. If it's not of the type
-  "compiled word", ignore. If it is, advance in word until a2
-  is met, and for each word that is above ol, reduce that
-  reference by o.
-  Arguments: a1: wordref a2: word end addr o: offset to apply
-             ol: offset limit. don't apply on refs under it.
-
-  The 0x0e and 0x2b check at the beginning is to ensure we have
-  either a compiledWord or a doesWord. If we don't, we do
-  nothing. The further 0x2b check is because if we have a
-  doesWord, we start 2 bytes later.
-)
-

blk/127

@@ -1,16 +0,0 @@
-: RLWORD ( ol o a1 a2 -- )
-    SWAP DUP C@             ( ol o a2 a1 n )
-    DUP 0x0e = OVER 0x2b = OR NOT IF
-        ( unwind all args ) 2DROP 2DROP EXIT THEN
-    0x2b = IF 2+ THEN ( ol o a2 a1 )
-    1+                          ( ol o a2 a1+1 )
-    BEGIN                       ( ol o a2 a1 )
-        2OVER SWAP              ( ol o a2 a1 o ol )
-        RLATOM                  ( ol o a2 a+n )
-        2DUP < IF ABORT THEN    ( Something is very wrong )
-        2DUP =                  ( ol o a2 a+n f )
-        IF ( unwind )
-            2DROP 2DROP EXIT
-        THEN
-    AGAIN
-;

blk/128

@@ -1,16 +0,0 @@
-( RLDICT pre-comment: Copy dict from target wordref, including
-header, up to HERE.  We're going relocate those words by
-specified offset. To do this, we're copying this whole memory
-area in HERE and then iterate through that copied area and call
-RLWORD on each word. That results in a dict that can be
-concatenated to target's prev entry in a more compact way.
-
-  This copy of data doesn't allocate anything, so H@ doesn't
-move. Moreover, we reserve 4 bytes at H@ to write our target
-and offset because otherwise, things get too complicated with
-the PSP.
-
-  The output of this word is 3 numbers: top copied address, top
-copied CURRENT, and then the beginning of the copied dict at
-the end to indicate that we're finished processing.
-                                                        cont. )

blk/129

@@ -1,16 +0,0 @@
-( Note that the last word is always skipped because it's not
-possible to reliably detect its end. If you need that last
-word, define a dummy word before calling RLDICT.
-
-We first start by copying the affected area to H@+4. This is
-where the relinking will take place.
-
-Then we iterate the new dict from the top, keeping track of
-wr, the current wordref and we, wr's end offset.
-
-Initially, we get our wr and we, withH@ and CURRENT, which we
-offset by u+4. +4 before, remember, we're using 4 bytes
-as variable space.
-
-At each iteration, we becomes wr-header and wr is fetched from
-PREV field. )

blk/130

@@ -1,16 +0,0 @@
-: RLDICT ( target offset -- )
-    H@ 2+ ! H@ ! ( H@+2 == offset, H@ == target )
-    H@ @ WORD( DUP H@ -^        ( src u )
-    DUP ROT SWAP H@ 4 +         ( u src u dst )
-    SWAP MOVE                   ( u )
-    4 + DUP CURRENT @ WORD( +   ( u we )
-    DUP .X NL
-    SWAP CURRENT @ PREV + DUP .X NL ( we wr )
-    BEGIN                       ( we wr )
-        DUP ROT                 ( wr wr we )
-        H@ @ H@ 2+ @            ( wr wr we ol o )
-        2SWAP RLWORD            ( wr )
-        DUP PREV SWAP           ( wr oldwr )
-        WORD( SWAP              ( we wr )
-        DUP 4 - H@ <= ( are we finished? )
-    UNTIL H@ 4 + .X NL ;

blk/262

@@ -1 +1 @@
-1 LOAD+ 3 LOAD+ 6 LOAD+ 7 LOAD+
+1 LOAD+ 3 LOAD+ 6 LOAD+ 

blk/267

@@ -1,6 +0,0 @@
-XPACK - pack source code
-
-The goal of this word is to pack source code in tight places,
-such as on the boot section of an EEPROM. It takes a block
-number, reads it and packs it to HERE. It normalizes all
-whitespaces to a single space and ignore comments.

blk/268

@@ -1,16 +0,0 @@
-: XPACK ( blkno -- )
-    BLK@
-    BLK( 0x2e RAM+ ! ( boot ptr )
-    ['] (boot<) 0x08 RAM+ ! ( C<* override )
-    BEGIN
-        WORD
-        0x2e RAM+ @ BLK( 1024 + < IF
-            DUP LIT< ( S= IF
-                DROP [COMPILE] (
-            ELSE
-                SCPY 0x20 C,
-            THEN 0 ( loop again )
-        ELSE 1 ( stop looping ) THEN
-    UNTIL
-    0 0x08 RAM+ !
-;

blk/269

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

blk/353

@@ -1,13 +1,14 @@
-: RAM+ [ RAMSTART LITN ] + ;
-: BIN+ [ BIN( @ LITN ] + ;
+: RAM+ [ RAMSTART LITN ] + ; : BIN+ [ BIN( @ LITN ] + ;
 : HERE 0x04 RAM+ ;
-: CURRENT* 0x51 RAM+ ;
-: CURRENT CURRENT* @ ;
+: CURRENT* 0x51 RAM+ ; : CURRENT CURRENT* @ ;
 : H@ HERE @ ;
 : FIND ( w -- a f ) CURRENT @ SWAP _find ;
+: IN> 0x30 RAM+ ; ( current position in INBUF )
+: IN( 0x32 RAM+ @ ; ( points to INBUF )
+: IN) 0x40 ( buffer size ) IN( + ; ( INBUF's end )
+: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer )
 : QUIT
-    (resRS)
-    0 0x08 RAM+ !  ( 08 == C<* override )
+    (resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
     LIT< (main) FIND DROP EXECUTE
 ;
 1 25 LOADR+ ( xcomp core low )

blk/367

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

blk/368

@@ -1,5 +1,7 @@
+: +! TUCK @ + SWAP ! ;
 : [entry] ( w -- )
-    H@ SWAP SCPY  ( h )
+    H@ SWAP
+    BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP
     H@ SWAP - ( sz )
     ( write prev value )
     H@ CURRENT @ - ,

blk/369

@@ -1,11 +1,7 @@
-( 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. )
 : IMMEDIATE
     CURRENT @ 1-
     DUP C@ 128 OR SWAP C! ;
 : IMMED? 1- C@ 0x80 AND ;
-: +! TUCK @ + SWAP ! ;
 : -^ SWAP - ;
 : / /MOD NIP ;
 : MOD /MOD DROP ;

blk/386

@@ -1,11 +0,0 @@
-( current position in INBUF )
-: IN> 0x30 RAM+ ;
-( points to INBUF )
-: IN( 0x32 RAM+ @ ;
-( points to INBUF's end )
-: IN) 0x40 ( buffer size ) IN( + ;
-
-( flush input buffer )
-( set IN> to IN( and set IN> @ to null )
-: (infl) 0 IN( DUP IN> ! ! ;
-

blk/397

@@ -1,6 +1,7 @@
 ( Now we have "as late as possible" stuff )
+: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
 : DO COMPILE 2>R H@ ; IMMEDIATE
-: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
+: LOOP COMPILE (loop) H@ - _bchk , ; IMMEDIATE
 ( LEAVE is implemented in low xcomp )
 : LITN 32 , , ( 32 == NUMBER ) ;
 ( gets its name at the very end. can't comment afterwards )

blk/398

@@ -1,14 +1,13 @@
-: IF                ( -- a | a: br cell addr )
+: IF ( -- a | a: br cell addr )
     COMPILE (?br) H@ 2 ALLOT ( br cell allot )
 ; IMMEDIATE
-: THEN              ( a -- | a: br cell addr )
-    DUP H@ -^ SWAP ( a-H a ) !
+: THEN ( a -- | a: br cell addr )
+    DUP H@ -^ _bchk SWAP ( a-H a ) !
 ; IMMEDIATE
-: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
+: 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 )
+    [COMPILE] THEN
+    H@ 2- ( push a. -2 for allot offset )
 ; IMMEDIATE
 

blk/399

@@ -1,9 +1,9 @@
+: LIT< WORD 34 , BEGIN C@+ DUP C, NOT UNTIL DROP ; IMMEDIATE
 : BEGIN H@ ; IMMEDIATE
-: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
-: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
+: AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE
+: UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE
 : [ INTERPRET ; IMMEDIATE
 : ] R> DROP ;
-: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
 : LITA 36 , , ;
 : COMPILE ' LITA ['] , , ; IMMEDIATE
 : [COMPILE] ' , ; IMMEDIATE