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

feat(v4.0.0): a node is handed a line -- ENGINE.md step 1

Browse Source 
A v4 node no longer reads its own command line or prints a prompt.  Its
host puts a line of text in the node's input buffer and starts it at
(LINE); the node interprets it and stops at (IDLE), leaving in
(LINE-STATUS) how it ended: completed, an error, or QUIT.  The host says
" ok" or " ERROR" and prompts, as the kernel's REPL does for a v3 VM.  A
line may be 1024 characters, a block, as v3's.  Ruled 2026-10-05
(V3-PARITY.md 1b); design ENGINE.md 3.1.

- quit.v4: (REPL), the node's prompt loop, is gone; (LINE) (IDLE) (DONE)
- image.h/.c: v4_line_begin, v4_line_done, v4_line_status; the node is
  idle at switch-on
- boot.c: v4_boot_line, the one loop the hosted binary, the kernel and the
  capsule loader hand a line with; the code that took " ok" and the prompt
  back out of the node's output is gone
- hosted.c, sk_v4.c: the prompt and the line editing are the host's
- test_host_quit.c: the tests are the node's host; two tests of the old
  80-character prompt line now test a whole line, 1024 and 1025 characters

Verified: make -C v4 test passes at both widths; hosted-check passes on
three ISAs; clean qemu with STARFORTH_V4=1 on amd64, aarch64 and riscv64
passes POST (550 of 550) with the same hashes as hosted, and three lines
typed at each bare-metal prompt through the serial port are answered
correctly (logs/20261005-180922, -181152, -181541).

