feat(v4): the ROM's slot packer, word for word with asm.c
(OP) (LIT) (BRANCH) (BRANCH>) (RESOLVE) (LABEL), entries 6-11: the code generator of any language built on the machine (MACHINE.md 2.1). asm.c's layout rules with text.c's branch placement; 400 random sequences agree word for word with asm.c at both widths, memory-full and out-of-reach are refused on both sides, and a ref with no branch is refused, not looped on. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
07911dcf91
commit
c233cb6536
@@ -13,3 +13,9 @@
|
||||
jump (FIND) \ 3 ( -- rec | 0 )
|
||||
jump (DEFINE) \ 4 ( value kind -- )
|
||||
jump (OPCODE) \ 5 ( -- op | -1 )
|
||||
jump (OP) \ 6 ( op -- )
|
||||
jump (LIT) \ 7 ( v -- )
|
||||
jump (BRANCH) \ 8 ( op target -- )
|
||||
jump (BRANCH>) \ 9 ( op -- ref )
|
||||
jump (RESOLVE) \ 10 ( ref target -- )
|
||||
jump (LABEL) \ 11 ( -- addr )
|
||||
|
||||
@@ -0,0 +1,140 @@
|
||||
\ pack.f18 -- the ROM's slot packer: how code is laid down.
|
||||
\
|
||||
\ The rules are v4/src/asm.c's, with text.c's branch placement
|
||||
\ (DATASHEET-F18.md section 6):
|
||||
\ - opcodes fill slots 0 .. 5 left to right; a full word is written out and
|
||||
\ a new one begun, unused slots padded with nop
|
||||
\ - a literal is @p in a slot and its value in the word after the
|
||||
\ instruction word, several in the order they were given
|
||||
\ - ; and ex end the word: nothing after them executes
|
||||
\ - a branch ends the word, the bits to its right being its address; it is
|
||||
\ put only in a slot that reaches the whole address space (ADDR-TOP),
|
||||
\ otherwise in a new word; a target it cannot reach is "does not fit"
|
||||
\ This is the code generator of whatever language is built on the machine
|
||||
\ (MACHINE.md 2.1). State, in the ROM's area: (HERE) the next word address,
|
||||
\ (CUR) the word being built, (SLOT) its next slot, (LITS) the (NLIT)
|
||||
\ literals it owes. (PI) (RS) (RN) are working cells. Uses A and B.
|
||||
|
||||
\ ( op -- f ) 1 if op is a branch: jump call next if -if
|
||||
: (BRANCH-OP?)
|
||||
dup -2 + if Y drop dup -3 + if Y drop dup -5 + if Y drop
|
||||
dup -6 + if Y drop dup -7 + if Y drop drop 0 ;
|
||||
Y: drop drop 1 ;
|
||||
|
||||
\ ( s -- m ) the address bits a branch in slot s replaces
|
||||
: (MASK)
|
||||
if S0 -1 + if S1 -1 + if S2 -1 + if S3 -1 + if S4 drop 3 ;
|
||||
S0: drop $7FFFFFF ;
|
||||
S1: drop $3FFFFF ;
|
||||
S2: drop $1FFFF ;
|
||||
S3: drop $FFF ;
|
||||
S4: drop $7F ;
|
||||
|
||||
\ ( w s -- op ) the opcode in slot s of the instruction word w
|
||||
: (SLOT-OP)
|
||||
dup 2* 2* + inv 1 + 27 +
|
||||
S: if SD push 2/ pop -1 + jump S
|
||||
SD: drop 31 and ;
|
||||
|
||||
\ ( op -- ) op into the next slot
|
||||
: (PUT-OP)
|
||||
(SLOT) a! @ dup 2* 2* + inv 1 + 27 +
|
||||
S: if SD push 2* pop -1 + jump S
|
||||
SD: drop (CUR) a! @ xor !
|
||||
(SLOT) a! @ 1 + ! ;
|
||||
|
||||
\ ( v -- ) v at (HERE), which then moves on; past RAM, "does not fit"
|
||||
: (EMIT)
|
||||
(HERE) a! @ dup RAM-WORDS inv 1 + + -if FULL
|
||||
drop b! !b (HERE) a! @ 1 + ! ;
|
||||
FULL: drop drop drop ERR-FIT jump (FAIL)
|
||||
|
||||
\ ( -- ) write out the word being built, padded with nop, then its literals
|
||||
: (FLUSH)
|
||||
(SLOT) a! @ if NONE drop
|
||||
P: (SLOT) a! @ 6 xor if PADDED drop 28 (PUT-OP) jump P
|
||||
PADDED: drop
|
||||
(CUR) a! @ (EMIT)
|
||||
0 (PI) a! !
|
||||
L: (PI) a! @ (NLIT) a! @ xor if LD drop
|
||||
(PI) a! @ (LITS) + a! @ (EMIT)
|
||||
(PI) a! @ 1 + ! jump L
|
||||
LD: drop
|
||||
0 (CUR) a! ! 0 (SLOT) a! ! 0 (NLIT) a! ! ;
|
||||
NONE: drop ;
|
||||
|
||||
\ ( op -- ) an opcode that is neither a branch nor @p
|
||||
: (OP)
|
||||
dup -32 + -if BAD
|
||||
drop dup 8 xor if BAD
|
||||
drop dup (BRANCH-OP?) if GOOD
|
||||
BAD: drop drop ERR-OPCODE jump (FAIL)
|
||||
GOOD: drop
|
||||
dup (PUT-OP)
|
||||
if CLOSE
|
||||
-1 + if CLOSE
|
||||
drop (SLOT) a! @ 6 xor if CLOSE drop ;
|
||||
CLOSE: drop jump (FLUSH)
|
||||
|
||||
\ ( v -- ) @p and its value
|
||||
: (LIT)
|
||||
(NLIT) a! @ (LITS) + b! !b
|
||||
(NLIT) a! @ 1 + !
|
||||
8 (PUT-OP)
|
||||
(SLOT) a! @ 6 xor if FL drop ;
|
||||
FL: drop jump (FLUSH)
|
||||
|
||||
\ ( -- ) text.c's place_branch: begin a new word unless the next slot
|
||||
\ reaches the whole address space
|
||||
: (PLACE)
|
||||
(SLOT) a! @ if NONE
|
||||
dup -4 + -if NEW drop
|
||||
(MASK) ADDR-TOP inv 1 + + -if KEEP drop jump (FLUSH)
|
||||
KEEP: drop ;
|
||||
NEW: drop drop jump (FLUSH)
|
||||
NONE: drop ;
|
||||
|
||||
\ ( -- addr ) end the word being built; the next word address
|
||||
: (LABEL) (FLUSH) (HERE) a! @ ;
|
||||
|
||||
\ ( op -- ref ) a branch whose target comes later: ref is the word it is in
|
||||
: (BRANCH>)
|
||||
dup (BRANCH-OP?) if BAD drop
|
||||
(PLACE)
|
||||
(SLOT) a! @ -4 + -if FL drop jump GO
|
||||
FL: drop (FLUSH)
|
||||
GO: (HERE) a! @ push
|
||||
(PUT-OP)
|
||||
6 (SLOT) a! !
|
||||
(FLUSH) pop ;
|
||||
BAD: drop drop ERR-OPCODE (FAIL) 0 ;
|
||||
|
||||
\ ( ref target -- ) give the branch in the word at ref its target. The
|
||||
\ branch is the first branch opcode in the word; the literals before it are
|
||||
\ what P has passed when it executes. A word with no branch in slots
|
||||
\ 0 .. 3 is not a ref, and is refused.
|
||||
: (RESOLVE)
|
||||
(FAILED) a! @ if GO drop drop drop ;
|
||||
GO: drop
|
||||
0 (RS) a! ! 0 (RN) a! !
|
||||
L: (RS) a! @ -4 + -if BADREF drop
|
||||
over a! @ (RS) a! @ (SLOT-OP)
|
||||
dup (BRANCH-OP?) if NB drop drop jump FOUND
|
||||
NB: drop 8 xor if ISLIT drop jump NXT
|
||||
ISLIT: drop (RN) a! @ 1 + !
|
||||
NXT: (RS) a! @ 1 + ! jump L
|
||||
BADREF: jump (NOB)
|
||||
FOUND:
|
||||
over 1 + (RN) a! @ +
|
||||
over xor (RS) a! @ (MASK) inv and
|
||||
if OKR drop drop drop ERR-FIT jump (FAIL)
|
||||
OKR: drop
|
||||
(RS) a! @ (MASK) and
|
||||
over a! @ (RS) a! @ (MASK) inv and
|
||||
xor over a! ! drop ;
|
||||
|
||||
\ (a word with no branch in slots 0 .. 3 is not a ref: refused)
|
||||
: (NOB) drop drop drop ERR-FIT jump (FAIL)
|
||||
|
||||
\ ( op target -- ) a branch to a known target
|
||||
: (BRANCH) push (BRANCH>) pop jump (RESOLVE)
|
||||
Reference in New Issue
Block a user