admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files
v4/capsule/compile.v4
+47 -39
View File
@@ -28,10 +28,12 @@
\
\ Constants the loader supplies:
\ STATE word address of the variable: non-zero while compiling
\ (C) word address of eight cells of scratch for this file:
\ (C) word address of ten cells of scratch for this file:
\ (C)+0 (C)+1 (C)+4 the in-liner's word, literal pointer and slot
\ (C)+2 LATEST before a header is made (C)+3 a data word's routine
\ (C)+5 what a loop's end lays after its test
\ (C)+6 (C)+7 a branch and a tag a control word is holding
\ (C)+8 whether a data word's entry was made
\ (CFP) word address of the control-flow stack's pointer
\ CFBASE CFEND word addresses of its first cell and of the cell past its last
@@ -65,15 +67,16 @@ macro ROT push SWAP pop SWAP endmacro
\ ---- compiling one word ------------------------------------------------------
\ ( x n -- x' ) x shifted right n places; the bits that come in at the top
\ are masked off by the caller
: (RSHIFT) if Z -1 + push L: 2/ next L ; Z: drop ;
\ ( w -- op ) the opcode in slot 0 of the instruction word w
: (TOP5) 8/ 8/ 8/ 2/ 2/ 2/ 31 and ;
\ ( xt -- ) copy the in-line word at xt into the definition being built
\ ( xt -- ) copy the in-line word at xt into the definition being built.
\ Each slot is read from the top of the word in (C)+0, which is then moved
\ up five bits for the next.
: (INLINE,)
W: dup a! @ (C) a! ! 1 + (C)+1 a! ! \ the word, and its literals after it
0 (C)+4 a! ! \ slot
S: (C)+4 a! @ (LOWBIT) (C) a! @ SWAP (RSHIFT) 31 and \ op
S: (C) a! @ dup 2* 2* 2* 2* 2* ! (TOP5) \ op
if END \ ; ends the copy
dup -8 + if LIT
drop dup -28 + if NOP \ nop is padding
@@ -86,7 +89,7 @@ macro ROT push SWAP pop SWAP endmacro
\ ( xt -- ) compile the word at xt: in line if it is flagged so, else a call
: (COMPILE,)
dup (FLAGS) a! @ 8 and if CALL drop jump (INLINE,)
dup -3 + a! @ 8 and if CALL drop jump (INLINE,)
CALL: drop jump (CALL,)
header EXECUTE
@@ -130,7 +133,7 @@ header INTERPRET
: INTERPRET
L: 32 WORD dup C@ if EOL
drop (LOOKUP) if NUM
dup (FLAGS) a! @ \ xt flags
dup -3 + a! @ \ xt flags
STATE a! @ if INTERP
drop 1 and if COMP \ compiling: immediate words still run
drop EXECUTE jump L
@@ -163,18 +166,13 @@ header ' immediate
\ ---- colon definitions -----------------------------------------------------------
\ ( -- flag ) an entry for the next word in the input stream; -1 if one was
\ made. (C)+2 holds LATEST meanwhile, to tell.
: (NAMED)
LATEST (C)+2 a! !
32 WORD (HEADER)
LATEST (C)+2 a! @ xor if NONE drop -1 ;
NONE: ;
\ FORTH-79: start a definition; it cannot be found until ; ends it
\ FORTH-79: start a definition; it cannot be found until ; ends it.
\ (C)+2 holds LATEST while the entry is made, to tell whether one was.
header :
: COLON
(NAMED) if NONE drop
LATEST (C)+2 a! !
32 WORD (HEADER)
LATEST (C)+2 a! @ xor if NONE drop
HIDDEN (CG-RESET) CFBASE (CFP) a! ! jump RIGHT-BRACKET
NONE: drop ;
@@ -212,29 +210,33 @@ header [COMPILE] immediate compile-only
: (DOVAR) pop ; \ leave the parameter field address
: (DOCON) pop a! @ ; \ leave what it holds
\ ( -- flag ) an entry for the next word, flagged data, its code a call to
\ the routine whose address is in (C)+3; -1 if one was made
\ ( -- ) an entry for the next word, flagged data, its code a call to the
\ routine whose address is in (C)+3. (C)+8 is left -1 if one was made, else
\ 0. It ends by jumping, and CREATE jumps to it, so that a defining word
\ has as few return entries under it as can be.
: (DATA)
LATEST (C)+2 a! ! \ (NAMED), in line: the calls
32 WORD (HEADER) \ below this are deep enough
0 (C)+8 a! !
LATEST (C)+2 a! !
32 WORD (HEADER)
LATEST (C)+2 a! @ xor if NONE drop
(CG-RESET)
LATEST (FLAGS) a! @ 4 OR !
(C)+3 a! @ (CALL,) -1 ;
NONE: ;
-1 (C)+8 a! !
(C)+3 a! @ jump (CALL,)
NONE: drop ;
\ FORTH-79: an entry whose word leaves the address of its parameter field
header CREATE
: CREATE &(DOVAR) (C)+3 a! ! (DATA) drop ;
: CREATE &(DOVAR) (C)+3 a! ! jump (DATA)
\ FORTH-79: CREATE and one cell. The standard leaves its first value to the
\ programme; here it is 0.
header VARIABLE
: VARIABLE &(DOVAR) (C)+3 a! ! (DATA) if NONE drop 0 jump , NONE: drop ;
: VARIABLE &(DOVAR) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ;
\ ( n -- ) FORTH-79: an entry whose word leaves n
header CONSTANT
: CONSTANT &(DOCON) (C)+3 a! ! (DATA) if NONE drop jump , NONE: drop drop ;
: CONSTANT &(DOCON) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop jump , NONE: drop drop ;
\ FORTH-79: in : DEFINER CREATE ... DOES> ... ; the words after DOES> become
\ what each word DEFINER makes does, starting with its parameter field address
@@ -257,7 +259,7 @@ header DOES> immediate compile-only
: (PAIR) xor if OK drop pop drop jump (ABANDON) OK: drop ;
\ ( ref -- ) the branch at ref lands here
: (HERE!) (LABEL) SWAP jump (RESOLVE)
: (HERE!) (FLUSH) HERE SWAP jump (RESOLVE)
\ Native if leaves the flag, so both ways out of it drop it (section 2):
\ IF a THEN if L1 drop a jump L2 L1: drop L2:
@@ -315,18 +317,24 @@ header REPEAT immediate compile-only
: (again) drop push push ;
: (3drop) drop drop drop ;
\ lay <less>: ( i' lim -- i' lim s ), the top bit of s set when i' < lim
: (LESS,)
\ The end of a loop. The control-flow stack holds the body's address and 5,
\ or for ?DO its skip, the body and 6; (C)+5 holds the xt of in-line code to
\ lay after the test, or 0. Laid down, in order:
\ <less> ( i' lim -- i' lim s ), the top bit of s set when i' < lim:
\ over over xor -if SAME drop over jump T SAME: drop over over - T:
\ the code in (C)+5, if any
\ -if EXIT drop push push jump BODY EXIT: drop drop drop
\ and for ?DO the landing of its skip: jump PAST SKIP: drop drop drop PAST:
\ It is one word, jumped to by LOOP and +LOOP, so that laying a loop's end
\ takes as few return entries as laying anything else.
: (LOOPS)
&(?do) (INLINE,) 7 (BRANCH>) >CF
&(differ) (INLINE,) 2 (BRANCH>) (C)+6 a! !
CF> (HERE!) &(same) (INLINE,)
(C)+6 a! @ jump (HERE!)
\ The end of a loop, after its increment and test. The control-flow stack
\ holds the body's address and 5, or for ?DO its skip, the body and 6.
\ -if EXIT drop push push jump BODY EXIT: drop drop drop
\ and for ?DO the landing of its skip: jump PAST SKIP: drop drop drop PAST:
: (LOOP-END)
(C)+6 a! @ (HERE!)
(C)+5 a! @ if NOMORE (INLINE,) jump TESTED
NOMORE: drop
TESTED:
CF> (C)+7 a! ! \ the tag
7 (BRANCH>) (C)+6 a! !
&(again) (INLINE,) CF> (JUMP,)
@@ -343,6 +351,6 @@ header DO immediate compile-only
header ?DO immediate compile-only
: ?DO &(?do) (INLINE,) 6 (BRANCH>) >CF 23 (OP,) &(do) (INLINE,) (LABEL) >CF 6 jump >CF
header LOOP immediate compile-only
: LOOP &(inc) (INLINE,) (LESS,) jump (LOOP-END)
: LOOP &(inc) (INLINE,) 0 (C)+5 a! ! jump (LOOPS)
header +LOOP immediate compile-only
: +LOOP &(+inc) (INLINE,) (LESS,) &(a-xor) (INLINE,) jump (LOOP-END)
: +LOOP &(+inc) (INLINE,) &(a-xor) (C)+5 a! ! jump (LOOPS)