Files
LithosAnanake/v4/capsule/codegen.v4
T
rajamesandClaude Opus 5.5 880560fc00 feat(v4.0.0): the code generator
The third layer of the compiler capsule, v4/capsule/codegen.v4: opcodes,
literals and branches packed into instruction words at HERE, by the
rules of sections 1.2 and 2.  (OP,) (LIT,) (LABEL) (BRANCH,) (JUMP,)
(CALL,) (BRANCH>) (RESOLVE) (FLUSH) (CG-RESET).

Tested by laying the same programmes down with the text assembler on
one node and with the code generator, running, on another, and
comparing memory word for word: every opcode, literals and branches in
every slot position, and 600 random programmes.  What it lays down is
then run.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-04 09:19:57 -04:00

105 lines
3.8 KiB
Plaintext

\ 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 nine cells: the word being built, the next
\ free slot, the number of literals it owes, and up to six of them
\ CG-BSLOTS how many slots, counted from slot 0, may hold a branch
macro (CUR) (CG) endmacro
macro (SLOT) (CG) 1 + endmacro
macro (NLIT) (CG) 2 + endmacro
macro (LITS) (CG) 3 + endmacro
\ ( x n -- x' ) x shifted left n places, n >= 0
: (LSHIFT) if Z -1 + push L: 2* next L ; Z: drop ;
\ ( k -- n ) the number of the lowest bit of slot k: 27 - 5k
: (LOWBIT) dup 2* 2* + NEGATE 27 + ;
\ ( k -- mask ) the address bits of a branch in slot k
: (MASK) (LOWBIT) 1 SWAP (LSHIFT) -1 + ;
\ ( -- ) forget the word being built
: (CG-RESET) 0 (CUR) a! ! 0 (SLOT) a! ! 0 (NLIT) a! ! ;
\ ( op -- ) into the next free slot. The slot must be free.
: (PUT)
(SLOT) a! @ dup 1 + ! \ op k
(LOWBIT) (LSHIFT)
(CUR) a! @ + ! ;
\ ( -- ) append the word being built, its unused slots nop, then the
\ literals it owes; nothing if no slot is in use
: (FLUSH)
(SLOT) a! @ if EMPTY drop
P: (SLOT) a! @ -6 + if FULL drop 28 (PUT) jump P
FULL: drop
(CUR) a! @ ,
0 L: dup (NLIT) a! @ xor if DONE
drop dup (LITS) + a! @ , 1 + jump L
DONE: drop drop
jump (CG-RESET)
EMPTY: drop ;
\ ( op -- ) any opcode that is neither a branch nor @p
: (OP,)
dup push (PUT) pop
if ENDS -1 + if ENDS \ ; and ex end the word
drop (SLOT) a! @ -6 + if ENDS drop ; \ and so does its last slot
ENDS: drop jump (FLUSH)
\ ( x -- ) @p and its value
: (LIT,)
(NLIT) a! @ dup 1 + ! \ x n
(LITS) + a! !
8 (PUT)
(SLOT) a! @ -6 + if FULL drop ;
FULL: drop jump (FLUSH)
\ ( -- addr ) where the next word will go: a branch target
: (LABEL) (FLUSH) HERE ;
\ ( op -- ref ) a branch (jump 2, call 3, next 5, if 6, -if 7) whose address
\ is filled in later by (RESOLVE). ref is the branch's word address times 8,
\ plus its slot.
: (BRANCH>)
(SLOT) a! @ CG-BSLOTS - -if MOVE drop jump PLACED
MOVE: drop (FLUSH)
PLACED:
\ the word will be appended at HERE; its literals, if any, come after it
HERE 2* 2* 2* (SLOT) a! @ + push
(PUT)
6 (SLOT) a! ! (FLUSH)
pop ;
\ ( target ref -- ) put the address into the branch at ref
: (RESOLVE)
dup 7 and (MASK) push \ target ref R: mask
2/ 2/ 2/ a! \ target A: the branch's word
pop dup push and \ the address bits
@ pop inv and + ! ;
\ ( target op -- ) a branch to a known address
: (BRANCH,) (BRANCH>) jump (RESOLVE)
: (JUMP,) ( addr -- ) 2 jump (BRANCH,)
: (CALL,) ( addr -- ) 3 jump (BRANCH,)