feat(v4.0.0): vocabularies, to FORTH-79
- VOCABULARY DEFINITIONS CONTEXT CURRENT FORTH, and v3's ORDER. A name is looked up in the CONTEXT vocabulary and then in FORTH; a new entry goes into the CURRENT vocabulary; : makes the CURRENT vocabulary CONTEXT; FORTH is immediate. - WORDS lists the CONTEXT vocabulary. FORGET takes what was defined later out of every vocabulary, and a vocabulary that goes gives way to FORTH. - v3's vocabularies separate nothing: a word defined in one is found from every other, and one redefined in a vocabulary replaces FORTH's for good. - tests/test_host_quit.c: isolation, chaining to FORTH, two vocabularies with the same names, FORGET across them; and DUMP is now checked to put BASE back. 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
ab272cc2ad
commit
0fbe1432b7
@@ -714,7 +714,8 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
|
||||
| Word | Fate |
|
||||
| --- | --- |
|
||||
| `VOCABULARY` `DEFINITIONS` `CONTEXT` `CURRENT` `FORTH` `ORDER` `(FIND)` | CC |
|
||||
| `VOCABULARY` `DEFINITIONS` `CONTEXT` `CURRENT` `FORTH` `ORDER` | CC | FORTH-79 (`ORDER` is v3's). Source in `v4/capsule/system.v4`, `dict.v4` and `compile.v4`. A vocabulary is two cells — its head, the xt of its newest entry, and the address of the vocabulary defined before it. `CONTEXT` and `CURRENT` each hold the address of a vocabulary's head cell; FORTH's is `(LATEST)`. A name is looked up in the `CONTEXT` vocabulary and then, if that is not FORTH, in FORTH ("new vocabularies chain to FORTH"). A new entry goes into the `CURRENT` vocabulary, and `:` makes the `CURRENT` vocabulary `CONTEXT`. `VOCABULARY xxx` makes an empty one whose name, executed, makes it `CONTEXT`; `FORTH` does the same for FORTH and is immediate; `DEFINITIONS` makes the `CONTEXT` vocabulary `CURRENT`. `WORDS` lists the `CONTEXT` vocabulary. `FORGET` takes what was defined later out of every vocabulary, and a vocabulary that goes with it gives way to FORTH. `ORDER` prints `Search order:` and `Current:` by name. v3's vocabularies do not separate anything: a word defined in one is found from every other, and a word redefined in one replaces FORTH's permanently; its `FORTH` is not immediate. Executed on the golden model's host node (2026-10-05). |
|
||||
| `(FIND)` | CC | |
|
||||
|
||||
### 5.15 System
|
||||
|
||||
@@ -758,7 +759,7 @@ call would bury what it works on. A **compile-only** word may not be executed by
|
||||
`v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`,
|
||||
`LEAVE`, `@`, the in-line variables and so on).
|
||||
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`), `system.v4` (`WORDS`, `FORGET`), `qmath.v4` (the Q48.16 words of §5.26: `Q.FROM-INT Q.TO-INT Q.1 Q.0 Q.SCALE Q.+ Q.- Q.* Q./ Q.ABS Q.NEG Q.= Q.< Q.> Q.0= Q.MAX Q.MIN Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS Q.PRINT`; `DUMP` is in `numout.v4`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. From the prompt, 122 results of the Q words printed by `Q.PRINT` — which shows all sixteen bits of a fraction — are digit for digit v3's, at both cell widths. Under D-18, `Q./` by zero and `Q.SQRT` and `Q.LOG` outside their domain leave the result D-11 and D-12 give and then raise an error (codes 11 `Division by zero` and 12 `Argument out of range`); v3 returns 0 and says nothing. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`), `system.v4` (vocabularies, `WORDS`, `FORGET`), `qmath.v4` (the Q48.16 words of §5.26: `Q.FROM-INT Q.TO-INT Q.1 Q.0 Q.SCALE Q.+ Q.- Q.* Q./ Q.ABS Q.NEG Q.= Q.< Q.> Q.0= Q.MAX Q.MIN Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS Q.PRINT`; `DUMP` is in `numout.v4`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. From the prompt, 122 results of the Q words printed by `Q.PRINT` — which shows all sixteen bits of a fraction — are digit for digit v3's, at both cell widths. Under D-18, `Q./` by zero and `Q.SQRT` and `Q.LOG` outside their domain leave the result D-11 and D-12 give and then raise an error (codes 11 `Division by zero` and 12 `Argument out of range`); v3 returns 0 and says nothing. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
|
||||
**The stacks and the compiler.** The interpreter and compiler run on the same stacks as the user's
|
||||
words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine
|
||||
|
||||
@@ -186,10 +186,12 @@ header [LITERAL] immediate
|
||||
|
||||
\ ---- colon definitions -----------------------------------------------------------
|
||||
|
||||
\ FORTH-79: start a definition; it cannot be found until ; ends it.
|
||||
\ FORTH-79: start a definition; it cannot be found until ; ends it. The
|
||||
\ CONTEXT vocabulary is set to the CURRENT one.
|
||||
\ (C)+2 holds LATEST while the entry is made, to tell whether one was.
|
||||
header :
|
||||
: COLON
|
||||
CURRENT a! @ CONTEXT a! !
|
||||
LATEST (C)+2 a! !
|
||||
32 WORD (HEADER)
|
||||
LATEST (C)+2 a! @ xor if NONE drop
|
||||
|
||||
+19
-6
@@ -26,7 +26,15 @@
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ DP word address of the variable: the next free byte
|
||||
\ (LATEST) word address of the variable: the xt of the newest entry, or 0
|
||||
\ (LATEST) word address of the variable: the xt of the newest entry of the
|
||||
\ FORTH vocabulary, or 0
|
||||
\ CONTEXT CURRENT word addresses of the variables: each holds the address
|
||||
\ of a vocabulary's head cell -- the cell that holds the xt of
|
||||
\ that vocabulary's newest entry. FORTH's head cell is (LATEST).
|
||||
\
|
||||
\ VOCABULARIES (FORTH-79). A name is looked up in the CONTEXT vocabulary and
|
||||
\ then, if that is not FORTH, in FORTH. A new entry goes into the CURRENT
|
||||
\ vocabulary: it is linked to that vocabulary's newest entry and becomes it.
|
||||
\ DBASE DLIMIT byte addresses of the start and end of dictionary space
|
||||
\ PAD byte address of the scratch area for strings, 84 bytes or more
|
||||
\ (D) word address of five cells of scratch for this file
|
||||
@@ -78,7 +86,7 @@ header 2,
|
||||
: 2, ( lo hi -- ) SWAP , , ; \ the low cell first, as v3
|
||||
|
||||
header LATEST
|
||||
: LATEST ( -- xt ) (LATEST) a! @ ;
|
||||
: LATEST ( -- xt ) CURRENT a! @ a! @ ; \ the newest entry of the CURRENT vocabulary
|
||||
|
||||
\ ---- the fields of an entry (5.13) -----------------------------------------
|
||||
|
||||
@@ -118,7 +126,7 @@ header HIDDEN
|
||||
\ ---- making an entry -------------------------------------------------------
|
||||
\ (D)+0 where the name starts (D)+1 the name being looked up
|
||||
\ (D)+2 the name being copied, or the entry being looked at
|
||||
\ (D)+3 a count
|
||||
\ (D)+3 a count (D)+4 whether a lookup has gone on to FORTH
|
||||
|
||||
\ ( -- bytes ) what an entry for a name of (D)+3 characters takes: its name
|
||||
\ cells and three more
|
||||
@@ -146,7 +154,7 @@ header HIDDEN
|
||||
P: DP b! @b 3 and if ALIGNED drop 0 C, jump P
|
||||
ALIGNED: drop
|
||||
0 , (D) a! @ , LATEST ,
|
||||
HERE (LATEST) a! ! ;
|
||||
HERE CURRENT a! @ a! ! ;
|
||||
FULL: drop ; \ (DP+) has set NODE-ERROR
|
||||
EMPTY: drop NODE-ERROR b! 6 !b ; \ name missing
|
||||
|
||||
@@ -162,7 +170,8 @@ header HIDDEN
|
||||
C@ -32 + -if LONG drop jump CUT
|
||||
LONG: drop 31 (D)+1 a! @ C!
|
||||
CUT:
|
||||
LATEST
|
||||
0 (D)+4 a! ! \ not yet on to FORTH
|
||||
CONTEXT a! @ a! @
|
||||
L: if END
|
||||
(D)+2 a! !
|
||||
(D)+2 a! @ -3 + a! @ 2 and if VISIBLE drop jump OLDER
|
||||
@@ -176,7 +185,11 @@ header HIDDEN
|
||||
EQ: drop jump C
|
||||
SAME: drop (D)+2 a! @ ;
|
||||
OLDER: (D)+2 a! @ -1 + a! @ jump L
|
||||
END: ;
|
||||
END: (D)+4 a! @ if FIRST drop ; \ FORTH has been searched: not found
|
||||
FIRST: drop -1 (D)+4 a! !
|
||||
CONTEXT a! @ (LATEST) xor if ISFORTH \ CONTEXT is FORTH: that was it
|
||||
drop drop (LATEST) a! @ jump L
|
||||
ISFORTH: drop ;
|
||||
|
||||
\ ( -- xt | 0 ) FORTH-79: the compilation address of the next word in the
|
||||
\ input stream, or 0 if it is not in the dictionary.
|
||||
|
||||
+71
-10
@@ -6,16 +6,57 @@
|
||||
\ Constants the loader supplies:
|
||||
\ FENCE word address of the variable: FORGET will not remove an entry
|
||||
\ that starts below the address it holds
|
||||
\ VOC-LINK word address of the variable: the newest vocabulary, or 0
|
||||
|
||||
header FENCE inline : FENCE' FENCE ;
|
||||
|
||||
\ ( -- ) the names in the dictionary, the newest first, a blank after
|
||||
\ ---- vocabularies (FORTH-79) ----------------------------------------------------
|
||||
\ A vocabulary is two cells: its head -- the xt of its newest entry, or 0 --
|
||||
\ and the address of the vocabulary defined before it, or 0. VOC-LINK holds
|
||||
\ the newest one's address. FORTH's head is (LATEST) and it is in no chain.
|
||||
header CONTEXT inline : CONTEXT' CONTEXT ;
|
||||
header CURRENT inline : CURRENT' CURRENT ;
|
||||
|
||||
\ FORTH-79: the primary vocabulary; it becomes the CONTEXT vocabulary.
|
||||
header FORTH immediate
|
||||
: FORTH (LATEST) CONTEXT a! ! ;
|
||||
\ FORTH-79: new definitions go into the CONTEXT vocabulary from now on.
|
||||
header DEFINITIONS
|
||||
: DEFINITIONS CONTEXT a! @ CURRENT a! ! ;
|
||||
|
||||
\ VOCABULARY xxx FORTH-79: xxx is a new, empty list of words; executing
|
||||
\ xxx makes it the CONTEXT vocabulary. When a search of it finds nothing,
|
||||
\ FORTH is searched.
|
||||
: (DOVOC) pop CONTEXT a! ! ;
|
||||
header VOCABULARY
|
||||
: VOCABULARY
|
||||
&(DOVOC) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop
|
||||
0 , VOC-LINK a! @ , HERE -2 + VOC-LINK a! ! ;
|
||||
NONE: drop ;
|
||||
|
||||
\ ( cell -- ) print the name of the vocabulary whose head cell this is
|
||||
: (.VOC)
|
||||
dup (LATEST) xor if F drop -1 + -2 + a! @ 4* COUNT 31 and jump TYPE
|
||||
F: drop drop $54524F46 (EMIT4) $48 (EMIT4) ;
|
||||
|
||||
\ ( -- ) as v3's, but true: where names are looked for, and where new ones go
|
||||
header ORDER
|
||||
: ORDER
|
||||
$72616553 (EMIT4) $6F206863 (EMIT4) $72656472 (EMIT4) $203A (EMIT4)
|
||||
CONTEXT a! @ dup (.VOC) SPACE
|
||||
(LATEST) xor if ONLY drop (LATEST) (.VOC) jump TWO
|
||||
ONLY: drop
|
||||
TWO: CR
|
||||
$72727543 (EMIT4) $3A746E65 (EMIT4) $20 (EMIT4)
|
||||
CURRENT a! @ (.VOC) jump CR
|
||||
|
||||
\ ( -- ) the names in the CONTEXT vocabulary, 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
|
||||
CONTEXT a! @ a! @
|
||||
L: if DONE
|
||||
dup -3 + a! @ 2 and if SHOW drop jump NXT
|
||||
SHOW: drop
|
||||
@@ -29,17 +70,37 @@ header WORDS
|
||||
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").
|
||||
\ ( cell -- ) take off a vocabulary's list every entry at or above the
|
||||
\ address in (Q)+0. The newest are first, so it stops at the first one below.
|
||||
: (PRUNE)
|
||||
(Q)+1 a! !
|
||||
L: (Q)+1 a! @ a! @ if DONE
|
||||
dup (Q) a! @ inv + 1 + -if CUT drop drop ;
|
||||
CUT: drop -1 + a! @ (Q)+1 a! @ a! ! jump L
|
||||
DONE: drop ;
|
||||
|
||||
\ FORGET xxx FORTH-79: remove xxx and every word defined after it, in
|
||||
\ whatever vocabulary; the space they took is free again. A vocabulary that
|
||||
\ goes is no longer CONTEXT or CURRENT: FORTH is. 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
|
||||
-2 + a! @ \ where its name starts
|
||||
dup FENCE a! @ inv + 1 + -if OK \ name - fence
|
||||
drop drop drop NODE-ERROR b! 10 !b ;
|
||||
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
|
||||
dup (Q) a! ! 4* DP a! ! \ the space from its name on
|
||||
(LATEST) (PRUNE)
|
||||
V: VOC-LINK a! @ if PRUNED \ vocabularies that go
|
||||
dup (Q) a! @ inv + 1 + -if GONE drop jump KEPT
|
||||
GONE: drop 1 + a! @ VOC-LINK a! ! jump V
|
||||
KEPT: P: if PRUNED \ the lists of those that stay
|
||||
dup (PRUNE) 1 + a! @ jump P
|
||||
PRUNED: drop
|
||||
CONTEXT a! @ (Q) a! @ inv + 1 + -if C1 drop jump C2
|
||||
C1: drop (LATEST) CONTEXT a! !
|
||||
C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop ;
|
||||
C3: drop (LATEST) CURRENT a! ! ;
|
||||
MISSING: drop (UNKNOWN) drop ;
|
||||
|
||||
@@ -40,6 +40,9 @@
|
||||
#define FVARS (TOP - 105) /* (F): forth.v4, 7 cells */
|
||||
#define SVARS (TOP - 540 - (v4_cell)V4_DATA_DEPTH) /* (S): where PICK and ROLL set stack values aside, one cell for each cell of the stack */
|
||||
#define WVARS (TOP - 99) /* (W): numout.v4, 3 cells */
|
||||
#define CONTEXT (TOP - 64) /* the vocabulary names are looked up in */
|
||||
#define CURRENT (TOP - 63) /* the vocabulary new words go into */
|
||||
#define VOC_LINK (TOP - 50) /* the newest vocabulary */
|
||||
#define FENCE (TOP - 26) /* FORGET's lower limit */
|
||||
#define HLD (TOP - 25) /* where the pictured number has got to */
|
||||
#define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */
|
||||
@@ -133,6 +136,9 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "MAX-INT", (v4_cell)(V4_MSB - 1u));
|
||||
v4_text_constant(tx, "HLD", HLD);
|
||||
v4_text_constant(tx, "FENCE", FENCE);
|
||||
v4_text_constant(tx, "CONTEXT", CONTEXT);
|
||||
v4_text_constant(tx, "CURRENT", CURRENT);
|
||||
v4_text_constant(tx, "VOC-LINK", VOC_LINK);
|
||||
v4_text_constant(tx, "HEND", HEND);
|
||||
v4_text_constant(tx, "-HFLOOR", -(HEND - 62));
|
||||
v4_text_constant(tx, "DSTACK-DEPTH", DSTACK_REG);
|
||||
@@ -147,6 +153,10 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
/* one vocabulary, FORTH, whose head cell is LATEST */
|
||||
n->mem[CONTEXT] = LATEST;
|
||||
n->mem[CURRENT] = LATEST;
|
||||
n->mem[VOC_LINK] = 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@@ -18,6 +18,10 @@
|
||||
* v3 goes on compiling the lines that follow into it.
|
||||
* - ABORT" at the prompt stops the line when its flag is true. v3 prints
|
||||
* the text and carries on. Compiled into a word, v3's crashes (SIGSEGV).
|
||||
* - vocabularies are FORTH-79's: a word defined in one is found only when
|
||||
* that vocabulary is CONTEXT, and FORTH is searched after it. v3 finds
|
||||
* every word everywhere, and a word redefined in a vocabulary replaces
|
||||
* FORTH's for good.
|
||||
* - every error has a message (D-18), but v4's says what was wrong, not
|
||||
* which word: "Control structure mismatch" where v3 says
|
||||
* "LOOP: missing DO".
|
||||
@@ -82,6 +86,9 @@ static void boot_with(unsigned depth)
|
||||
n.mem[BASE] = 10;
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
n.mem[FENCE] = DICT_W;
|
||||
n.mem[CONTEXT] = LATEST;
|
||||
n.mem[CURRENT] = LATEST;
|
||||
n.mem[VOC_LINK] = 0;
|
||||
v4_node_console_attach(&n, CONSOLE_TX);
|
||||
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
|
||||
v4_node_fault_attach(&n, w_fault);
|
||||
@@ -814,6 +821,39 @@ int main(void)
|
||||
CHECK(is(say("FORGET G3 G1 G2\n"), "AB ok\nok> ") && is(say("G3\n"), "UNKNOWN WORD: 'G3'\n ERROR\nok> "), "one above it can");
|
||||
}
|
||||
|
||||
/* ---- vocabularies (FORTH-79) ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say("CONTEXT @ CURRENT @ = . ORDER\n"), "-1 Search order: FORTH \nCurrent: FORTH\n ok\nok> "), "at switch-on there is FORTH");
|
||||
CHECK(is(say("VOCABULARY ANIMALS ANIMALS DEFINITIONS : CAT 65 EMIT ; CAT FORTH CAT\n"), "AUNKNOWN WORD: 'CAT'\n ERROR\nok> "),
|
||||
"a word defined in a vocabulary is found there and not in FORTH");
|
||||
CHECK(is(say("ORDER\n"), "Search order: FORTH \nCurrent: ANIMALS\n ok\nok> "), "FORTH is CONTEXT; ANIMALS is still CURRENT");
|
||||
CHECK(is(say("ANIMALS CAT 1 2 + . ORDER\n"), "A3 Search order: ANIMALS FORTH\nCurrent: ANIMALS\n ok\nok> "), "with ANIMALS as CONTEXT, FORTH is searched after it");
|
||||
CHECK(is(say(": DUP 66 EMIT ; DUP FORTH 5 DUP . . ANIMALS DUP\n"), "B5 5 B ok\nok> "), "a name in both: each vocabulary has its own");
|
||||
CHECK(is(say("FORTH DEFINITIONS VOCABULARY PLANTS PLANTS DEFINITIONS : CAT 67 EMIT ; CAT\n"), "C ok\nok> "), "a second vocabulary with the same name in it");
|
||||
CHECK(is(say("ANIMALS CAT PLANTS CAT FORTH DEFINITIONS\n"), "AC ok\nok> "), "each finds its own");
|
||||
CHECK(is(say("ANIMALS WORDS PLANTS WORDS FORTH\n"), "DUP CAT \nCAT \n ok\nok> "), "WORDS lists the CONTEXT vocabulary");
|
||||
CHECK(is(say("ANIMALS CONTEXT @ CURRENT @ = . : X 1 ; CONTEXT @ CURRENT @ = .\n"), "0 -1 ok\nok> "), ": makes the CURRENT vocabulary CONTEXT");
|
||||
CHECK(is(say(": T1 ANIMALS ; : T2 FORTH 68 EMIT ; T1 CAT T2 ORDER\n"), "ADSearch order: ANIMALS FORTH\nCurrent: FORTH\n ok\nok> "),
|
||||
"a vocabulary's name can be compiled; FORTH is immediate");
|
||||
CHECK(is(say("VOCABULARY\nFORTH\n"), "Name missing\n ERROR\nok> ok\nok> "), "VOCABULARY needs a name");
|
||||
/* FORGET across vocabularies */
|
||||
boot_bare();
|
||||
CHECK(is(say("VOCABULARY V1 V1 DEFINITIONS : A1 1 ; FORTH DEFINITIONS : B1 2 ;\n"), " ok\nok> ")
|
||||
&& is(say("V1 DEFINITIONS : A2 3 ; FORTH DEFINITIONS\n"), " ok\nok> "), "words in two vocabularies, defined turn about");
|
||||
CHECK(is(say("FORGET B1 V1 A1 . A2\n"), "1 UNKNOWN WORD: 'A2'\n ERROR\nok> "), "FORGET takes what was defined later out of every vocabulary");
|
||||
CHECK(is(say("B1\n"), "UNKNOWN WORD: 'B1'\n ERROR\nok> ") && is(say("V1 DEFINITIONS : A3 4 ; A1 A3 + . FORTH DEFINITIONS\n"), "5 ok\nok> "), "and the vocabulary goes on");
|
||||
{
|
||||
v4_cell dp;
|
||||
CHECK(is(say("HERE . \n"), out) && n.mem[VOC_LINK] != 0, "(one vocabulary)");
|
||||
dp = n.mem[DP];
|
||||
CHECK(is(say("VOCABULARY V2 V2 DEFINITIONS : Z 1 ; VOCABULARY V3 ORDER\n"), "Search order: V2 FORTH\nCurrent: V2\n ok\nok> "), "a vocabulary that is CONTEXT and CURRENT");
|
||||
CHECK(is(say("FORGET V2 ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && n.mem[DP] == dp,
|
||||
"forgotten, FORTH takes its place and the space is back");
|
||||
CHECK(is(say("V2\n"), "UNKNOWN WORD: 'V2'\n ERROR\nok> ") && is(say("V3\n"), "UNKNOWN WORD: 'V3'\n ERROR\nok> ")
|
||||
&& is(say("V1 A1 . FORTH : OK1 65 EMIT ; OK1\n"), "1 A ok\nok> "), "its words and the vocabulary defined inside it are gone; the rest works");
|
||||
CHECK(is(say("FORGET V1 FORGET V1\n"), "UNKNOWN WORD: 'V1'\n ERROR\nok> ") && n.mem[VOC_LINK] == 0, "and with V1 forgotten there is none");
|
||||
}
|
||||
|
||||
/* ---- WORDS ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say(": ZEBRA ; : YAK ; : HALFWAY 1\n"), " ok\nok> "), "two words and a definition under way");
|
||||
@@ -845,7 +885,7 @@ int main(void)
|
||||
at += (size_t)snprintf(want + at, sizeof want - at, "00 7E C8 7F |.~..|\n");
|
||||
snprintf(want + at, sizeof want - at, " ok\nok> ");
|
||||
CHECK(is(say("PAD 20 DUMP\n"), want), "a line and four bytes, in hex though BASE is ten");
|
||||
CHECK(is(say("BASE @ .\n"), "10 ok\nok> "), "and BASE is put back");
|
||||
CHECK(is(say("BASE @ 48 + EMIT\n"), ": ok\nok> "), "and BASE is put back");
|
||||
CHECK(is(say("8 BASE ! PAD 24 DUMP DECIMAL\n"), want), "the same from octal");
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user