Still the lone node: kernel_main.c starts it before the fleet tables.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-05 18:17:37 -04:00
co-authored by Claude Opus 5.5
parent ab7a9bf06f
commit 01c447f9ab
17 changed files with 771 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/README.md
+25 -9
View File
@@ -55,23 +55,39 @@ and fails unless their output is identical and ends in `PARITY:OK`.
A capsule line the node does not answer ` ok` to ends the boot, naming the
capsule, block and line, with `PARITY:FAIL` and `POST: FAILED`.
State, 2026-10-05: all six builds start the nucleus, load `v4:forth79.4th`,
pass POST and reach `ok>`, with the same lines:
State, 2026-10-05, after `ENGINE.md` step 1: all six builds start the nucleus,
load `v4:forth79.4th`, pass POST and reach `ok>`, with the same lines:
```
PARITY:V4_NUCLEUS words=295 image_hash=0x3ed5d5fc83f0b026
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x1ec33b48cc76a0b5
PARITY:V4_NUCLEUS words=295 image_hash=0x3b5a9a7a2f7c5361
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=... dict_hash=0xc45c4db43ea0b1f1
PARITY:V4_POST tests=550 pass=550 fail=0
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=0xb987dbb4388990bd capsule_hash=0xb987dbb4388990bd dict_hash=0x671fdd7aebf0f8d8
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=... dict_hash=0x88df0873060da73e
PARITY:OK
POST: PASSED
ok>
```
Bare-metal logs: `logs/20261005-161924/amd64/`, `logs/20261005-162142/aarch64/`,
`logs/20261005-162524/riscv64/`. Each run was ended once the prompt was in the
log; nothing was typed at a bare-metal prompt, so keyboard input there is not
yet verified. The capsules were unsigned (no signing key on this machine).
Bare-metal logs: `logs/20261005-180922/amd64/`, `logs/20261005-181152/aarch64/`,
`logs/20261005-181541/riscv64/`. On each, three lines were then typed at the
prompt through the serial port — a definition, its use with the capsule's
`U*`, and an unknown word — and each answered as the hosted binary does. The
capsules were unsigned (no signing key on this machine).
**A node is handed a line** (`docs/v4.0.0/ENGINE.md` 3.1). It does not read
its own command line and prints no prompt. Its host puts the text in the
node's input buffer and starts it at `(LINE)`; the node interprets the text
and stops at `(IDLE)`, leaving in `(LINE-STATUS)` how it ended. The host says
` ok` or ` ERROR` and prompts, as the kernel's REPL does for a v3 VM. A line
may be 1024 characters, a block. `v4_line_begin`, `v4_line_done` and
`v4_line_status` (`v4/include/v4/image.h`) are that interface;
`v4_boot_line` (`v4/system/boot.c`) is the one loop the hosted binary, the
kernel and the capsule loader all run it with.
**This is still the lone node.** On bare metal `kernel_main.c` starts it
before the fleet tables, beside the kernel's own system and not in the VM's
place. `ENGINE.md` sets out the steps from here; step 1 is the only one
done. `V3-PARITY.md` records the rulings it is built from.
**What this does not yet show.** `forth79.4th` holds two definitions, `U*`
and `U/MOD`. Every other word is still in the assembled nucleus, so POST is
v4/capsule/forth.v4
+2 -2
View File
@@ -34,7 +34,7 @@ header DEPTH
\ ( name -- ) "xxxx: Invalid index", and the line ends with ERROR
: (INDEX)
R-CLEAR (EMIT4) $6E49203A (EMIT4) $696C6176 (EMIT4) $6E692064 (EMIT4) $786564 (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
\ ( x1 .. xn-1 -- ) A: n, which is 2 or more. Set the n-1 values above
\ the n-th aside. If there are not that many, the pop that finds the stack
@@ -127,7 +127,7 @@ header 2/ inline : TWO/ 2/ ;
: (DIV0)
R-CLEAR (EMIT4) (EMIT4) $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4) \ ": Division b"
$657A2079 (EMIT4) $6F72 (EMIT4) CR \ "y zero"
2 jump (REPL)
2 jump (DONE)
\ ( d n -- rem quot ) truncating toward zero: the quotient has the sign of
\ d xor n, the remainder the sign of d. This is section 4's SM/REM with its
v4/capsule/quit.v4
+64 -49
View File
@@ -1,20 +1,28 @@
\ quit.v4 -- the prompt: lines read from the console and interpreted, one
\ after another, for as long as the node runs; and the words that print text
\ written in the source.
\ quit.v4 -- a line of text, interpreted; how it ends; and the words that
\ print text written in the source.
\
\ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of
\ the compiler capsule. Rests on all the files before it.
\
\ WHAT THE CONSOLE SHOWS, as v3:
\ ok> 65 EMIT the prompt, then the line as it is typed
\ A ok what the line printed, then " ok"
\ A NODE IS HANDED A LINE (docs/v4.0.0/ENGINE.md 3.1). It does not read its
\ own command line and prints no prompt: that is its host's, as it is the
\ kernel's REPL's for a v3 VM. The host puts the text in TIB and starts
\ (LINE); the node interprets it and stops at (IDLE), having left in the
\ variable (LINE-STATUS) how the line ended:
\ 1 it completed the host says " ok"
\ 2 it ended in an error the message is already printed; " ERROR"
\ 0 QUIT nothing is said
\ What the console then shows is v3's:
\ ok> 65 EMIT the host's prompt, and the line
\ A ok what the line printed, then the host's " ok"
\ ok> NOSUCH
\ UNKNOWN WORD: 'NOSUCH'
\ ERROR any line that sets NODE-ERROR ends so
\ ERROR
\ ok> -1 @
\ Address out of range an address fault (D-14), from any depth
\ ERROR
\ The line itself is not sent back: the terminal shows what is typed.
\ KEY, EXPECT and QUERY are FORTH-79 words that read characters, as before;
\ they are not how a line reaches the node.
\
\ THE STACKS are guarded (D-16): each counts what it holds, and a push onto
\ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which
@@ -22,6 +30,7 @@
\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that.
\
\ Constants the loader supplies:
\ (LINE-STATUS) word address of the variable: how the last line ended
\ (Q) word address of four cells of scratch, which system.v4 and
\ blocks.v4 use too
\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers
@@ -37,34 +46,40 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ CATCHING A LINE'S ERROR. While the variable (CATCH) is not zero, a line
\ that ends in an error -- a fault, or a code in NODE-ERROR -- does not say
\ ERROR: (CATCH) is set to -1 and the line ends " ok". Whatever message the
\ ERROR: (CATCH) is set to -1 and the line is reported as completed. Whatever message the
\ error printed has gone wherever EMIT was sending it. POST uses this to
\ go on to its next case, and to check the cases that must fail
\ (docs/v4.0.0/NUCLEUS.md 6.3). (EMIT-HOOK), core.v4, is set to 0 here at
\ the end of every line, caught or not.
\
\ ( k -- ) the loop. It is entered with what to say first -- 0 nothing,
\ 1 " ok", anything else " ERROR" -- and never returns. It is always jumped
\ to, never called, by something that has emptied the return stack (or by a
\ fault, which empties it). Each line is then interpreted with one return
\ entry under it, this word's call of INTERPRET.
: (REPL)
\ ( k -- ) the line is over. It is entered with how -- 0 QUIT, 1 completed,
\ anything else an error -- and never returns: it leaves that in
\ (LINE-STATUS) and stops at (IDLE), where the host finds the node. It is
\ always jumped to, never called, by something that has emptied the return
\ stack (or by a fault, which empties it).
: (IDLE) L: jump L
: (DONE)
(EMIT-HOOK) b! 0 !b \ the console is the console again
if GO -1 + if OK
drop (RESET)
(CATCH) b! @b if LOUD drop -1 !b 1 jump (REPL) \ caught: the line ends " ok"
LOUD: drop $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR"
OK: drop $6B6F20 (EMIT4) CR jump READ \ " ok"
GO: drop
READ:
$203E6B6F (EMIT4) \ "ok> "
(CATCH) b! @b if LOUD drop -1 !b 1 jump (DONE) \ caught: the line completed
LOUD: drop 2 (LINE-STATUS) b! !b jump (IDLE)
OK: drop 1 (LINE-STATUS) b! !b jump (IDLE)
GO: drop 0 (LINE-STATUS) b! !b jump (IDLE)
\ ( -- ) THE LINE ENTRY. The host has put a line of text in TIB, a zero
\ after it, and its length in SPAN, has emptied the return stack and set P
\ here. The line is interpreted with one return entry under it, this
\ word's call of INTERPRET; whatever is on the data stack stays there.
: (LINE)
0 BLK a! ! \ the terminal, whatever was being loaded
QUERY
TIB (SRC) a! ! 0 >IN a! !
0 NODE-ERROR b! !b
INTERPRET
NODE-ERROR b! @b if GOOD
drop 2 jump (REPL)
GOOD: drop 1 jump (REPL)
drop 2 jump (DONE)
GOOD: drop 1 jump (DONE)
\ FORTH-79: clear the return stack, set execution mode, return control to
\ the terminal; no message is given. The data stack is left as it is.
@@ -77,14 +92,14 @@ header (CATCH) inline : (CATCH)' (CATCH) ;
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
header QUIT
: QUIT R-CLEAR (RESET) CR 0 jump (REPL)
: QUIT R-CLEAR (RESET) CR 0 jump (DONE)
\ FORTH-79: clear the data and return stacks, set execution mode, return
\ control to the terminal. As v3, the line it stops ends with " ok".
\ Both are emptied before anything is called: ABORT may be run with the
\ return stack full.
header ABORT
: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (REPL)
: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (DONE)
\ ---- faults (D-14, D-16) -------------------------------------------------------
\ Where the node goes when a programme uses an address outside its memory,
@@ -94,19 +109,19 @@ header ABORT
\ ERROR.
: (FAULT) \ "Address out of range"
$72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
: (D-OVER) \ "Stack overflow"
$63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
: (D-UNDER) \ "Stack underflow"
$63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
: (R-OVER) \ "Return stack overflow"
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
: (R-UNDER) \ "Return stack underflow"
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
2 jump (REPL)
2 jump (DONE)
\ A word has stored an error code in NODE-ERROR (D-18; the codes are listed
\ in core.v4). Print its message -- a negative code means the word printed
@@ -114,28 +129,28 @@ header ABORT
\ emptied; the data stack is as the word left it.
: (RAISED)
NODE-ERROR b! @b
-if POS drop 2 jump (REPL)
-if POS drop 2 jump (DONE)
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 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
-1 + if M15 -1 + if M16
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)
M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (REPL)
M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (REPL)
M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (REPL)
M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (REPL)
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)
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (REPL)
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (REPL)
M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (EMIT4) CR 2 jump (REPL)
drop 2 jump (DONE)
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (DONE)
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (DONE)
M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (DONE)
M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (DONE)
M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (DONE)
M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (DONE)
M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (DONE)
M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (DONE)
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (DONE)
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (DONE)
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (DONE)
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (DONE)
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (DONE)
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (DONE)
M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
\ 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
v4/include/v4/boot.h
+20 -6
View File
@@ -11,7 +11,6 @@
* PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=0x... capsule_hash=0x... dict_hash=0x...
* PARITY:OK
* POST: PASSED
* ok>
*
* or, if anything is wrong, what was wrong and then
*
@@ -21,9 +20,10 @@
* A capsule is found by name in the directory tools/mkcapsule.c baked into
* the binary, its hash is recomputed, its signature is checked -- one that
* does not verify refuses the capsule, a missing one is only reported, as
* for v3's capsules -- and its blocks are given to the node a line at a
* time as if typed. The node must answer " ok" to every line; the first
* line it does not accept ends the boot. What a line prints is shown.
* for v3's capsules -- and its blocks are handed to the node a line at a
* time (docs/v4.0.0/ENGINE.md 3.1). Every line must complete; the first
* that ends in an error, or in QUIT, ends the boot. What a line prints is
* shown.
*
* The dictionary hash is FNV-1a over the node's memory below HERE, a cell at
* a time, low byte first, then LATEST. It does not depend on the machine:
@@ -40,13 +40,27 @@ typedef struct {
v4_heat *h;
const v4_image *im; /* the nucleus */
void (*out)(const char *text, unsigned len); /* the console */
int (*key)(void); /* a character for a line that reads the keyboard, or 0: there is none */
} v4_boot;
/* What `key` returns when it has no character. */
#define V4_BOOT_KEY_NONE (-1) /* not yet: it is asked again */
#define V4_BOOT_KEY_END (-2) /* and there never will be */
/* Start the node from the nucleus image, with `disk` as its block storage
* (see v4_image_boot), and load the capsules. Returns 1 with the node
* waiting at its prompt, the prompt printed; or 0, the failure printed. */
* (see v4_image_boot), and load the capsules. Returns 1 with the node idle,
* waiting to be handed a line; or 0, the failure printed. It prints no
* prompt: that is the host's. */
int v4_boot_run(const v4_boot *b, unsigned char *disk, unsigned blocks);
/* Hand the node a line and run it to its end, sending what it prints to
* `out`. Returns how it ended -- V4_LINE_QUIT, V4_LINE_COMPLETED or
* V4_LINE_ERROR (image.h) -- or one of these: */
#define V4_BOOT_LINE_TOO_LONG (-1) /* more than the node's input buffer holds; nothing was run */
#define V4_BOOT_LINE_STOPPED (-2) /* the node stopped on a fault, or never finished */
#define V4_BOOT_LINE_NO_INPUT (-3) /* the line read the keyboard and there is no more input */
int v4_boot_line(const v4_boot *b, const char *text, unsigned len);
/* The dictionary hash of a node started from `im`. */
uint64_t v4_boot_dict_hash(const v4_node *n, const v4_image *im);
v4/include/v4/image.h
+33 -9
View File
@@ -29,9 +29,17 @@ typedef struct {
/* what the image was built for */
unsigned cell_bits, node_words, data_ring, ret_ring;
/* where to start, and where a fault goes */
v4_cell entry; /* QUIT */
v4_cell fault_table; /* (FAULTS) */
/* The node is handed a line (docs/v4.0.0/ENGINE.md 3.1). Its host puts
* text in the input buffer and starts it at `line`; it stops at `idle`,
* with how the line ended in the cell `line_status`. At switch-on it
* is at `idle`. */
v4_cell line; /* (LINE) */
v4_cell idle; /* (IDLE) */
v4_cell line_status; /* word address of the variable (LINE-STATUS) */
v4_cell tib; /* byte address of the input buffer */
unsigned tib_bytes; /* its size: a line may be one less */
v4_cell span; /* word address of the variable SPAN */
v4_cell fault_table; /* (FAULTS): where a fault goes */
/* KEY's code: a node whose P is in key_start .. key_end - 1 with no
* character pending is waiting for one */
@@ -53,17 +61,33 @@ typedef struct {
/* The image built from v4/capsule (the generated file defines it). */
extern const v4_image v4_capsule_image;
/* How a line ended. */
#define V4_LINE_QUIT 0 /* QUIT: nothing is to be said */
#define V4_LINE_COMPLETED 1 /* the host says " ok" */
#define V4_LINE_ERROR 2 /* the message is printed; the host says " ERROR" */
/* Reset `n`, load the image into it, attach its registers -- with `disk`,
* `blocks` blocks of 1024 bytes, as its block storage, or none if `disk` is
* 0 -- and leave it about to execute its first instruction. Returns 1, or 0
* if the image is not for this build of the engine (nothing is then done).
*
* After it, the caller runs the node: v4_exec_step_word again and again,
* taking what the node prints from n->console (and setting n->console_len
* back to 0) and giving it what is typed with v4_node_console_feed. */
* 0 -- and leave it idle, waiting to be handed a line. Returns 1, or 0 if
* the image is not for this build of the engine (nothing is then done). */
int v4_image_boot(v4_node *n, v4_exec_state *es, v4_heat *h, const v4_image *im,
unsigned char *disk, unsigned blocks);
/* Hand the node `len` characters of text to interpret. Returns 1, or 0 if
* the text is longer than the node's input buffer holds (nothing is then
* done). After it the host runs the node -- v4_exec_step_word again and
* again, taking what the node prints from n->console and setting
* n->console_len back to 0 -- until v4_line_done; if v4_image_waiting comes
* first, the line is reading the keyboard, and the host gives it characters
* with v4_node_console_feed. */
int v4_line_begin(v4_node *n, const v4_image *im, const char *text, unsigned len);
/* 1 when the node has finished the line it was handed and is idle again. */
int v4_line_done(const v4_node *n, const v4_image *im);
/* How the line just finished ended: V4_LINE_QUIT, _COMPLETED or _ERROR. */
int v4_line_status(const v4_node *n, const v4_image *im);
/* 1 if the node is waiting for a character: it is inside KEY and none is
* pending. */
int v4_image_waiting(const v4_node *n, const v4_image *im);
v4/src/image.c
+35 -1
View File
@@ -26,7 +26,8 @@ int v4_image_boot(v4_node *n, v4_exec_state *es, v4_heat *h, const v4_image *im,
v4_node_fault_attach(n, im->fault_table);
if (disk && blocks) v4_node_storage_attach(n, im->storage_reg, disk, blocks);
n->p = im->entry;
n->mem[im->line_status] = V4_LINE_COMPLETED;
n->p = im->idle;
return 1;
}
@@ -34,3 +35,36 @@ int v4_image_waiting(const v4_node *n, const v4_image *im)
{
return n->input_pos == n->input_len && n->p >= im->key_start && n->p < im->key_end;
}
/* One byte of the node's memory: four to a cell, the first lowest, at either
* cell width -- as C! stores them (v4/capsule/core.v4). */
static void put_byte(v4_node *n, v4_cell baddr, unsigned c)
{
v4_cell word = baddr / 4;
unsigned shift = 8u * (unsigned)(baddr % 4);
v4_ucell mask = (v4_ucell)0xFFu << shift;
n->mem[word] = (v4_cell)(((v4_ucell)n->mem[word] & ~mask) | ((v4_ucell)(c & 0xFFu) << shift));
}
int v4_line_begin(v4_node *n, const v4_image *im, const char *text, unsigned len)
{
unsigned i;
if (len + 1u > im->tib_bytes) return 0;
for (i = 0; i < len; i++) put_byte(n, im->tib + (v4_cell)i, (unsigned char)text[i]);
put_byte(n, im->tib + (v4_cell)len, 0);
n->mem[im->span] = (v4_cell)len;
v4_rstack_reset(&n->rs);
n->p = im->line;
return 1;
}
int v4_line_done(const v4_node *n, const v4_image *im)
{
return n->p == im->idle;
}
int v4_line_status(const v4_node *n, const v4_image *im)
{
return (int)n->mem[im->line_status];
}
v4/system/boot.c
+29 -63
View File
@@ -24,7 +24,7 @@ static const char *const boot_capsules[] = {
#endif
};
#define LINE_MAX 80u /* QUERY takes 80 characters, the new-line among them */
#define LINE_MAX 1025u /* a line is at most 1024 characters, a block */
#define STEP_LIMIT 4000000000ULL /* instruction words one line may take */
/* ---- printing ------------------------------------------------------------ */
@@ -104,17 +104,7 @@ static uint32_t word_count(const v4_node *n, const v4_image *im)
return count;
}
/* ---- running the node ---------------------------------------------------- */
/* The node ends every line it has taken with " ok" and the next prompt.
* Those eight characters are held back from the console, so that what is
* shown is only what the line itself printed. */
static const char accepted[8] = { ' ', 'o', 'k', '\n', 'o', 'k', '>', ' ' };
typedef struct {
char held[8];
unsigned len;
} tail;
/* ---- handing the node a line ---------------------------------------------- */
/* POST's verdict. The POST capsule ends by printing one line,
* PARITY:V4_POST tests=N pass=N fail=N
@@ -136,62 +126,42 @@ static int text_at(const char *line, unsigned len, unsigned at, const char *want
static void post_watch(char c)
{
static const char clean[] = " fail=0";
unsigned i;
if (c != '\n') {
if (post_len < sizeof post_line) post_line[post_len++] = c;
return;
}
/* the node's prompt comes before it on the line, so look along the line */
for (i = 0; i < post_len; i++)
if (text_at(post_line, post_len, i, "PARITY:V4_POST ")) {
post_seen = 1;
post_clean = post_len >= sizeof clean - 1 && text_at(post_line, post_len, post_len - (unsigned)(sizeof clean - 1), clean);
break;
}
if (text_at(post_line, post_len, 0, "PARITY:V4_POST ")) {
post_seen = 1;
post_clean = post_len >= sizeof clean - 1 && text_at(post_line, post_len, post_len - (unsigned)(sizeof clean - 1), clean);
}
post_len = 0;
}
static void tail_put(const v4_boot *b, tail *t, int show, char c)
{
unsigned i;
if (t->len == sizeof t->held) {
if (show) b->out(t->held, 1);
for (i = 1; i < sizeof t->held; i++) t->held[i - 1] = t->held[i];
t->len--;
}
t->held[t->len++] = c;
}
/* Run until the node waits for a character. Returns 1 if what it printed
* ended with " ok" and the prompt; 0 if not -- the rest is then shown too --
* or if the node stopped or never came back. */
static int run_to_prompt(const v4_boot *b, int show)
int v4_boot_line(const v4_boot *b, const char *text, unsigned len)
{
v4_node *n = b->n;
uint64_t steps = 0;
unsigned i;
tail t;
t.len = 0;
if (!v4_line_begin(n, b->im, text, len)) return V4_BOOT_LINE_TOO_LONG;
for (;;) {
(void)v4_exec_step_word(n, b->es, b->h);
if (n->console_len) {
for (i = 0; i < n->console_len; i++) {
post_watch((char)n->console[i]);
tail_put(b, &t, show, (char)n->console[i]);
}
for (i = 0; i < n->console_len; i++) post_watch((char)n->console[i]);
b->out((const char *)n->console, n->console_len);
n->console_len = 0;
}
if (n->stopped) { say(b, "\nV4: the node stopped on a fault\n"); return 0; }
if (v4_image_waiting(n, b->im)) break;
if (++steps > STEP_LIMIT) { say(b, "\nV4: the node did not come back to its prompt\n"); return 0; }
if (n->stopped) return V4_BOOT_LINE_STOPPED;
if (v4_line_done(n, b->im)) return v4_line_status(n, b->im);
if (v4_image_waiting(n, b->im)) { /* the line is reading the keyboard */
int c = b->key ? b->key() : V4_BOOT_KEY_END;
unsigned char ch = (unsigned char)c;
if (c == V4_BOOT_KEY_END) return V4_BOOT_LINE_NO_INPUT;
if (c >= 0) (void)v4_node_console_feed(n, &ch, 1u);
continue;
}
if (++steps > STEP_LIMIT) return V4_BOOT_LINE_STOPPED;
}
if (t.len == sizeof t.held) {
for (i = 0; i < sizeof t.held && t.held[i] == accepted[i]; i++) { }
if (i == sizeof t.held) return 1;
}
if (show) b->out(t.held, t.len);
return 0;
}
/* ---- one capsule --------------------------------------------------------- */
@@ -253,13 +223,13 @@ static int load_capsule(const v4_boot *b, const char *name)
if (len >= LINE_MAX) { say_where(b, name, block, line); say(b, " is too long\n"); return 0; }
if (len) {
for (i = 0; i < len; i++) text[i] = (char)p[i];
text[len] = '\n';
if (v4_node_console_feed(b->n, text, len + 1u) != len + 1u) {
say_where(b, name, block, line); say(b, ": the node's input is full\n");
return 0;
}
if (!run_to_prompt(b, 1)) {
say_where(b, name, block, line); say(b, " was not accepted: ");
int how = v4_boot_line(b, text, len);
if (how != V4_LINE_COMPLETED) {
say_where(b, name, block, line);
say(b, how == V4_LINE_ERROR ? " ended in an error: "
: how == V4_LINE_QUIT ? " ended with QUIT: "
: how == V4_BOOT_LINE_NO_INPUT ? " reads the keyboard: "
: " stopped the node: ");
b->out(text, len); say(b, "\n");
return 0;
}
@@ -291,10 +261,6 @@ int v4_boot_run(const v4_boot *b, unsigned char *disk, unsigned blocks)
say(b, " image_hash="); say_hex(b, image_hash(b->im));
say(b, "\n");
/* the node's own first prompt is not shown: the boot prints one at the end */
(void)run_to_prompt(b, 0);
if (b->n->stopped) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; }
for (i = 0; i < sizeof boot_capsules / sizeof boot_capsules[0]; i++)
if (!load_capsule(b, boot_capsules[i])) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; }
#if V4_POST_AT_BOOT
@@ -306,9 +272,9 @@ int v4_boot_run(const v4_boot *b, unsigned char *disk, unsigned blocks)
#endif
#if V4_POST_AT_BOOT
say(b, "PARITY:OK\nPOST: PASSED\nok> ");
say(b, "PARITY:OK\nPOST: PASSED\n");
#else
say(b, "PARITY:OK\nok> ");
say(b, "PARITY:OK\n");
#endif
return 1;
}
v4/tests/host_map.h
+3 -1
View File
@@ -51,7 +51,7 @@
#define CFS_CELLS 32
#define WBUF_W (TOP - 170) /* WORD's buffer: 65 cells = 260 bytes */
#define WBUF_CELLS 65
#define TIB_W (TOP - 440) /* the text input buffer: 260 cells = 1040 bytes */
#define TIB_W (TOP - 440) /* the text input buffer: 260 cells = 1040 bytes; a line is at most 1024 */
#define PAD_W (TOP - 470) /* PAD: 21 cells = 84 bytes */
#define SBUF_W (TOP - 540) /* 64 cells for the tests' own strings */
#define HBUF_W (SVARS - 16) /* the hold buffer: 16 cells = 64 bytes */
@@ -67,6 +67,7 @@
#define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */
#define EMIT_HOOK (BUF0_W - 7) /* the xt of a word EMIT gives its character to, or 0: the console */
#define CATCH (BUF0_W - 8) /* non-zero: a line's error is recorded here, -1, and the line ends " ok" */
#define LINE_STATUS (BUF0_W - 9) /* how the last line ended: 0 QUIT, 1 completed, 2 an error */
#define LOG_LEVEL (BUF0_W - 5) /* the level at or below which a message is printed */
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
@@ -142,6 +143,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(SRC-HOOK)", SRC_HOOK);
v4_text_constant(tx, "(EMIT-HOOK)", EMIT_HOOK);
v4_text_constant(tx, "(CATCH)", CATCH);
v4_text_constant(tx, "(LINE-STATUS)", LINE_STATUS);
v4_text_constant(tx, "BLOCK-NUMBER", STORAGE_REG);
v4_text_constant(tx, "BLOCK-ADDRESS", STORAGE_REG + 1);
v4_text_constant(tx, "BLOCK-COMMAND", STORAGE_REG + 2);
v4/tests/test_host_quit.c
+98 -26
View File
@@ -41,6 +41,7 @@
* 3 ROLL is ROT. v3's count from zero.
*/
#include "v4/text.h"
#include "v4/image.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
@@ -57,7 +58,8 @@ static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_text tx;
static v4_cell w_quit, w_key, w_key_end, w_fault, capsule_latest;
static v4_cell w_key, w_key_end, w_fault, capsule_latest;
static v4_image img; /* where a line is handed to the node: v4/include/v4/image.h */
static char out[V4_CONSOLE_CAP + 1];
/* The storage device's blocks: zeros at every switch-on. */
@@ -71,19 +73,32 @@ static void put_block(unsigned num, const char *text)
}
static long last_steps;
/* Run until the node has taken all its input and has been inside KEY, waiting,
* for 64 instruction words; or until `max` words. True if it is waiting. */
static int run_until_waiting(long max)
/* THE HOST. A node is handed a line and prints no prompt (ENGINE.md 3.1);
* these tests are its host, and do what tools/hosted.c does: take what is
* typed a line at a time, hand each line over, and say " ok" or " ERROR" and
* the next prompt. What is typed after a line is there for a word in it
* that reads the keyboard, and what such a word does not take is the next
* line. */
static char typed[8192]; /* typed and not yet taken */
static unsigned typed_len;
static int line_open; /* a line has been handed over and has not ended */
/* Run until the line ends, or until it has been inside KEY with nothing to
* read for 64 instruction words; or until `max` words. 1: ended, 2: waiting
* for a character, 0: neither. */
static int run_line(long max)
{
long steps = 0;
unsigned idle = 0;
while (steps < max && idle < 64) {
if (v4_line_done(&n, &img)) { last_steps = steps; return 1; }
(void)v4_exec_step_word(&n, &es, &h);
steps++;
if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
}
last_steps = steps;
return idle >= 64;
if (v4_line_done(&n, &img)) return 1;
return idle >= 64 ? 2 : 0;
}
/* A node just switched on: an empty dictionary above the capsule's words,
@@ -121,8 +136,10 @@ static void boot_with(unsigned depth)
v4_heat_reset(&h);
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
v4_dstack_push(&n.ds, CANARY);
n.p = w_quit;
(void)run_until_waiting(100000);
n.mem[LINE_STATUS] = V4_LINE_COMPLETED;
n.p = img.idle; /* idle, waiting to be handed a line */
typed_len = 0;
line_open = 0;
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
@@ -141,16 +158,52 @@ static int canary_under_expect(void)
return 0;
}
/* Feed `input` and return what the node prints until it waits again. */
/* Type `input` and return what the console then shows: what each line
* printed, the host's " ok" or " ERROR" after it, and the next prompt. A
* line that has not been ended shows nothing; nor does one that is waiting
* for a character. */
static const char *say(const char *input)
{
unsigned len = (unsigned)strlen(input);
v4_node_console_attach(&n, CONSOLE_TX); /* empties the capture */
if (v4_node_console_feed(&n, input, len) != len) return "(input queue full)";
if (!run_until_waiting(40000000)) return "(still running)";
if (n.console_dropped) return "(too much output)";
memcpy(out, n.console, n.console_len);
out[n.console_len] = 0;
unsigned ilen = (unsigned)strlen(input), olen = 0;
if (typed_len + ilen > sizeof typed) return "(input queue full)";
memcpy(typed + typed_len, input, ilen);
typed_len += ilen;
out[0] = 0;
for (;;) {
const char *tail;
unsigned took;
int ended;
if (!line_open) {
char *nl = (char *)memchr(typed, '\n', typed_len);
unsigned len;
if (!nl) break;
len = (unsigned)(nl - typed);
if (!v4_line_begin(&n, &img, typed, len)) return "(line too long)";
memmove(typed, nl + 1, typed_len - len - 1);
typed_len -= len + 1;
line_open = 1;
}
v4_node_console_attach(&n, CONSOLE_TX); /* empties the capture */
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); /* and the keyboard */
if (v4_node_console_feed(&n, typed, typed_len) != typed_len) return "(input queue full)";
ended = run_line(40000000);
took = n.input_pos; /* what a word in the line read */
memmove(typed, typed + took, typed_len - took);
typed_len -= took;
if (n.console_dropped || olen + n.console_len + 16 > sizeof out) return "(too much output)";
memcpy(out + olen, n.console, n.console_len);
olen += n.console_len;
out[olen] = 0;
if (ended == 0) return "(still running)";
if (ended == 2) break;
line_open = 0;
tail = v4_line_status(&n, &img) == V4_LINE_COMPLETED ? " ok\nok> "
: v4_line_status(&n, &img) == V4_LINE_ERROR ? " ERROR\nok> " : "ok> ";
memcpy(out + olen, tail, strlen(tail) + 1);
olen += (unsigned)strlen(tail);
}
return out;
}
/* Feed a file of FORTH source to the prompt, a line at a time, as if typed.
@@ -614,7 +667,12 @@ int main(void)
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
printf(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
w_quit = v4_text_word(&tx, "QUIT");
img.line = v4_text_word(&tx, "(LINE)");
img.idle = v4_text_word(&tx, "(IDLE)");
img.line_status = LINE_STATUS;
img.tib = TIB;
img.tib_bytes = 1025u;
img.span = SPAN;
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
w_fault = v4_text_word(&tx, "(FAULTS)");
@@ -623,10 +681,11 @@ int main(void)
/* ---- switch-on ---- */
boot();
CHECK(n.console_len == 5 && memcmp(n.console, "\nok> ", 5) == 0, "QUIT starts a new line and prompts");
CHECK(n.input_pos == n.input_len, "then waits for a line");
CHECK(run_until_waiting(5000) && last_steps == 64 && n.console_len == 5, "and goes on waiting, printing nothing");
CHECK(v4_line_done(&n, &img) && n.console_len == 0, "the node is idle and has printed nothing: the prompt is its host's");
CHECK(run_line(5000) == 1 && last_steps == 0, "and goes on waiting to be handed a line");
CHECK(canary_under_expect(), "with the data stack as it found it");
(void)v4_exec_step_word(&n, &es, &h);
CHECK(v4_line_done(&n, &img), "it stays idle however long it is run");
/* ---- the sessions ---- */
for (i = 0; i < NSCRIPT; i++) {
@@ -713,16 +772,15 @@ int main(void)
snprintf(want, sizeof want, "<><%.*s\n ok\nok> ", (int)i, "abcdefghijkl");
CHECK(is(say(line), want), "ABORT\" with %u characters, false then true", i);
}
/* the longest: 76 characters fit an 80-character line after ." and a space.
* EXPECT stops at the 80th character, so that line's new-line is still to
* come and is read as an empty line (FORTH-79's EXPECT; see input.v4). */
/* 76 characters after ." and a space make a line of 80. That was the most
* the node's own QUERY would take; a line the host hands over is whole. */
{
char line[128], want[128], text[80];
for (i = 0; i < 76; i++) text[i] = (char)('#' + i); /* no " in it */
text[76] = 0;
boot();
snprintf(line, sizeof line, ".\" %s\"\n", text);
snprintf(want, sizeof want, "%s ok\nok> ok\nok> ", text);
snprintf(want, sizeof want, "%s ok\nok> ", text);
CHECK(is(say(line), want), "a string that fills an 80-character line");
boot();
snprintf(line, sizeof line, ".\" %s\"\n", text + 1);
@@ -730,16 +788,30 @@ int main(void)
CHECK(is(say(line), want), "and one that fills a 79-character line");
}
/* ---- QUERY takes 80 characters; what is over is the next line ---- */
/* ---- a line is handed over whole, up to 1024 characters: a block, as v3 ---- */
boot();
{
char line[128];
static char line[1100];
memset(line, ' ', 100);
memcpy(line, "65 EMIT", 7);
memcpy(line + 70, "66 EMIT", 7);
memcpy(line + 80, "67 EMIT 68 EMIT", 15);
line[100] = '\n'; line[101] = 0;
CHECK(is(say(line), "AB ok\nok> CD ok\nok> "), "a line of 100 characters is read as 80 and 20");
CHECK(is(say(line), "ABCD ok\nok> "), "a line of 100 characters is one line");
boot();
memset(line, ' ', 1024);
memcpy(line, "65 EMIT", 7);
memcpy(line + 1017, "66 EMIT", 7);
line[1024] = '\n'; line[1025] = 0;
CHECK(is(say(line), "AB ok\nok> "), "a line of 1024 characters is interpreted to its end");
boot();
memset(line, ' ', 1025);
memcpy(line, "65 EMIT", 7);
line[1025] = '\n'; line[1026] = 0;
CHECK(is(say(line), "(line too long)"), "one of 1025 is not taken: the node's input buffer holds a block");
CHECK(v4_line_done(&n, &img) && n.console_len == 0, "and nothing of it was run");
}
/* ---- ABORT and QUIT from deep in a programme, again and again ---- */
v4/tools/hosted.c
+30 -17
View File
@@ -8,7 +8,7 @@
*/
#include "v4/boot.h"
#include <stdio.h>
#include <unistd.h>
#include <string.h>
#define BLOCKS 64u
@@ -22,27 +22,40 @@ static void console_out(const char *text, unsigned len)
(void)fwrite(text, 1, len, stdout);
}
/* a character for a line that reads the keyboard */
static int console_key(void)
{
int c;
fflush(stdout);
c = getchar();
return c == EOF ? V4_BOOT_KEY_END : c;
}
/* The prompt is the host's, as it is the kernel's REPL's for a v3 VM: read a
* line, hand it to the node, say how it ended. */
int main(void)
{
const v4_image *im = &v4_capsule_image;
unsigned char buf[256];
static char line[1026];
v4_boot boot;
boot.n = &n; boot.es = &es; boot.h = &h; boot.im = im; boot.out = console_out;
boot.n = &n; boot.es = &es; boot.h = &h; boot.im = &v4_capsule_image;
boot.out = console_out; boot.key = console_key;
if (!v4_boot_run(&boot, disk, BLOCKS)) { fflush(stdout); return 1; }
for (;;) {
(void)v4_exec_step_word(&n, &es, &h);
if (n.console_len) {
(void)fwrite(n.console, 1, n.console_len, stdout);
n.console_len = 0;
}
if (n.stopped) { fflush(stdout); fprintf(stderr, "starforth4: the node stopped on a fault\n"); return 1; }
if (v4_image_waiting(&n, im)) {
ssize_t got;
fflush(stdout);
got = read(0, buf, sizeof buf);
if (got <= 0) { putchar('\n'); return 0; }
(void)v4_node_console_feed(&n, buf, (unsigned)got);
}
size_t len;
int how;
fputs("ok> ", stdout);
fflush(stdout);
if (!fgets(line, sizeof line, stdin)) { putchar('\n'); return 0; }
len = strlen(line);
if (len && line[len - 1] == '\n') len--;
how = v4_boot_line(&boot, line, (unsigned)len);
if (how == V4_LINE_COMPLETED) fputs(" ok\n", stdout);
else if (how == V4_LINE_ERROR) fputs(" ERROR\n", stdout);
else if (how == V4_BOOT_LINE_TOO_LONG) fputs("Line too long\n ERROR\n", stdout);
else if (how == V4_BOOT_LINE_NO_INPUT) { putchar('\n'); return 0; }
else if (how == V4_BOOT_LINE_STOPPED) { fflush(stdout); fprintf(stderr, "starforth4: the node stopped on a fault\n"); return 1; }
}
}
v4/tools/mkimage.c
+6 -30
View File
@@ -4,7 +4,7 @@
*
* Runs on the build machine. It assembles capsule/ *.v4 -- the nucleus,
* docs/v4.0.0/NUCLEUS.md -- onto a host node with the memory map of
* tests/host_map.h and starts the node at its prompt. Then it writes every
* tests/host_map.h. It runs nothing: it writes every
* word of the node's memory that is not zero, and the addresses a loader
* needs, as a C file. No FORTH source is compiled here: what is not in the
* nucleus is loaded from capsules when the system boots (v4/system/boot.c).
@@ -22,11 +22,8 @@
#include "../tests/host_map.h"
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_text tx;
static v4_cell w_key, w_key_end;
static unsigned char disk[4 * V4_BLOCK_BYTES];
static void die(const char *what, const char *detail)
{
@@ -34,19 +31,6 @@ static void die(const char *what, const char *detail)
exit(1);
}
/* run until the node has taken all its input and is waiting in KEY */
static void run_until_waiting(void)
{
long steps = 0;
unsigned idle = 0;
while (idle < 64) {
if (++steps > 200000000L) die("the node did not come back to its prompt", NULL);
if (n.stopped) die("the node stopped on a fault", NULL);
(void)v4_exec_step_word(&n, &es, &h);
if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
}
}
/* every entry from xt back: no access control fields set */
static void clear_acl(v4_cell xt)
{
@@ -58,7 +42,7 @@ int main(int argc, char **argv)
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4",
"numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
FILE *out;
v4_cell k, entry, faults, voc;
v4_cell k, line, idle, faults, voc;
unsigned count = 0;
if (argc != 2) die("usage: mkimage OUTPUT.c", NULL);
@@ -66,7 +50,8 @@ int main(int argc, char **argv)
if (!host_load(&tx, &n, files, (unsigned)(sizeof files / sizeof files[0]))) die("the capsule does not assemble", NULL);
if (!v4_text_finish(&tx)) die("not everything is defined", v4_text_error(&tx));
if (v4_text_here(&tx) >= DICT_W) die("the capsule's code runs into the dictionary space", NULL);
entry = v4_text_word(&tx, "QUIT");
line = v4_text_word(&tx, "(LINE)");
idle = v4_text_word(&tx, "(IDLE)");
faults = v4_text_word(&tx, "(FAULTS)");
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR");
@@ -83,16 +68,6 @@ int main(int argc, char **argv)
n.mem[CURRENT] = LATEST;
n.mem[SRC] = TIB;
v4_exec_reset(&es);
v4_heat_reset(&h);
v4_node_console_attach(&n, CONSOLE_TX);
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
v4_node_error_attach(&n, NODE_ERROR);
v4_node_fault_attach(&n, faults);
v4_node_storage_attach(&n, STORAGE_REG, disk, 4);
n.p = entry;
run_until_waiting();
/* The nucleus is the system as COLD finds it: COLD comes back to here,
* and FORGET will not go below it. What the capsules add at boot
* (v4/system/boot.c) is above it. */
@@ -125,7 +100,8 @@ int main(int argc, char **argv)
}
fprintf(out, "};\n\nconst v4_image v4_capsule_image = {\n cells, %uu,\n %uu, %uu, %uu, %uu,\n", count,
(unsigned)V4_CELL_BITS, (unsigned)V4_NODE_WORDS, (unsigned)V4_DATA_RING, (unsigned)V4_RET_RING);
fprintf(out, " %ld, %ld,\n %ld, %ld,\n", (long)entry, (long)faults, (long)w_key, (long)w_key_end);
fprintf(out, " %ld, %ld, %ld,\n %ld, %uu, %ld,\n %ld,\n %ld, %ld,\n", (long)line, (long)idle, (long)LINE_STATUS,
(long)TIB, 1025u, (long)SPAN, (long)faults, (long)w_key, (long)w_key_end);
fprintf(out, " %ld, %ld, %ld,\n %ld, %ld,\n %ld,\n %ld,\n %ld, %ld\n};\n", (long)CONSOLE_TX, (long)CONSOLE_RX, (long)CONSOLE_ST,
(long)DSTACK_REG, (long)RSTACK_REG, (long)NODE_ERROR, (long)STORAGE_REG, (long)DP, (long)LATEST);
if (fclose(out) != 0) die("cannot write", argv[1]);