rajamesandClaude Opus 5.5
dac7ffac92
The fourth layer of the compiler capsule. compile.v4: INTERPRET's loop, STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE [COMPILE] ' EXECUTE, CREATE VARIABLE CONSTANT DOES>, and IF ELSE THEN BEGIN UNTIL AGAIN WHILE REPEAT DO ?DO LOOP +LOOP on a control-flow stack in memory. forth.v4: the first words of the vocabulary, the in-line ones. FORTH source now goes in and running code comes out. 49 programmes were run through the v3 binary and through this; every result agrees, bar COMPILE, which v3 cannot run. The code laid down for each control structure is word for word the expansion DECOMPOSITION.md gives. A line may have six values on the stack while it is interpreted, and words called from the interpreter may nest eight deep. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
349 lines
14 KiB
Plaintext
349 lines
14 KiB
Plaintext
\ compile.v4 -- the interpreter's inner loop, and the defining and compiling
|
|
\ words.
|
|
\
|
|
\ DECOMPOSITION.md 5.17 and 5.18: STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE
|
|
\ [COMPILE] ' EXECUTE CREATE VARIABLE CONSTANT DOES>, the control structures
|
|
\ IF ELSE THEN BEGIN UNTIL AGAIN WHILE REPEAT DO ?DO LOOP +LOOP, and INTERPRET,
|
|
\ which they cannot be run without. Part of the compiler capsule. Rests on
|
|
\ core.v4, input.v4, dict.v4 and codegen.v4.
|
|
\
|
|
\ HOW A WORD IS COMPILED. v4 code is native: a colon definition is
|
|
\ instruction words, and compiling a word into one lays down a call to it.
|
|
\ Two flags on an entry (dict.v4) change that:
|
|
\ inline its code is a straight run of opcodes and literals ending
|
|
\ in ; -- that run is copied in place of a call. Everything
|
|
\ that touches the return stack must be, since a call would
|
|
\ bury what it works on (DECOMPOSITION.md 0, fate IN).
|
|
\ compile-only it may not be executed by the interpreter.
|
|
\ An immediate word is executed even when compiling.
|
|
\
|
|
\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and no
|
|
\ way to see how full they are. The interpreter and compiler run on the same
|
|
\ stacks as the user's words, with the user's values beneath them, so:
|
|
\ - every word here keeps what it works on in (C), and has at most three
|
|
\ cells of its own on the data stack at any moment;
|
|
\ - what an IF or a DO leaves for its THEN or LOOP goes on a control-flow
|
|
\ stack in memory, not on the data stack, so structures may nest as
|
|
\ deep as that stack (32 cells) allows whatever the user has stacked.
|
|
\
|
|
\ 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)+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)+6 (C)+7 a branch and a tag a control word is holding
|
|
\ (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
|
|
|
|
macro ROT push SWAP pop SWAP endmacro
|
|
|
|
\ ---- errors ------------------------------------------------------------------
|
|
|
|
\ ( -- ) give up the line: stop compiling, forget the word being built and
|
|
\ whatever control structures were open, skip the rest of the input, and set
|
|
\ NODE-ERROR. A definition that was under way stays hidden. (QUIT will add
|
|
\ the message and the stack reset.)
|
|
: (ABANDON)
|
|
0 STATE a! ! (CG-RESET)
|
|
CFBASE (CFP) a! !
|
|
SPAN a! @ >IN a! !
|
|
NODE-ERROR b! -1 !b ;
|
|
|
|
\ ---- the control-flow stack ----------------------------------------------------
|
|
|
|
\ ( x -- ) push; a full stack abandons the line
|
|
: >CF
|
|
(CFP) a! @ CFEND xor if FULL
|
|
drop (CFP) a! @ dup 1 + ! a! ! ;
|
|
FULL: drop drop jump (ABANDON)
|
|
|
|
\ ( -- x ) pop; 0 from an empty stack, which no opening word leaves
|
|
: CF>
|
|
(CFP) a! @ CFBASE xor if EMPTY
|
|
drop (CFP) a! @ -1 + dup ! a! @ ;
|
|
EMPTY: ;
|
|
|
|
\ ---- 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 ;
|
|
|
|
\ ( xt -- ) copy the in-line word at xt into the definition being built
|
|
: (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
|
|
if END \ ; ends the copy
|
|
dup -8 + if LIT
|
|
drop dup -28 + if NOP \ nop is padding
|
|
drop (OP,)
|
|
NXT: (C)+4 a! @ 1 + dup ! -6 + if NEXTW drop jump S
|
|
NEXTW: drop (C)+1 a! @ jump W \ the next instruction word follows the literals
|
|
LIT: drop drop (C)+1 a! @ dup 1 + ! a! @ (LIT,) jump NXT
|
|
NOP: drop drop jump NXT
|
|
END: drop ;
|
|
|
|
\ ( 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,)
|
|
CALL: drop jump (CALL,)
|
|
|
|
header EXECUTE
|
|
: EXECUTE ( xt -- ) push ;
|
|
|
|
\ ---- the interpreter's inner loop ---------------------------------------------
|
|
|
|
\ ( -- n flag ) the word WORD has just left, as a single-cell number in the
|
|
\ current BASE, and -1; or 0 0 if it is not one. A leading minus sign is
|
|
\ allowed. This is what the interpreter uses: NUMBER (input.v4) makes a
|
|
\ double and needs more of the stack than can be spared here.
|
|
\ (P)+2 the number so far, (P)+3 where it is in the word, (P)+4 the word's
|
|
\ length, (P)+5 the sign, (P)+6 the base.
|
|
: (NUM?)
|
|
WBUF C@ if EMPTY
|
|
(P)+4 a! ! 0 (P)+2 a! ! 1 (P)+3 a! ! 0 (P)+5 a! !
|
|
(BASE) (P)+6 a! !
|
|
WBUF+1 C@ -45 + if NEG drop jump DIGITS
|
|
NEG: drop -1 (P)+5 a! ! 2 (P)+3 a! !
|
|
(P)+4 a! @ -1 + if EMPTY drop \ a sign alone
|
|
DIGITS:
|
|
L: (P)+4 a! @ (P)+3 a! @ - -if MORE
|
|
drop (P)+2 a! @ (P)+5 a! @ if POS drop NEGATE -1 ;
|
|
POS: drop -1 ;
|
|
MORE: drop
|
|
(P)+3 a! @ dup 1 + ! WBUF + C@ (DIGIT) \ d
|
|
-if DIGIT jump BAD1
|
|
DIGIT: dup (P)+6 a! @ - -if BAD2 drop
|
|
(P)+2 a! @ (P)+6 a! @ STAR + (P)+2 a! !
|
|
jump L
|
|
BAD2: drop
|
|
BAD1: drop 0 0 ;
|
|
EMPTY: drop 0 0 ;
|
|
|
|
\ ( -- ) FORTH-79: take words from the input stream until it is exhausted.
|
|
\ A word in the dictionary is executed, or, when compiling and not immediate,
|
|
\ compiled. Anything else must be a number in the current BASE: it is left
|
|
\ on the stack, or compiled as a literal. What is neither, or a compile-only
|
|
\ word met while interpreting, abandons the line.
|
|
header INTERPRET
|
|
: INTERPRET
|
|
L: 32 WORD dup C@ if EOL
|
|
drop (LOOKUP) if NUM
|
|
dup (FLAGS) a! @ \ xt flags
|
|
STATE a! @ if INTERP
|
|
drop 1 and if COMP \ compiling: immediate words still run
|
|
drop EXECUTE jump L
|
|
COMP: drop (COMPILE,) jump L
|
|
INTERP: drop 16 and if RUN
|
|
drop drop jump (ABANDON)
|
|
RUN: drop EXECUTE jump L
|
|
NUM: drop (NUM?) if BAD
|
|
drop
|
|
STATE a! @ if KEEP drop (LIT,) jump L
|
|
KEEP: drop jump L
|
|
BAD: drop drop jump (ABANDON)
|
|
EOL: drop drop ;
|
|
|
|
\ ---- state ---------------------------------------------------------------------
|
|
|
|
header [ immediate
|
|
: LEFT-BRACKET 0 STATE a! ! ;
|
|
header ]
|
|
: RIGHT-BRACKET -1 STATE a! ! ;
|
|
|
|
\ ( x -- ) FORTH-79: if compiling, compile x as a literal
|
|
header LITERAL immediate
|
|
: LITERAL STATE a! @ if NO drop jump (LIT,) NO: drop ;
|
|
|
|
\ ( -- addr ) FORTH-79: the next word's parameter field address; if
|
|
\ compiling, compiled as a literal
|
|
header ' immediate
|
|
: TICK (') jump LITERAL
|
|
|
|
\ ---- 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
|
|
header :
|
|
: COLON
|
|
(NAMED) if NONE drop
|
|
HIDDEN (CG-RESET) CFBASE (CFP) a! ! jump RIGHT-BRACKET
|
|
NONE: drop ;
|
|
|
|
\ FORTH-79: compile the return, let the word be found, stop compiling
|
|
header ; immediate compile-only
|
|
: SEMICOLON
|
|
0 (OP,)
|
|
LATEST (FLAGS) a! @ -3 and !
|
|
jump LEFT-BRACKET
|
|
|
|
\ FORTH-79: return from the definition at this point
|
|
header EXIT immediate compile-only
|
|
: EXIT 0 jump (OP,)
|
|
|
|
header IMMEDIATE
|
|
: IMMEDIATE LATEST if NONE (FLAGS) a! @ 1 OR ! ; NONE: drop ;
|
|
|
|
\ COMPILE xxx FORTH-79: when the word this is in runs, xxx is compiled
|
|
header COMPILE immediate compile-only
|
|
: COMPILE
|
|
32 WORD (LOOKUP) if MISSING
|
|
(LIT,) &(COMPILE,) jump (CALL,)
|
|
MISSING: drop jump (ABANDON)
|
|
|
|
\ [COMPILE] xxx FORTH-79: compile xxx even though it is immediate
|
|
header [COMPILE] immediate compile-only
|
|
: BRACKET-COMPILE
|
|
32 WORD (LOOKUP) if MISSING jump (COMPILE,)
|
|
MISSING: drop jump (ABANDON)
|
|
|
|
\ ---- data words ---------------------------------------------------------------------
|
|
\ A data word's code is one call to its run-time routine; the call leaves the
|
|
\ address of the cell after it -- the parameter field -- on the return stack.
|
|
|
|
: (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
|
|
: (DATA)
|
|
LATEST (C)+2 a! ! \ (NAMED), in line: the calls
|
|
32 WORD (HEADER) \ below this are deep enough
|
|
LATEST (C)+2 a! @ xor if NONE drop
|
|
(CG-RESET)
|
|
LATEST (FLAGS) a! @ 4 OR !
|
|
(C)+3 a! @ (CALL,) -1 ;
|
|
NONE: ;
|
|
|
|
\ FORTH-79: an entry whose word leaves the address of its parameter field
|
|
header CREATE
|
|
: CREATE &(DOVAR) (C)+3 a! ! (DATA) drop ;
|
|
|
|
\ 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 ;
|
|
|
|
\ ( n -- ) FORTH-79: an entry whose word leaves n
|
|
header CONSTANT
|
|
: CONSTANT &(DOCON) (C)+3 a! ! (DATA) 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
|
|
\ on the stack. (DOES), run by DEFINER, turns the newest entry's code into a
|
|
\ call to the code after it and leaves DEFINER; that code starts with pop,
|
|
\ which fetches the parameter field address the call left.
|
|
: (DOES) pop 402653184 + LATEST a! ! ; \ 402653184 is `call` in slot 0
|
|
header DOES> immediate compile-only
|
|
: DOES> &(DOES) (CALL,) 25 jump (OP,)
|
|
|
|
\ ---- control structures (5.18, section 2) ---------------------------------------------
|
|
\ All immediate and compile-only. Each puts what the word that closes it
|
|
\ needs on the control-flow stack, with a number on top saying which word put
|
|
\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO. A closing word that
|
|
\ finds the wrong number abandons the line.
|
|
|
|
\ ( tag wanted -- ) if they differ, abandon the line and leave the control
|
|
\ word that called this as well: its return address is dropped, so the
|
|
\ abandoning returns to the interpreter and nothing more is laid down.
|
|
: (PAIR) xor if OK drop pop drop jump (ABANDON) OK: drop ;
|
|
|
|
\ ( ref -- ) the branch at ref lands here
|
|
: (HERE!) (LABEL) 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:
|
|
\ IF a ELSE b THEN if L1 drop a jump L2 L1: drop b L2:
|
|
header IF immediate compile-only
|
|
: IF 6 (BRANCH>) >CF 23 (OP,) 1 jump >CF
|
|
header ELSE immediate compile-only
|
|
: ELSE
|
|
CF> 1 (PAIR) CF> (C)+6 a! ! \ the if
|
|
2 (BRANCH>) >CF \ the jump over the else part
|
|
(C)+6 a! @ (HERE!) 23 (OP,)
|
|
2 jump >CF
|
|
header THEN immediate compile-only
|
|
: THEN
|
|
CF> dup -1 + if PLAIN
|
|
drop 2 (PAIR) CF> jump (HERE!)
|
|
PLAIN: drop drop
|
|
CF> (C)+6 a! ! \ the if
|
|
2 (BRANCH>) >CF
|
|
(C)+6 a! @ (HERE!) 23 (OP,)
|
|
CF> jump (HERE!)
|
|
|
|
\ A loop that tests at its end jumps back with the flag still there, so it
|
|
\ jumps back to a drop laid just ahead of the body:
|
|
\ BEGIN a UNTIL jump L0 Ld: drop L0: a if Ld drop
|
|
\ BEGIN a WHILE b REPEAT jump L0 Ld: drop L0: a if Lx drop b jump L0 Lx: drop
|
|
\ BEGIN a AGAIN jump L0 Ld: drop L0: a jump L0
|
|
\ The control-flow stack holds Ld, L0 and 3.
|
|
header BEGIN immediate compile-only
|
|
: BEGIN
|
|
2 (BRANCH>) (C)+6 a! !
|
|
(LABEL) >CF 23 (OP,)
|
|
(LABEL) dup >CF (C)+6 a! @ (RESOLVE)
|
|
3 jump >CF
|
|
header UNTIL immediate compile-only
|
|
: UNTIL CF> 3 (PAIR) CF> drop CF> 6 (BRANCH,) 23 jump (OP,)
|
|
header AGAIN immediate compile-only
|
|
: AGAIN CF> 3 (PAIR) CF> (JUMP,) CF> drop ;
|
|
header WHILE immediate compile-only
|
|
: WHILE CF> 3 (PAIR) 3 >CF 6 (BRANCH>) >CF 23 (OP,) 4 jump >CF
|
|
header REPEAT immediate compile-only
|
|
: REPEAT
|
|
CF> 4 (PAIR) CF> (C)+6 a! ! \ the while
|
|
CF> 3 (PAIR) CF> (JUMP,) CF> drop
|
|
(C)+6 a! @ (HERE!) 23 jump (OP,)
|
|
|
|
\ DO loops: the limit and index are on the return stack, limit below (5.18).
|
|
: (do) over push push drop ;
|
|
: (?do) over over xor ;
|
|
: (inc) pop 1 + pop ; \ index' limit
|
|
: (+inc) dup a! pop + pop ; \ index' limit A: the step
|
|
: (differ) drop over ;
|
|
: (same) drop over over - ;
|
|
: (a-xor) a xor ;
|
|
: (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,)
|
|
&(?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)
|
|
CF> (C)+7 a! ! \ the tag
|
|
7 (BRANCH>) (C)+6 a! !
|
|
&(again) (INLINE,) CF> (JUMP,)
|
|
(C)+6 a! @ (HERE!) &(3drop) (INLINE,)
|
|
(C)+7 a! @ -5 + if PLAIN
|
|
drop (C)+7 a! @ 6 (PAIR)
|
|
2 (BRANCH>) (C)+6 a! !
|
|
CF> (HERE!) &(3drop) (INLINE,)
|
|
(C)+6 a! @ jump (HERE!)
|
|
PLAIN: drop ;
|
|
|
|
header DO immediate compile-only
|
|
: DO &(do) (INLINE,) (LABEL) >CF 5 jump >CF
|
|
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)
|
|
header +LOOP immediate compile-only
|
|
: +LOOP &(+inc) (INLINE,) (LESS,) &(a-xor) (INLINE,) jump (LOOP-END)
|