rajamesandClaude Opus 5.5
d5b7235464
A block is a kernel request, as ENGINE.md 3.3 has it: the node puts the
block's number and the address of 256 cells on its stack and writes the
request to port 0, and the kernel leaves the status there. The requests
are -1, read, and -2, write, the same for every node. v4/system/blocks.c
serves them from the kernel's block subsystem, which is v3's. The four
storage registers are gone from the engine.
The device that spoke block messages (4a505a15) is withdrawn with its
test and its message types: Captain Bob ruled on 2026-10-07 that it, a
node's own drive, and nodes with no storage had left the OS as designed
(docs/v4.0.0/MESH.md 8.5).
Hera no longer sends POST to the nodes she births: POST is the kernel's,
once. Every node has its kernel on port 0; it serves a node's blocks and,
for Hera alone, her requests for nodes and capsules.
Bare metal: the node boots and is POSTed against POST's own block RAM,
and the kernel's chain -- fast RAM, the ramdrive, the virtio disk -- is
set up after POST and before the prompt, as on the v3 path. The disk is
read and not written: nothing in v4 yet gives the owner's word that it
may be formatted. A hosted program has the chain's fast RAM, as hosted
v3 has with no disk. Error 17 is Storage refused.
make -C v4 test and sanitize pass at both widths; hosted-check passes on
three ISAs; amd64, aarch64 and riscv64 boot, POST 538 of 538, with the
typed session: logs/20261007-081603, -081839, -082226. The hashes are
the same on all six.
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
405 lines
19 KiB
Plaintext
405 lines
19 KiB
Plaintext
\ 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.
|
|
\
|
|
\ A NODE IS SENT TEXT (docs/v4.0.0/MESH.md section 6). It does not read its
|
|
\ own command line and prints no prompt. A node with nothing to do waits at
|
|
\ its ports; a neighbour writes it a message; if that is text for this node
|
|
\ it is interpreted; what it printed goes back as a message, and then a
|
|
\ message saying how the text ended:
|
|
\ 1 it completed a console says " ok"
|
|
\ 2 it ended in an error the message is already printed; " ERROR"
|
|
\ 0 QUIT nothing is said
|
|
\ What a console then shows is v3's:
|
|
\ ok> 65 EMIT the console's prompt, and the line
|
|
\ A ok what the line printed, then " ok"
|
|
\ ok> NOSUCH
|
|
\ UNKNOWN WORD: 'NOSUCH'
|
|
\ ERROR
|
|
\ ok> -1 @
|
|
\ Address out of range an address fault (D-14), from any depth
|
|
\ ERROR
|
|
\ KEY, EXPECT and QUERY are FORTH-79 words that read characters, as before;
|
|
\ they are not how text reaches the node. They still read the console's
|
|
\ registers, CONSOLE-RX and CONSOLE-STATUS, and not a message.
|
|
\
|
|
\ 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
|
|
\ never return to whatever ran them, must empty the return stack, and ABORT
|
|
\ 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 text ended
|
|
\ (MSG) (REPLY) (ME) (OUT) (OUT^) see core.v4, "what a node prints"
|
|
\ (PORT) word address of the node's port 0; (PORT)+8 is "any port" and
|
|
\ (PORT)+9 the port the last read from that came on
|
|
\ (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
|
|
|
|
\ ( -- ) empty the return stack. `a` is only something to store: any
|
|
\ store to the register empties the stack, and `a` needs nothing to be on
|
|
\ the data stack. One cell of the data stack is used for a moment.
|
|
macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
|
|
|
|
\ ( -- ) stop compiling; forget the word being built and any open control
|
|
\ structures. A definition that was under way stays hidden.
|
|
: (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ;
|
|
|
|
\ 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 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.
|
|
\
|
|
\ ( s -- ) the text is done with. What it printed is sent, then a message
|
|
\ saying how it ended -- 0 QUIT, 1 completed, 2 an error -- and the node waits
|
|
\ for the next. (DONE) is entered with the same number and decides whether
|
|
\ an error was one to catch; it is always jumped to, never called, by
|
|
\ something that has emptied the return stack (or by a fault, which empties
|
|
\ it). (LINE-STATUS) keeps how the last text ended.
|
|
: (FINISH) ( s -- )
|
|
(LINE-STATUS) b! dup !b
|
|
(FLUSH-OUT)
|
|
(DONE-PORT) a! @ (GATE) (MSG)+1 a! @ !b \ to whoever sent the text
|
|
3 (HDR) 4 !b !b \ a message of type 3, four characters long: how it ended
|
|
jump (IDLE)
|
|
|
|
: (DONE)
|
|
(EMIT-HOOK) b! 0 !b \ what is printed is printed again
|
|
if GO -1 + if OK
|
|
drop (RESET)
|
|
(CATCH) b! @b if LOUD drop -1 !b 1 jump (DONE) \ caught: the text completed
|
|
LOUD: drop 2 jump (FINISH)
|
|
OK: drop 1 jump (FINISH)
|
|
GO: drop 0 jump (FINISH)
|
|
|
|
\ ( -- ) WAITING. A node with nothing to do deals with the oldest of the
|
|
\ messages waiting (core.v4). With none waiting it is blocked reading its
|
|
\ ports (docs/v4.0.0/MESH.md 4.1): it executes nothing until a neighbour
|
|
\ writes, and what arrives is taken in as any message is, its first word
|
|
\ from any port and the rest from the port that came on. The message's
|
|
\ text goes into TIB, which holds 1024 characters, the most a message
|
|
\ carries; one that came with a length no message has is error 12. A
|
|
\ message of type 1 for this node is text to interpret: it is done as a
|
|
\ line was, and (FINISH) reports how it ended. A message for another node
|
|
\ is passed on, (PASS-ON).
|
|
: (IDLE)
|
|
L: (MQ#) a! @ if WAIT drop jump HAVE
|
|
WAIT: drop (PORT)+8 b! @b (PORT)+9 b! @b (PORT) + dup b! \ ( to port ) B: the port it came on
|
|
SWAP (TAKE) jump L
|
|
HAVE:
|
|
(MQ@) (MSG) a! ! (MQ@) (MSG)+1 a! ! (MQ@) (MSG)+2 a! ! (MQ@) (MSG)+3 a! !
|
|
(MQ@) (MSG)+4 a! ! (MQ@) (MSG)+5 a! ! (MQ@) (MSG)+6 a! ! (MQ@) (REPLY) a! !
|
|
(MSG)+6 a! @ -if SIZED
|
|
drop 0 (MSG)+6 a! ! 0 SPAN a! ! NODE-ERROR b! 12 !b \ no telling what it was
|
|
SIZED: drop
|
|
TIB 2/ 2/ (MSG)+6 a! @ 3 + 2/ 2/ if EMPTY
|
|
-1 + FOR (MQ@) over a! ! 1 + NEXT
|
|
drop jump READ
|
|
EMPTY: drop drop
|
|
READ:
|
|
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
|
|
(MSG)+6 a! @ SPAN a! !
|
|
(MSG) a! @ (ME) a! @ xor if MINE drop jump (PASS-ON)
|
|
MINE: drop
|
|
(MSG)+2 a! @ -1 + if TEXT drop jump (IDLE) \ for this node and not text: let go
|
|
TEXT: drop
|
|
(MSG)+1 a! @ (PORT-FOR) if D0 jump D1 \ the way back to whoever sent it:
|
|
D0: drop (REPLY) a! @ \ the port it came on, if no other is known
|
|
D1: (DONE-PORT) a! !
|
|
(CONSOLE) a! @ if P0 jump P1 \ where what it prints goes: the console,
|
|
P0: drop (MSG)+1 a! @ \ or whoever sent it
|
|
P1: dup (PRINT-TO) a! !
|
|
(PORT-FOR) if Q0 jump Q1
|
|
Q0: drop (REPLY) a! @
|
|
Q1: (PRINT-PORT) a! !
|
|
jump (LINE)
|
|
|
|
\ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): all
|
|
\ of it, as it came, to the port that leads toward that node. With no way
|
|
\ known it is let go, and (LOST) counts it.
|
|
: (PASS-ON)
|
|
(MSG) a! @ (PORT-FOR) if NOWAY
|
|
(GATE) (MSG) a! 6 FOR @+ !b UNEXT \ its seven words
|
|
(MSG)+6 a! @ 3 + 2/ 2/ if SENT
|
|
-1 + TIB 2/ 2/ a! FOR @+ !b UNEXT \ and its text
|
|
jump (IDLE)
|
|
SENT: drop jump (IDLE)
|
|
NOWAY: drop (LOST) a! @ 1 + ! jump (IDLE)
|
|
|
|
\ ( -- ) THE TEXT, INTERPRETED. It is in TIB with a zero after it and its
|
|
\ length in SPAN, and the return stack is empty. It 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
|
|
TIB (SRC) a! ! 0 >IN a! !
|
|
0 NODE-ERROR b! !b
|
|
INTERPRET
|
|
NODE-ERROR b! @b if GOOD
|
|
drop 2 jump (DONE)
|
|
GOOD: drop 1 jump (DONE)
|
|
|
|
\ ---- the node among others (MESH.md sections 6 and 7) ---------------------------
|
|
\ Not FORTH-79 and not in v3: v3's VMs are sent to through the kernel.
|
|
|
|
\ ( node port -- ) the port, by its number, leads toward that node
|
|
header ROUTE
|
|
: ROUTE
|
|
(ROUTE#) a! @ -16 + if FULL drop
|
|
(PORT) + (ROUTE#) a! @ 2* (ROUTES) + a!
|
|
push !+ pop !+
|
|
(ROUTE#) a! @ 1 + ! ;
|
|
FULL: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( node port -- ) the node on the other end of the port, by its number;
|
|
\ 0: none, or a device. Whoever wires the node tells it, and tells it again
|
|
\ when the wiring changes. It is what lets one of two neighbours, and one
|
|
\ only, wait to write to the other (core.v4, (GATE)).
|
|
header NEIGHBOUR
|
|
: NEIGHBOUR
|
|
dup -if POS jump BAD
|
|
POS: -PORTS + -if BAD drop (NEAR) + a! ! ;
|
|
BAD: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( port -- ) the port, by its number, leads toward every node not told of
|
|
header DEFAULT-ROUTE
|
|
: DEFAULT-ROUTE (PORT) + (ROUTE-DEFAULT) a! ! ;
|
|
|
|
\ ( -- ) forget every way: for when the wiring has changed
|
|
header NO-ROUTES
|
|
: NO-ROUTES 0 (ROUTE#) a! ! 0 (ROUTE-DEFAULT) a! ! ;
|
|
|
|
\ ( baddr u node port -- ) send the node u characters of text to
|
|
\ interpret, by the port given, by its address. It is on its way when this
|
|
\ returns. The write waits for the neighbour to read, and is not begun
|
|
\ until it may be (core.v4, (GATE)).
|
|
: (SEND-ON)
|
|
(GATE) !b \ to
|
|
1 (HDR)
|
|
dup !b \ length
|
|
3 + 2/ 2/ if NONE -1 +
|
|
FOR dup C@ over 1 + C@ 8* + over 2 + C@ 8* 8* + over 3 + C@ 8* 8* 8* + !b 4 + NEXT
|
|
drop ;
|
|
NONE: drop drop ;
|
|
|
|
\ ( baddr u node -- ) send the node u characters of text to interpret,
|
|
\ by the way this node knows to it. What it prints there goes to that
|
|
\ node's console. With no way to the node it is error 12.
|
|
header SEND
|
|
: SEND
|
|
dup (PORT-FOR) if NOWAY jump (SEND-ON)
|
|
NOWAY: drop drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( baddr u node port -- ) the same by a port this node names, by its
|
|
\ number, whatever ways it knows: for a neighbour that has no number of
|
|
\ its own yet, to which text is sent as to node 0.
|
|
header SEND-ON
|
|
: SEND-ON
|
|
dup -if POS jump BAD
|
|
POS: -PORTS + -if BAD drop (PORT) + jump (SEND-ON)
|
|
BAD: drop drop drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( node -- how ) WAIT FOR THE NODE'S WORD OF HOW TEXT ENDED: 0 QUIT,
|
|
\ 1 completed, 2 an error. This node is blocked reading its ports until a
|
|
\ message of type 3 comes for it from that node; every other message that
|
|
\ comes meanwhile is kept with the messages waiting. It waits for ever
|
|
\ for a node that never answers.
|
|
header AWAIT
|
|
: AWAIT
|
|
(AWAIT-FROM) a! !
|
|
L: (PORT)+8 b! @b (PORT)+9 b! @b (PORT) + dup b! SWAP (TAKE-HDR)
|
|
(MQ-HDR) a! @ (ME) a! @ xor if A1 drop jump KEEP
|
|
A1: drop (MQ-HDR)+2 a! @ -3 + if A2 drop jump KEEP
|
|
A2: drop (MQ-HDR)+1 a! @ (AWAIT-FROM) a! @ xor if A3 drop jump KEEP
|
|
A3: drop (MQ-HDR)+6 a! @ -4 + if A4 drop jump KEEP
|
|
A4: drop @b ; \ its one word
|
|
KEEP: (TAKE-KEEP) jump L
|
|
|
|
\ ( w port -- ) write a cell to the port, by its number. It waits until
|
|
\ the neighbour has taken it. This is how a node is sent a capsule of F18
|
|
\ code (docs/v4.0.0/MESH.md section 5): the cells go as they are, not as a
|
|
\ message, to a node that is executing from its ports.
|
|
header PORT!
|
|
: PORT!
|
|
dup -if POS jump BAD
|
|
POS: -PORTS + -if BAD drop (PORT) + b! !b ;
|
|
BAD: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( -- ) WHAT IS IN THE DICTIONARY NOW IS THE SYSTEM: COLD comes back to
|
|
\ it and FORGET will not go below it. Whoever has loaded a node's capsules
|
|
\ has it do this (system.v4, (BOOT) and FENCE).
|
|
header (SEAL)
|
|
: (SEAL)
|
|
DP a! @ (BOOT) a! !
|
|
(LATEST) a! @ (BOOT)+1 a! !
|
|
DP a! @ 3 + 2/ 2/ FENCE a! ! ;
|
|
|
|
\ 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.
|
|
\ NODE-ERROR, by name: how a definition written in FORTH raises an error.
|
|
\ A store of a code that is not zero is the trap of D-18 -- the word goes no
|
|
\ further, the message for the code is printed (-1: the word has printed
|
|
\ its own) and the line ends with ERROR. The codes are listed in core.v4.
|
|
header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ;
|
|
header (CATCH) inline : (CATCH)' (CATCH) ;
|
|
header (ME) inline : (ME)' (ME) ;
|
|
header (CONSOLE) inline : (CONSOLE)' (CONSOLE) ;
|
|
header (LOST) inline : (LOST)' (LOST) ;
|
|
header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ;
|
|
header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ;
|
|
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
|
|
|
|
header QUIT
|
|
: 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 (DONE)
|
|
|
|
\ ---- faults (D-14, D-16) -------------------------------------------------------
|
|
\ Where the node goes when a programme uses an address outside its memory,
|
|
\ pushes onto a full stack or pops an empty one. The opcode that faulted did
|
|
\ nothing, and both stacks have been emptied. Each handler says what happened;
|
|
\ whatever was running is abandoned, as by ABORT, and the line ends with
|
|
\ ERROR.
|
|
: (FAULT) \ "Address out of range"
|
|
$72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (D-OVER) \ "Stack overflow"
|
|
$63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (D-UNDER) \ "Stack underflow"
|
|
$63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-OVER) \ "Return stack overflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-UNDER) \ "Return stack underflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
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
|
|
\ its own -- and end the line with ERROR. The return stack has been
|
|
\ emptied; the data stack is as the word left it.
|
|
: (RAISED)
|
|
NODE-ERROR b! @b
|
|
-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 -1 + if M17
|
|
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)
|
|
M17: drop $726F7453 (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (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
|
|
\ are one after another.
|
|
: (FAULTS)
|
|
jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED)
|
|
|
|
\ ---- text in the source ---------------------------------------------------------
|
|
\ The three run-time words have names, as v3's have, so that SEE can tell a
|
|
\ string in a definition from code; they cannot be used from the prompt.
|
|
\ ." and ABORT" take the text up to the next " , which may be none at all
|
|
\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay
|
|
\ down a call to their run-time word and, after it, the text as a counted
|
|
\ string: the count byte and the characters, four to a cell, the last cell
|
|
\ filled with zeros. The run-time word finds the string by the return
|
|
\ address the call left, and returns to the cell after the string.
|
|
|
|
\ ( -- ) lay the counted string in WBUF into the dictionary, as above.
|
|
\ (Q)+0 how many bytes are still to go, (Q)+1 which is next.
|
|
: (STRING,)
|
|
(FLUSH)
|
|
WBUF C@ 1 + (Q) a! ! 0 (Q)+1 a! !
|
|
L: (Q) a! @ if DONE -1 + !
|
|
(Q)+1 a! @ dup 1 + ! WBUF + C@ C,
|
|
jump L
|
|
DONE: drop
|
|
P: DP b! @b 3 and if ALIGNED drop 0 C, jump P
|
|
ALIGNED: drop ;
|
|
|
|
\ The run time of ." : print the string after the call, go on after it.
|
|
\ It takes the return address off before it calls anything and keeps the
|
|
\ count there instead, so a word that prints text goes no deeper than one
|
|
\ that calls any other word.
|
|
header (.") compile-only
|
|
: (.")
|
|
pop 4* dup C@ \ baddr n
|
|
L: if DONE
|
|
push 1 + dup C@ EMIT pop -1 + jump L
|
|
DONE: drop 4/ 1 + push ; \ the cell after the last character
|
|
|
|
\ FORTH-79: ." text" prints the text -- now, if interpreting; when the word
|
|
\ it is compiled into runs, if compiling.
|
|
header ." immediate
|
|
: DOT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(.") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF COUNT jump TYPE
|
|
|
|
\ ( flag -- ) the run time of ABORT" : if the flag is not zero print the
|
|
\ string after the call, start a new line and ABORT; otherwise go on after
|
|
\ the string.
|
|
header (ABORT") compile-only
|
|
: (ABORT")
|
|
if NO
|
|
drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT
|
|
NO: drop pop 4* dup C@ + 4/ 1 + push ;
|
|
|
|
\ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if
|
|
\ the flag is not zero, print the text and ABORT.
|
|
header ABORT" immediate
|
|
: ABORT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(ABORT") (CALL,) jump (STRING,)
|
|
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.
|
|
header (S") compile-only
|
|
: (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@
|