feat(v4.0.0): CASE, ['], S", WORDS, FORGET and FENCE
- compile.v4: CASE OF ENDOF ENDCASE, as v3 (they nest; a word out of place is a control structure mismatch); ['] and [LITERAL]. - quit.v4: S" and its run-time word; at the prompt the text is copied to PAD. - capsule/system.v4: WORDS and VLIST; FORGET (FORTH-79), which gives the space back and will not remove a word below FENCE -- the capsule's own words -- where v3's FORGET DUP succeeds. - tests/test_host_quit.c: ten more transcripts of the v3 binary, and nesting, the fence and the listing. 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
c02505db69
commit
e7d686c7a2
+41
-1
@@ -177,6 +177,13 @@ header LITERAL immediate
|
||||
header ' immediate
|
||||
: TICK (') jump LITERAL
|
||||
|
||||
\ ['] xxx the same inside a definition, whatever STATE is; and [LITERAL],
|
||||
\ which v3 has as another name for LITERAL.
|
||||
header ['] immediate compile-only
|
||||
: BRACKET-TICK (') jump (LIT,)
|
||||
header [LITERAL] immediate
|
||||
: BRACKET-LITERAL jump LITERAL
|
||||
|
||||
\ ---- colon definitions -----------------------------------------------------------
|
||||
|
||||
\ FORTH-79: start a definition; it cannot be found until ; ends it.
|
||||
@@ -263,7 +270,7 @@ header DOES> immediate compile-only
|
||||
\ ---- 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
|
||||
\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO, 7 CASE, 8 OF. A closing word that
|
||||
\ finds the wrong number abandons the line.
|
||||
|
||||
\ ( tag wanted -- ) if they differ, abandon the line and leave the control
|
||||
@@ -319,6 +326,39 @@ header REPEAT immediate compile-only
|
||||
CF> 3 (PAIR) CF> (JUMP,) CF> drop
|
||||
(C)+6 a! @ (HERE!) 23 jump (OP,)
|
||||
|
||||
\ CASE: the value being chosen on stays on the stack through the clauses.
|
||||
\ CASE x1 OF a ENDOF x2 OF b ENDOF c ENDCASE
|
||||
\ lays, for each clause,
|
||||
\ over xor if M drop jump N M: drop drop a jump END N:
|
||||
\ and ENDCASE lays the drop that the part after the last ENDOF leaves the
|
||||
\ value for, with END after it. The control-flow stack holds the jumps to
|
||||
\ END, how many there are, and 7; inside a clause, the jump to N and 8.
|
||||
: (of) over xor ;
|
||||
header CASE immediate compile-only
|
||||
: CASE 0 >CF 7 jump >CF
|
||||
header OF immediate compile-only
|
||||
: OF
|
||||
CF> 7 (PAIR)
|
||||
&(of) (INLINE,) 6 (BRANCH>) (C)+6 a! ! \ if M
|
||||
23 (OP,) 2 (BRANCH>) >CF \ drop, jump N
|
||||
(C)+6 a! @ (HERE!) 23 (OP,) 23 (OP,) \ M: drop drop
|
||||
8 jump >CF
|
||||
header ENDOF immediate compile-only
|
||||
: ENDOF
|
||||
CF> 8 (PAIR) CF> (C)+6 a! ! \ the jump to N
|
||||
CF> (C)+7 a! ! \ how many jumps to END so far
|
||||
2 (BRANCH>) >CF \ one more
|
||||
(C)+7 a! @ 1 + >CF
|
||||
(C)+6 a! @ (HERE!) \ N:
|
||||
7 jump >CF
|
||||
header ENDCASE immediate compile-only
|
||||
: ENDCASE
|
||||
CF> 7 (PAIR) CF> (C)+7 a! !
|
||||
23 (OP,)
|
||||
L: (C)+7 a! @ if DONE -1 + !
|
||||
CF> (HERE!) jump L
|
||||
DONE: drop ;
|
||||
|
||||
\ DO loops: the limit and index are on the return stack, limit below (5.18).
|
||||
: (do) over push push drop ;
|
||||
: (?do) over over xor ;
|
||||
|
||||
+1
-1
@@ -14,7 +14,7 @@
|
||||
\ 1 Negative count 2 Not a number 3 Number too long
|
||||
\ 4 Not a character 5 Dictionary full 6 Name missing
|
||||
\ 7 Control structure mismatch 8 Control structures too deep
|
||||
\ 9 Shift count out of range
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
@@ -96,6 +96,7 @@ header ABORT
|
||||
-if POS drop 2 jump (REPL)
|
||||
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
||||
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
||||
-1 + if M10
|
||||
drop 2 jump (REPL)
|
||||
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL)
|
||||
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL)
|
||||
@@ -106,6 +107,7 @@ header ABORT
|
||||
M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (REPL)
|
||||
M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (REPL)
|
||||
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL)
|
||||
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (REPL)
|
||||
|
||||
\ The table the loader gives the node: six words, one for each kind of
|
||||
\ fault in the node's order, each a jump. A jump fills its word, so they
|
||||
@@ -170,3 +172,20 @@ header ABORT" immediate
|
||||
NOW: drop if NO
|
||||
drop WBUF COUNT TYPE CR jump ABORT
|
||||
NO: drop ;
|
||||
|
||||
\ The run time of S" : leave the address and length of the string after the
|
||||
\ call, and go on after it.
|
||||
: (S")
|
||||
pop 4* dup C@ \ baddr n
|
||||
over over + 4/ 1 + push \ the cell after the last character
|
||||
push 1 + pop ; \ baddr+1 n
|
||||
|
||||
\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled
|
||||
\ into it. At the prompt it is copied to PAD, where it stays until PAD is
|
||||
\ used again: WORD's buffer is overwritten by the very next word of the line.
|
||||
header S" immediate
|
||||
: S-QUOTE
|
||||
34 (PARSE) drop
|
||||
STATE a! @ if NOW
|
||||
drop &(S") (CALL,) jump (STRING,)
|
||||
NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
\ system.v4 -- words about the dictionary as a whole: WORDS, FORGET, FENCE.
|
||||
\
|
||||
\ DECOMPOSITION.md 5.13 and 5.15. Part of the compiler capsule; rests on
|
||||
\ dict.v4, quit.v4 and forth.v4.
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ FENCE word address of the variable: FORGET will not remove an entry
|
||||
\ that starts below the address it holds
|
||||
|
||||
header FENCE inline : FENCE' FENCE ;
|
||||
|
||||
\ ( -- ) the names in the dictionary, the newest first, a blank after
|
||||
\ each, a new line whenever one has passed column 64. Hidden entries -- a
|
||||
\ definition under way -- are not shown. (Q)+0 is the column.
|
||||
header WORDS
|
||||
: WORDS
|
||||
0 (Q) a! !
|
||||
LATEST
|
||||
L: if DONE
|
||||
dup -3 + a! @ 2 and if SHOW drop jump NXT
|
||||
SHOW: drop
|
||||
dup -2 + a! @ 4* COUNT 31 and \ xt baddr u
|
||||
dup (Q) a! @ + 1 + !
|
||||
TYPE SPACE
|
||||
(Q) a! @ -64 + -if WRAP drop jump NXT
|
||||
WRAP: drop CR 0 (Q) a! !
|
||||
NXT: -1 + a! @ jump L
|
||||
DONE: drop jump CR
|
||||
header VLIST
|
||||
: VLIST jump WORDS
|
||||
|
||||
\ FORGET xxx FORTH-79: remove xxx and every word defined after it. The
|
||||
\ space they took is free again. A word that is not there is an error, and
|
||||
\ so is one below FENCE, which is where the capsule's own words are (code
|
||||
\ 10, "Protected word").
|
||||
header FORGET
|
||||
: FORGET
|
||||
32 WORD (LOOKUP) if MISSING
|
||||
dup -2 + a! @ \ xt name
|
||||
dup FENCE a! @ inv + 1 + -if OK \ name - fence
|
||||
drop drop drop NODE-ERROR b! 10 !b ;
|
||||
OK: drop
|
||||
4* DP a! ! \ the space from its name on
|
||||
-1 + a! @ (LATEST) a! ! ; \ and the entry before it is the newest
|
||||
MISSING: drop (UNKNOWN) drop ;
|
||||
Reference in New Issue
Block a user