\ 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! ! ; \ ( 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, for an error, \ stops compiling first; 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 -- ) 1 (QUIET) a! ! \ from here an error is not this text's: see (RAISED) (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) if GO -1 + if OK drop (RESET) 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: 1 (QUIET) a! ! \ nothing here is any text's doing: see (RAISED) (PAY) \ what refusals can be sent now, are (core.v4) (MQ#) a! @ if WAIT drop jump HAVE WAIT: drop (OWED#) a! @ if BLOCK \ with one still owed it does not sleep: drop (WRITERS) b! @b if L0 \ it takes in whatever is being written to it, (LOW) (PORT) + dup b! @b (TAKE) jump L L0: drop jump L \ and tries again BLOCK: 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 \ for this node, and -3 + if NACK -1 + if GONE drop jump (IDLE) \ neither text nor these: let go NACK: drop (REFUSED) a! @ 1 + ! jump (IDLE) \ a message of this node's was refused: counted GONE: drop (MSG)+6 a! @ -4 + if G4 drop jump (IDLE) \ a node is gone, if its centre says so: G4: drop (CENTRE) if NOT (MSG)+1 a! @ xor if CENTRE drop jump (IDLE) NOT: drop jump (IDLE) CENTRE: drop TIB 2/ 2/ a! @ NO-ROUTE jump (IDLE) \ the way to it is forgotten 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)+3 a! @ if FRESH jump COUNT \ how many more nodes may pass it on; FRESH: drop 16 \ from a device, which set none: sixteen COUNT: -1 + if SPENT (MSG)+3 a! ! (MSG) a! @ (PORT-FOR) if NOWAY dup (THERE) if NOONE drop (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) NOONE: drop \ its way is a port with nothing on it SPENT: \ it has been passed on as often as it may be NOWAY: drop (LOST) a! @ 1 + ! (MSG)+1 a! @ (MSG) a! @ (MSG)+2 a! @ (TELL-OF) jump (IDLE) \ whoever waits on it is told (core.v4) \ ( -- ) 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 (QUIET) a! ! \ an error from here on is this text's 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! ! ; \ ( node -- ) forget the way to that node, if one is known: what is for it \ then goes by the way for every node not told of, if there is one. The \ last way in the table takes its place. header NO-ROUTE : NO-ROUTE (ROUTE#) a! @ if NONE -1 + (ROUTES) a! FOR dup @+ xor if HIT drop @+ drop NEXT drop ; NONE: drop drop ; HIT: drop drop pop drop a -1 + push \ where its entry is (ROUTE#) a! @ -1 + dup ! \ one way fewer 2* (ROUTES) + a! @+ @ \ the last entry: node port pop a! SWAP !+ ! ; \ ( about node type -- ) send the node a message of one word, `about`: \ a NACK is type 4, a GONE type 5 (MESH.md 7b). With no way to the node \ it is error 12. : (SEND1) push dup (PORT-FOR) if NOWAY (GATE) !b pop (HDR) 4 !b !b ; NOWAY: drop drop drop pop drop NODE-ERROR b! 12 !b ; \ ( n node -- ) tell the node that node n is gone. It acts on that only \ if this node is its centre: it forgets the way to n, and if it is waiting \ for n's answer the wait ends. header GONE : GONE 5 jump (SEND1) \ ( -- ) 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 ; \ ( -- n ) the number of this node's centre: the node on the port that \ leads to everything it has no other way to. 0: it has none, or has not \ been told who is there (NEIGHBOUR). : (CENTRE) (ROUTE-DEFAULT) a! @ if NONE (PORT) - (NEAR) + a! @ ; NONE: ; \ ( -- n ) the number of this node's console: the one it was told of, or \ with none told of, whoever sent the text it is doing : (A-CONSOLE) (CONSOLE) a! @ if C0 ; C0: drop (MSG)+1 a! @ ; \ THE MESSAGES WAITING, LOOKED THROUGH for what would end a wait. Each in \ turn is taken from the front: its eight cells into (MQ-HDR), (A-HDR). If \ it is the answer waited for, or a NACK or a believed GONE for this node, \ it is used up, as it would be had it come during the wait; otherwise it \ goes to the back, (A-BACK) and (A-TEXT), so that when all have been \ looked at they are in the order they were in. (A-LEFT) is how many \ cells are still to be looked at. (A-FOUND) is what was found first: 0 \ nothing, 1 the answer, its word in (A-WORD); 2 a NACK about the node \ waited for; 3 a GONE about it; 4 text from the console, which stays \ where it is to be done next. : (A-HDR) (MQ-HDR) a! 7 FOR a push (MQ@) pop a! !+ NEXT ; : (A-BACK) (MQ-HDR) a! 7 FOR @+ a push (MQ!) pop a! NEXT ; : (A-TEXT) if NONE -1 + FOR (MQ@) (MQ!) NEXT ; NONE: drop ; : (A-QUEUE) 0 (A-FOUND) a! ! (MQ#) a! @ (A-LEFT) a! ! L: (A-LEFT) a! @ if END drop (A-HDR) (MQ-HDR)+6 a! @ -if SIZED drop 0 jump N SIZED: 3 + 2/ 2/ N: (A-LEFT) a! @ over 8 + - ! \ n: its words of text (A-FOUND) a! @ if LOOK drop jump KEEP \ something is found: the rest only go round LOOK: drop (MQ-HDR) a! @ (ME) a! @ xor if MINE drop jump KEEP MINE: drop (MQ-HDR)+2 a! @ -1 + if TEXT -2 + if ANS -1 + if NACK -1 + if GONE drop jump KEEP TEXT: drop (A-CONSOLE) (MQ-HDR)+1 a! @ xor if BRK drop jump KEEP BRK: drop 4 (A-FOUND) a! ! jump KEEP ANS: drop (MQ-HDR)+1 a! @ (AWAIT-FROM) a! @ xor if A1 drop jump KEEP A1: drop dup -1 + if A2 drop jump KEEP A2: drop drop (MQ@) (A-WORD) a! ! 1 (A-FOUND) a! ! jump L NACK: drop dup -1 + if N2 drop jump KEEP N2: drop drop (MQ@) (AWAIT-FROM) a! @ xor if N3 drop (REFUSED) a! @ 1 + ! jump L N3: drop 2 (A-FOUND) a! ! jump L GONE: drop dup -1 + if G2 drop jump KEEP G2: drop (CENTRE) if NOC (MQ-HDR)+1 a! @ xor if G3 drop jump KEEP NOC: drop jump KEEP G3: drop drop (MQ@) dup NO-ROUTE (AWAIT-FROM) a! @ xor if G4 drop jump L G4: drop 3 (A-FOUND) a! ! jump L KEEP: (A-BACK) (A-TEXT) jump L END: drop ; \ ( what -- how | ) the wait is over, by what (A-FOUND) says: the answer's \ word is left; anything else is an error : (A-END) 0 (AWAIT-FROM) a! ! -1 + if ANS -1 + if REF -1 + if LEFT drop NODE-ERROR b! 21 !b ; ANS: drop (A-WORD) a! @ ; REF: drop NODE-ERROR b! 19 !b ; LEFT: drop NODE-ERROR b! 20 !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. (AWAIT-FROM) holds the \ node while it waits, and 0 otherwise. \ THE WAIT ALSO ENDS, in an error, when the answer is not going to come \ (MESH.md section 7b): a NACK about that node, error 19, Message refused; \ or a GONE about it from this node's centre, error 20, Node gone. A NACK \ about another node is counted, and a GONE about another has its way \ forgotten, as they would be if this node were not waiting. A GONE is \ believed only if this node's centre sent it: (CENTRE). \ WHAT HAS COME ALREADY is looked through first, (A-QUEUE): the answer, a \ NACK or a GONE may have been taken in before the wait began, while this \ node was waiting to write, and is then with the messages waiting. \ AND A LINE FROM THE CONSOLE BREAKS IT (7b.6): text for this node from its \ console is kept, as any message is, the wait ends in error 21, \ Interrupted, and the text is then done as usual. It is the one way to \ end a wait on a node that is alive and never answers, short of Hera's \ killing that node. header AWAIT : AWAIT (AWAIT-FROM) a! ! (A-QUEUE) (A-FOUND) a! @ if WAIT jump (A-END) WAIT: drop L: (ROOM) \ before a first word is read: core.v4 (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! @ \ for this node: its type -1 + if TEXT -2 + if ANSWER -1 + if NACK -1 + if GONE drop jump KEEP TEXT: drop (A-CONSOLE) (MQ-HDR)+1 a! @ xor if BREAK drop jump KEEP \ text: from the console? BREAK: drop (TAKE-KEEP) 4 jump (A-END) \ kept, to be done next; and the wait is over ANSWER: 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 0 (AWAIT-FROM) a! ! @b ; \ its one word NACK: drop (MQ-HDR)+6 a! @ -4 + if N4 drop jump KEEP N4: drop @b (AWAIT-FROM) a! @ xor if REFUSED \ about the node waited for? drop (REFUSED) a! @ 1 + ! jump L \ another: counted REFUSED: drop 2 jump (A-END) GONE: drop (MQ-HDR)+6 a! @ -4 + if G4 drop jump KEEP G4: drop @b \ the node that is gone (CENTRE) if NOC (MQ-HDR)+1 a! @ xor if CENTRE \ only its centre is believed drop drop jump L NOC: drop drop jump L CENTRE: drop dup NO-ROUTE (AWAIT-FROM) a! @ xor if LEFT drop jump L LEFT: drop 3 jump (A-END) 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 (ME) inline : (ME)' (ME) ; header (CONSOLE) inline : (CONSOLE)' (CONSOLE) ; header (LOST) inline : (LOST)' (LOST) ; header (REFUSED) inline : (REFUSED)' (REFUSED) ; header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ; header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ; 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. \ (QUIET) is 1 while the node is doing something that is no text's doing: \ paying a refusal, passing a message on, or sending word of how a text \ ended. An error then has nobody to be told to -- the usual one is that \ no one is on the port (18) -- and trying to tell it would raise it again \ without end. So it is not told: what was being sent is let go and \ counted, and the node goes back to waiting. : (RAISED) (QUIET) a! @ if SPEAK drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! jump (IDLE) SPEAK: drop 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 -1 + if M18 -1 + if M19 -1 + if M20 -1 + if M21 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) M18: drop (OUT) (OUT^) a! ! \ what was printed and not sent cannot be sent: it is let go $6F206F4E (EMIT4) $6F20656E (EMIT4) $6874206E (EMIT4) $70207461 (EMIT4) $74726F (EMIT4) CR 2 jump (DONE) M19: drop $7373654D (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (EMIT4) CR 2 jump (DONE) M20: drop $65646F4E (EMIT4) $6E6F6720 (EMIT4) $65 (EMIT4) CR 2 jump (DONE) M21: drop $65746E49 (EMIT4) $70757272 (EMIT4) $646574 (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@