\ codegen.v4 -- the code generator: opcodes, literals and branches packed into
\ instruction words at HERE.
\
\ This is what the compiling words ( : ; IF LOOP LITERAL ... ) are built on.
\ It lays code down exactly as DECOMPOSITION.md 1.2 and 2 require and as the
\ test harness's own packers do (v4/include/v4/asm.h, text.h):
\
\   - opcodes fill slots 0 .. 5 of a word left to right; a full word is
\     appended to the dictionary and a new one started; unused slots are nop
\   - a literal is @p in a slot and its value in the cell after the word;
\     several in one word follow it in order
\   - ; and ex close the word, since nothing after them runs
\   - a branch closes the word: the bits to its right are its address
\   - a branch goes only in a slot whose address field reaches all of the
\     node's memory; otherwise the word is closed first and the branch starts
\     the next one.  So no branch ever needs a reach check.
\
\ An instruction word is 32 bits at every cell width (D-9): slot k is the five
\ bits whose lowest is bit 27 - 5k, and a branch there has 27 - 5k address bits.
\
\ Rests on core.v4 and dict.v4.  Constants the loader supplies:
\   (CG)        word address of fourteen cells of scratch for this file
\   CG-BSLOTS   how many slots, counted from slot 0, may hold a branch

\ Like WORD, these run under whatever the user has on the stacks, so what they
\ work on is in (CG), they keep at most three cells of their own on the data
\ stack, and they call each other as little as they can (D-2):
\   (CG)+0 the word being built     (CG)+1 its next free slot
\   (CG)+2 how many literals it owes, and (CG)+3 .. (CG)+8 the literals
\   (CG)+9 the opcode (OP,) was given          (CG)+10 the ref (BRANCH0) made
\   (CG)+11 the target a branch is to reach    (CG)+12 which literal (FLUSH) is at
\   (CG)+13 what (FLUSH) fills unused slots with: nop, or 0 after a branch
\
\ The word being built is kept right-justified: each opcode is shifted in
\ below the ones before it, and (FLUSH) shifts in what fills the rest and the
\ two spare bits.  So nothing is ever shifted by a counted loop, which would
\ want a return-stack entry for its count.

\ ( k -- mask )   the address bits of a branch in slot k: 2^(27-5k) - 1
: (MASK)
  if K0  -1 + if K1  -1 + if K2
      drop 4095 ;
  K2: drop 131071 ;
  K1: drop 4194303 ;
  K0: drop 134217727 ;

\ ( -- )   forget the word being built
: (CG-RESET)   0 (CG) a! !  0 (CG)+1 a! !  0 (CG)+2 a! !  28 (CG)+13 a! ! ;

\ ( x -- )   five bits into the next free slot, which must be free
: (PUT)
  (CG) a! @  2* 2* 2* 2* 2*  +  !
  (CG)+1 a! @ 1 + ! ;

\ ( -- )   append the word being built, its unused slots filled, then the
\ literals it owes; nothing if no slot is in use
: (FLUSH)
  (CG)+1 a! @ if EMPTY  drop
  P: (CG)+1 a! @ -6 + if FULL  drop  (CG)+13 a! @ (PUT)  jump P
  FULL: drop
  (CG) a! @  2* 2*  ,                        \ the two spare bits
  0 (CG)+12 a! !
  L: (CG)+12 a! @  (CG)+2 a! @  xor if DONE
     drop  (CG)+12 a! @  dup 1 + !  (CG)+3 + a! @ ,
     jump L
  DONE: drop
  jump (CG-RESET)
  EMPTY: drop ;

\ ( op -- )   any opcode that is neither a branch nor @p
: (OP,)
  dup (CG)+9 a! !  (PUT)
  (CG)+9 a! @  if ENDS  -1 + if ENDS         \ ; and ex end the word
  drop  (CG)+1 a! @ -6 + if ENDS  drop ;     \ and so does its last slot
  ENDS: drop  jump (FLUSH)

\ ( x -- )   @p and its value
: (LIT,)
  (CG)+2 a! @  dup 1 + !                     \ x n
  (CG)+3 + a! !
  8 (PUT)
  (CG)+1 a! @ -6 + if FULL  drop ;
  FULL: drop  jump (FLUSH)

\ ( -- addr )   where the next word will go: a branch target
: (LABEL)    (FLUSH) HERE ;

\ ( op -- )   a branch (jump 2, call 3, next 5, if 6, -if 7) whose address is
\ not filled in yet.  Its ref -- the branch's word address times 8, plus its
\ slot -- is left in (CG)+10.  The rest of its word is filled with 0, which
\ is its address field.  It ends by jumping to (FLUSH), so that the chain of
\ calls under it is one shorter.
: (BRANCH0)
  (CG)+1 a! @  CG-BSLOTS inv + 1 +  -if MOVE  drop jump PLACED     \ slot - CG-BSLOTS
  MOVE: drop (FLUSH)
  PLACED:
  \ the word will be appended at HERE; its literals, if any, come after it
  HERE 2* 2* 2*  (CG)+1 a! @ +  (CG)+10 a! !
  (PUT)
  0 (CG)+13 a! !  jump (FLUSH)

\ ( op -- ref )   the same, leaving the ref, for (RESOLVE) to fill in later
: (BRANCH>)   (BRANCH0)  (CG)+10 a! @ ;

\ ( ref -- )   put the address in (CG)+11 into the branch at ref
: (RESOLVE1)
  dup 7 and (MASK) push                      \ ref           R: mask
  2/ 2/ 2/ a!                                \ A: the branch's word
  (CG)+11 b! @b  pop dup push and            \ the address bits
  @  pop inv and  +  ! ;

\ ( target ref -- )   put the address into the branch at ref
: (RESOLVE)   SWAP (CG)+11 a! !  jump (RESOLVE1)

\ ( target op -- )   a branch to a known address
: (BRANCH,)   SWAP (CG)+11 a! !  (BRANCH0)  (CG)+10 a! @  jump (RESOLVE1)

: (JUMP,) ( addr -- )   2 jump (BRANCH,)
: (CALL,) ( addr -- )   3 jump (BRANCH,)