fix(v4.0.0): shorter chains of calls in the compiler capsule

Measured, compiling a DO loop left one return entry spare under
INTERPRET and a defining word called from inside another word
overflowed the nine-entry return stack (D-2); the prompt loop will take
one more.

C@ and C! shift without a loop.  The code generator shifts each opcode
into the word being built, so nothing is placed by a counted shift, and
the address masks come from a table.  The dictionary search, the
in-liner, the end of a loop and the making of a data word are each one
word reached by a jump.

Every kind of line now leaves at least three return entries spare while
it compiles; a word run from the interpreter has six; and CREATE ...
DOES> works from the prompt, from a word, and from a word that calls
that.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 11:17:58 -04:00
co-authored by Claude Opus 5.5
parent dac7ffac92
commit 806f876ee0
9 changed files with 165 additions and 123 deletions
+32 -29
View File
@@ -19,44 +19,46 @@
\ 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 thirteen cells of scratch for this file
\ (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) and they keep at most three cells of their own on the
\ data stack (D-2):
\ 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 (BRANCH>) is making
\ (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.
\ ( 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 + ;
\ ( 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! ! ;
: (CG-RESET) 0 (CG) a! ! 0 (CG)+1 a! ! 0 (CG)+2 a! ! 28 (CG)+13 a! ! ;
\ ( op -- ) into the next free slot. The slot must be free. The shift is
\ (LSHIFT) in line; the slot's lowest bit is never bit 0, so it shifts at
\ least once.
\ ( x -- ) five bits into the next free slot, which must be free
: (PUT)
(CG)+1 a! @ dup 1 + ! \ op k
(LOWBIT) -1 + push L: 2* next L
(CG) a! @ + ! ;
(CG) a! @ 2* 2* 2* 2* 2* + !
(CG)+1 a! @ 1 + ! ;
\ ( -- ) append the word being built, its unused slots nop, then the
\ ( -- ) 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 28 (PUT) jump P
P: (CG)+1 a! @ -6 + if FULL drop (CG)+13 a! @ (PUT) jump P
FULL: drop
(CG) a! @ ,
(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! @ ,
@@ -85,16 +87,20 @@
\ ( 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. It ends by jumping to (FLUSH), so that the
\ chain of calls under it is one shorter.
\ 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 - -if MOVE drop jump PLACED
(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)
6 (CG)+1 a! ! jump (FLUSH)
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)
@@ -106,9 +112,6 @@
\ ( target ref -- ) put the address into the branch at ref
: (RESOLVE) SWAP (CG)+11 a! ! jump (RESOLVE1)
\ ( op -- ref ) the same, leaving the ref, for (RESOLVE) to fill in later
: (BRANCH>) (BRANCH0) (CG)+10 a! @ ;
\ ( target op -- ) a branch to a known address
: (BRANCH,) SWAP (CG)+11 a! ! (BRANCH0) (CG)+10 a! @ jump (RESOLVE1)