\ core.v4 -- the core words the host-node capsules rest on. \ \ Each is the definition DECOMPOSITION.md gives and the golden-model tests \ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c), \ written here as text for the text assembler (v4/include/v4/text.h). \ \ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX, \ CONSOLE-RX, CONSOLE-STATUS, BASE, (MSG), (REPLY), (ME), (OUT), \ (OUT^), (CONSOLE), (ROUTES), (ROUTE#), (ROUTE-DEFAULT), (PRINT-TO), \ (PRINT-PORT). \ \ ERRORS (D-18). A word that finds an error takes its arguments off the stack \ and stores a code in NODE-ERROR. On a node with a prompt that store is a \ trap: the word goes no further, and the prompt prints the message for the \ code and ERROR (quit.v4, (RAISED)). The codes: \ 1 Negative count 2 Not a number 3 Number too long \ 4 Not a character 5 Dictionary full 6 Name missing \ 7 Control structure mismatch 8 Control structures too deep \ 9 Shift count out of range 10 Protected word \ 11 Division by zero (Q./) 12 Argument out of range \ 13 Block out of range 14 No block is being loaded \ 15 Deferred word not set 16 Not a word \ 17 Storage refused 18 No one on that port \ 19 Message refused 20 Node gone \ 21 Interrupted \ -1 the word has printed its own message macro SWAP over push push drop pop pop endmacro macro - push inv pop + inv endmacro \ x y -- x-y macro NEGATE inv 1 + endmacro macro NIP push drop pop endmacro \ ---- section 4: multiply ------------------------------------------------ header UM* : UM* ( u1 u2 -- ulo uhi ) over 1 and inv 1 + over 2/ and \ u1 u2 t0 t0 = u2 2/ if u1 odd over a! N-1 push \ A: u2 R: loop count push over 2/ pop \ u1 u2 s t0 s = u1 2/ L: +* unext \ u1 u2 s hi A: lo push drop pop \ u1 u2 hi 2* a -if L0 drop 1 + jump L1 L0: drop L1: push over -if L2 drop dup jump L3 L2: drop 0 L3: push dup -if L4 drop over 1 and jump L5 L4: drop 0 L5: pop + pop + push and 1 and a 2* + pop ; \ ---- section 5.7: doubles ------------------------------------------------ header D+ : D+ ( d1 d2 -- d3 ) push over push push drop pop \ al bl R: bh ah over over xor -if L1 drop + -if C1 jump C0 L1: drop over -if L2 drop + jump C1 L2: drop + C0: pop pop + ; C1: pop pop + 1 + ; header DNEGATE : DNEGATE ( d -- -d ) inv over if L1 drop push inv 1 + pop ; L1: drop 1 + ; \ ---- section 5.3: bytes -------------------------------------------------- \ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has \ a FOR ... UNEXT loop: a loop keeps its count on the return stack, and C@ and \ C! are at the bottom of every chain of calls in the compiler capsule, where \ there is not an entry to spare (D-2). The result is the same. macro 8/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ endmacro macro 8* 2* 2* 2* 2* 2* 2* 2* 2* endmacro header C@ : C@ ( baddr -- c ) dup 2/ 2/ a! 3 and if K0 -1 + if K1 -1 + if K2 drop @ 8/ 8/ 8/ 255 and ; K2: drop @ 8/ 8/ 255 and ; K1: drop @ 8/ 255 and ; K0: drop @ 255 and ; header C! : C! ( c baddr -- ) dup 2/ 2/ a! 3 and if K0 -1 + if K1 -1 + if K2 drop 8* 8* 8* 4278190080 and @ 4278190080 inv and + ! ; K2: drop 8* 8* 16711680 and @ -16711681 and + ! ; K1: drop 8* 65280 and @ -65281 and + ! ; K0: drop 255 and @ -256 and + ! ; \ ---- section 5.9: strings ------------------------------------------------ header CMOVE : CMOVE ( src dst u -- ) -if OK drop drop drop NODE-ERROR b! 1 !b ; OK: if DONE push over C@ over C! 1 + push 1 + pop pop -1 + jump OK DONE: drop drop drop ; \ ---- section 5.10: the console ------------------------------------------- \ ---- what a node prints (docs/v4.0.0/MESH.md section 6) ------------------------ \ A node has no console of its own. It does what a message asks, and what \ it prints while doing it is sent as a message: to the node in (CONSOLE), or \ if that is 0 to whoever sent the text; by the port that leads there, or if \ this node knows of none, by the port the text came on. A message is seven words and then its text, four \ characters to a word: \ to, from, type, heat and TTL, ACL tag, sequence, length in characters \ The types: 1 text to be interpreted 2 what a node printed 3 how the \ text ended (one word of text: 0 QUIT, 1 completed, 2 an error). \ The header of the text being served is in the seven cells (MSG); (REPLY) \ is the port it came on, by its number; (ME) is this node's number. \ \ Characters are kept in (OUT), 256 of them, a character to a cell, and sent \ when it is full and when the text has been done with (quit.v4). (OUT^) \ is where the next goes. \ \ THE STACK. What prints may be run with the data stack all but full: EMIT \ has always needed one free cell and no more, and still does -- it keeps \ the character and A on the return stack while it works. Sending needs \ three. \ FINDING THE WAY (MESH.md section 7). A node knows its ports and nothing of \ the shape they are wired in. Whoever wires it tells it, for a node, which \ port leads toward that node: the table (ROUTES), (ROUTE#) entries of a \ node's number and a port's address; and (ROUTE-DEFAULT), the port for any \ node that is not in the table, or 0. \ ( node -- port | -1 ) the port, by its number, that leads toward the node : (WAY) (ROUTE#) a! @ if NONE -1 + (ROUTES) a! FOR dup @+ xor if HIT drop @+ drop NEXT 0 NONE: drop drop (ROUTE-DEFAULT) a! @ if NOWAY (PORT) - ; NOWAY: drop -1 ; HIT: drop drop @+ pop drop (PORT) - ; \ WHOLE MESSAGES (MESH.md section 7d). A message waits on a wire, in the \ fabric, and not in a node: each wire has a queue of whole messages each \ way. A node asks the fabric to look at one, take it, move it to another \ wire, drop it, or put one on, by the six addresses after its ports: \ (WIRE) the port, by its number, that what follows is about \ (WIRE-A) (WIRE-B) what the operation needs \ (WIRE-DO) the operation: a store here is the asking \ (WIRE-HOW) how it went: 0 done, 1 no room, 2 no one on that port, \ 3 no such message, 4 not a message \ (WIRE-HAVE) which wires have a message waiting, a bit to a port \ The operations: 1 look 2 take 3 move 4 drop 5 put 6 first 7 next \ 8 sleep 9 sleep for room 10 room. Each is whole: all of a message \ moves or none of it. So a fault or an error in the middle of anything \ here leaves no message half moved; and nothing here keeps, from one \ operation to the next, anything a later pass does not set again for \ itself: every pass over a wire begins by naming the wire and putting its \ mark at its first message. \ This replaced a ring of messages waiting in the node's own memory, a \ list of refusals owed, and messages written and read a word at a time \ (MESH.md 7a, 7b, 7c.6). The ports themselves are still written a word at \ a time for the two things that are not messages: a newborn node's \ nucleus (PORT!, quit.v4) and a node's requests to its kernel. \ \ THE STACKS. All of this runs on the stacks the node's text is using. \ (SERVE) and what it calls keep to four cells of the data stack and four \ entries of the return stack, its own call among them; what they need \ from one operation to the next is in cells. (ROOM-SERVE) tries that much. \ ( op -- how ) ask the fabric for the operation, and say how it went : (DO) (WIRE-DO) b! !b (WIRE-HOW) b! @b ; \ ( port -- ) what is asked next is about that port's wire, by its number. \ A number that is no port's is no wire: every operation then answers 2. : (WIRE!) (WIRE) b! !b ; \ ( cells port -- how ) has the port's wire that many cells free? 0: it \ has; 1: it has not; 2: no one is on that port. Only this node puts \ messages on the wires that lead from it, so room found stays until it \ uses it. : (ROOM?) (WIRE!) (WIRE-A) b! !b 10 jump (DO) \ ( -- ) ROOM FOR WHAT A WAIT DOES. A node that waits within text -- for \ an answer, or for room to print -- passes on meanwhile what comes for \ other nodes, on the stacks the text has left it: four cells of the data \ stack and four entries of the return stack, (SERVE)'s. They are tried \ before anything is taken off a wire or put on one: if they are not there \ the fault comes here, and the text ends "Stack overflow" with nothing \ half done (MESH.md 7c.7, 7d.4). \ (ROOM-SERVE) tries just those, and is what a wait for room does each time \ a message wakes it. (ROOM), which AWAIT does once before it waits, tries \ six cells, as it did when a message was read a word at a time: the wait \ ends in an error that leaves the stack as it is, and the line from the \ console that broke it is then done on that stack, where printing needs \ six (MESH.md 7c.7). : (ROOM-SERVE) 0 0 0 0 drop drop drop drop 0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ; : (ROOM) 0 0 0 0 0 0 drop drop drop drop drop drop 0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ; \ ( to type -- ) the first six words of a message this node puts, in \ (OUT-HDR): to, from, type, and the three that are carried: how many nodes \ may pass it on, sixteen (the TTL: MESH.md 7b.3); ACL tag; sequence. : (HDR) push (OUT-HDR) a! !+ (ME) b! @b !+ pop !+ 16 !+ 0 !+ 0 !+ ; \ ( text port -- how ) put the message whose seven words are in (OUT-HDR) \ and whose text is at the word address given on the wire of the port, by \ its number. How it went is the fabric's answer: 0 it is on the wire. \ THE ROOM KEPT FOR AN ANSWER. While this node does text, (KEEP) is the \ port its word of how the text ended will go by, and nothing else it puts \ on that wire may take the last 8 cells: a message that would is refused \ here, 1, as if the wire were full. With no text being done (KEEP) is -1. : (PUT-ON) push (WIRE-B) b! !b pop dup (WIRE!) (KEEP) a! @ xor if KEPT GO: drop (OUT-HDR) (WIRE-A) b! !b 5 jump (DO) KEPT: drop (OUT-HDR)+6 a! @ 3 + 2/ 2/ 15 + (WIRE-A) b! !b 10 (DO) if GO ; \ REFUSALS (MESH.md 7b, 7d.4). A message this node cannot pass on is \ dropped and counted in (LOST), and whoever waits on it is told, by a \ message of type 4, a NACK, whose one word is the node the refused message \ was for: its sender; or, for a node's answer (type 3), the node the \ answer was for, which is the one that waits, about the node that \ answered. The NACK is put at once. If it cannot go -- no way, no one on \ the port, no room -- it is counted in (LOST) too, and that is the end of \ it. Nothing is told for a NACK or for a GONE, type 5: there is no NACK \ for a NACK. \ ( -- ) the message the mark of the wire in (WIRE) is at, whose seven \ words are in (IN), is refused. A refusal for this node itself -- its own \ message came back to it -- is counted in (REFUSED) as one that came by a \ wire would be; or, if it is about the node this one is waiting on, \ (A-SELF) is set for AWAIT to find (quit.v4). \ (WIRE) is not what it was afterwards: the NACK went by another. \ If the drop does not drop -- the wire was cut after the message was looked \ at, which let it go already -- nothing is counted and no one is told. : (REFUSE) 4 (DO) if DROPPED drop ; \ it was not there to drop -- its wire has been cut: nothing is counted or told DROPPED: drop (LOST) a! @ 1 + ! (IN)+2 a! @ -4 + if NOT -1 + if NOT 2 + if ANSWER drop (IN) a! @ (ONE) a! ! (IN)+1 a! @ jump TELL \ about whom it was for; to its sender ANSWER: drop (IN)+1 a! @ (ONE) a! ! (IN) a! @ \ about the node that answered; to whom the answer was for TELL: dup (ME) a! @ xor if SELF drop dup 4 (HDR) 4 (OUT-HDR)+6 a! ! (WAY) (ONE) SWAP (PUT-ON) if SENT drop (LOST) a! @ 1 + ! ; SENT: drop ; SELF: drop drop (AWAIT-FROM) a! @ if COUNT (ONE) a! @ xor if MINE COUNT: drop (REFUSED) a! @ 1 + ! ; MINE: drop 1 (A-SELF) a! ! ; NOT: drop ; \ ( port -- bit ) the bit for a port, by its number, in a word of a bit to a port : (WBIT) push 1 pop if Z -1 + FOR 2* NEXT ; Z: drop ; \ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): the \ one the mark of the wire in (WIRE) is at, whose seven words are in (IN), \ is moved, whole, to the wire that leads toward that node. It is refused \ instead if it has been passed on as often as a message may be; or if \ there is no way, or no one on the port. \ WITH NO ROOM on that wire -- or none but the room kept on it, (KEEP) -- \ text, a NACK and a GONE are refused, at once. But what a node printed \ (type 2) and its word of how text ended (type 3) are NOT let go for want \ of room: the message is left where it is, on the wire it came by, and \ gone past; what is behind it is served; and it is moved on a later pass, \ when there is room. Printing waits; it is not lost (MESH.md 7d.1, \ ruling 3). (H-PORT) and (H-NEED) are the port of the first message left \ so on this pass and the cells it needs there: a node that then sleeps, \ sleeps for that room, (SLEEP), and is woken by room on any wire. \ (H-MASK) has a bit for each port something was left for: what is behind \ it for the same port is left too, though it be shorter and would fit, so \ that what a node printed goes on in the order it came. \ HOW OFTEN. A message's fourth word is how many more nodes may pass it \ on; a node sends it with 16, and a move takes one off. The node that \ finds 1 there refuses it. A device sends it with 0, which is taken for \ 16: so 0 down to -14 are passed on and -15 is refused. Anything else is \ nothing a node or a device sent, and is refused. : (PASS) (IN)+3 a! @ -if POS 14 + -if OK jump SPENT POS: if OK -1 + if SPENT -16 + -if SPENT OK: drop (IN) a! @ (WAY) (P-WAY) a! ! (IN)+6 a! @ 3 + 2/ 2/ 7 + \ the cells it takes, (P-WAY) a! @ (KEEP) a! @ xor if KEPT drop jump NEED KEPT: drop 8 + \ and the room kept, if it is that wire NEED: (P-NEED) a! ! (P-WAY) a! @ -if WAY \ no way: refused SPENT: drop jump (REFUSE) WAY: (WBIT) (H-MASK) a! @ and if CLEAR \ something is left for that port already? FULL: drop (IN)+2 a! @ -2 + if HOLD -1 + if HOLD jump SPENT \ no room: only output and answers wait CLEAR: drop (P-NEED) a! @ (P-WAY) a! @ (ROOM?) (S-WIRE) a! @ (WIRE!) if GO -1 + if FULL jump SPENT \ no one on that port: refused GO: drop (P-WAY) a! @ (WIRE-A) b! !b 3 (DO) if MOVED jump SPENT MOVED: drop ; HOLD: drop (P-WAY) a! @ (WBIT) dup inv (H-MASK) a! @ and + ! (H-PORT) a! @ -if HELD drop (P-WAY) a! @ (H-PORT) a! ! (P-NEED) a! @ (H-NEED) a! ! 7 (DO) drop ; HELD: drop 7 (DO) drop ; \ ( -- ) SLEEP until a message comes -- or, if (SERVE) left a message \ on a wire for want of room, until there is that room or a message comes \ or any wire of this node's gains room (operation 9, MESH.md 7d.3). : (SLEEP) (H-PORT) a! @ -if ROOM drop 8 (DO) drop ; ROOM: (WIRE!) (H-NEED) a! @ (WIRE-A) b! !b 9 (DO) drop ; \ ( -- ) ONE PASS OVER EVERY WIRE THAT HAS A MESSAGE. What is for another \ node is passed on, or refused; what is for this node is left where it \ is. Fetching (WIRE-HAVE) is what tells the fabric this node has seen \ what had come: a sleep after this is woken only by what comes later \ (MESH.md 7d.3). (S-HAVE) keeps which wires they were, for whoever then \ looks for what is this node's own, (MINE). : (SERVE) (WIRE-HAVE) b! @b dup (S-HAVE) a! ! (S-MASK) a! ! 0 (S-WIRE) a! ! -1 (H-PORT) a! ! 0 (H-MASK) a! ! W: (S-MASK) a! @ if END dup 2/ ! 1 and if NEXTW drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop M: (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED jump NEXTW LOOKED: drop (IN) a! @ (ME) a! @ xor if MINE drop (PASS) jump M MINE: drop 7 (DO) drop jump M NEXTW: drop (S-WIRE) a! @ 1 + ! jump W END: drop ; \ WHAT IS FOR THIS NODE is gone through after (SERVE), a message at a time: \ (MINE0) begins, and each (MINE) puts the mark of a wire at the next \ message for this node and its seven words in (IN). Whoever asked then \ takes or drops that message -- the mark is then at the one that followed \ -- or leaves it and goes past it, (SKIP). The wire is (S-WIRE). \ ( -- ) begin with the wires (SERVE) found a message on : (MINE0) (S-HAVE) a! @ (S-MASK) a! ! -1 (S-WIRE) a! ! 0 (S-ON) a! ! ; \ ( -- flag ) the next message for this node; 0: there are no more : (MINE) L: (S-ON) a! @ if WIRE drop (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED drop 0 (S-ON) a! ! jump L \ this wire has no more LOOKED: drop (IN) a! @ (ME) a! @ xor if HIT drop 7 (DO) drop jump L HIT: drop -1 ; WIRE: drop (S-WIRE) a! @ 1 + ! \ the next wire that had one (S-MASK) a! @ if NONE dup 2/ ! 1 and if NOT drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop 1 (S-ON) a! ! jump L NOT: drop jump L NONE: ; \ ( -- ) go past the message (MINE) found: it stays on its wire : (SKIP) (S-WIRE) a! @ (WIRE!) 7 (DO) drop ; \ ( -- ) A TAKE DID NOT TAKE the message (MINE) found. The fabric takes \ only the message last looked at (MESH.md 7d.3), so either the wire has \ been cut -- and there is nothing there, or another message that has not \ been looked at -- or the message cannot be taken at all. It is dropped, \ and counted in (LOST); if it cannot be dropped either it is gone past. \ Either way whoever goes through the messages next is at another one: \ nothing goes round on one that will not be taken. : (UNTAKEN) (S-WIRE) a! @ (WIRE!) 4 (DO) if GONE drop jump (SKIP) GONE: drop (LOST) a! @ 1 + ! ; \ ( -- how ) take the message (MINE) found, which has one word of text: \ its seven words stay in (IN), and its word goes to (ONE). 0: it is \ taken. Anything else: it is not -- the wire was cut after the message \ was looked at -- and (ONE) is not its word: nothing is to be done for it. : (TAKE1) (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b (ONE) (WIRE-B) b! !b 2 jump (DO) \ ( -- how ) WAIT UNTIL THE WIRE of the port (W-PORT) has (W-NEED) cells \ free. 0: it has. 2: no one is on that port. The node sleeps until \ there is room, or a message comes, or another wire of its own gains \ room; woken with no room yet, it passes on what is for other nodes, \ (SERVE), and sleeps again. It is the one thing a node waits to put: \ what a text prints (MESH.md 7d.1, ruling 3). \ NOTHING BREAKS THIS WAIT but the room coming or the wire being cut \ (ruled 2026-10-08): text for this node that comes meanwhile, from its \ console or anyone, stays on its wire and is done when this text has been \ finished with. A text whose printing can never go, because a stuck node \ is on the way, waits until that node is killed (MESH.md 7d.6). : (WAIT-ROOM) L: (W-PORT) a! @ (WIRE!) (W-NEED) a! @ (WIRE-A) b! !b 9 (DO) if DONE -1 + if WOKEN drop 2 ; WOKEN: drop (WIRE-HAVE) b! @b if QUIET \ no wire has a message: there is nothing to pass on, drop (ROOM-SERVE) (SERVE) jump L \ and no more of the stacks is asked for than a wait needs QUIET: drop jump L DONE: ; \ ( -- ) send what has been printed, to where (PRINT-TO) says, by the port \ (PRINT-PORT): a message of type 2, its characters four to a word, the \ first lowest. quit.v4 sets those two when text for this node arrives. \ It waits for room on the wire, and for the 8 cells kept as well when the \ wire is the one the answer goes by. The characters are made ready in \ (OUT-TEXT), not where they are: until the message is on the wire the \ buffer is as it was, and a fault on the way leaves it to be sent again. \ The three cells after the last character are made zero first, so that \ nothing printed earlier goes on the wire in the last word (they are in \ the buffer, or the four free cells after it). \ The three cells and two return entries this needs are tried first. \ WITH NO ONE ON THE PORT -- when it waits for room, or when it comes to \ put -- what was printed cannot be sent. While the text is being done \ that is its error, 18; and the data stack is emptied first, as a fault \ empties it. A word that raises an error has taken its own arguments \ off; this one comes from under whatever word was printing, in the \ middle of its work, and what that word had on the stack is nothing its \ caller can use (as first built those values were left there). Once it has been finished with, what it printed \ is let go and counted in (LOST), and the text is said to have ended in \ an error: (LINE-STATUS), which is the word then sent of how it ended. : (FLUSH-OUT) (OUT^) a! @ (OUT) xor if NONE drop 0 0 0 drop drop drop 0 push 0 push pop drop pop drop (OUT^) a! @ (OUT) - 3 + 2/ 2/ 7 + (PRINT-PORT) a! @ (KEEP) a! @ xor if SAME drop jump NEED SAME: drop 8 + NEED: (W-NEED) a! ! (PRINT-PORT) a! @ (W-PORT) a! ! (WAIT-ROOM) if ROOM NOONE: drop (QUIET) a! @ if TELL drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! 2 (LINE-STATUS) a! ! ; TELL: drop DSTACK-DEPTH b! a !b NODE-ERROR b! 18 !b ; \ the data stack is emptied, as by a fault: see below ROOM: drop (PRINT-TO) a! @ 2 (HDR) (OUT^) a! @ a! 0 !+ 0 !+ 0 ! (OUT^) a! @ (OUT) - dup (OUT-HDR)+6 a! ! 3 + 2/ 2/ -1 + push (OUT-TEXT) pop (OUT) a! FOR @+ @+ 8* + @+ 8* 8* + @+ 8* 8* 8* + over b! !b 1 + NEXT drop (OUT-TEXT) (PRINT-PORT) a! @ (PUT-ON) if SENT jump NOONE SENT: drop (OUT) (OUT^) a! ! ; NONE: drop ; \ EMIT puts the character with what has been printed. Everything the node \ prints goes through EMIT. A is kept: the words that print have always \ been free to use it across an EMIT. As v3, only the low 8 bits of the \ character are printed. \ A BUFFER FOUND FULL is sent first. It is full when a flush of it ended \ in a fault -- the stack too deep to begin a message -- and what is printed \ next is that fault's own message: put where (OUT^) points, it would go \ past the buffer's end, and (OUT^) would never again be at the end to be \ flushed (MESH.md 7c.6). header EMIT : EMIT ( c -- ) 255 and a push push \ A, and then the character, to the return stack (OUT^) b! @b (OUT)+256 xor if STALE drop jump PUT STALE: drop (FLUSH-OUT) PUT: (OUT^) b! @b a! pop !+ a !b \ the character goes where (OUT^) points, which moves on a (OUT)+256 xor if FULL drop pop a! ; FULL: drop (FLUSH-OUT) pop a! ; header KEY : KEY ( -- c ) L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ; WAIT: drop jump L header CR : CR ( -- ) 10 jump EMIT header SPACE : SPACE ( -- ) 32 jump EMIT header COUNT : COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ; header TYPE : TYPE ( baddr u -- ) -if OK drop drop NODE-ERROR b! 1 !b ; OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK DONE: drop drop ; \ ( x -- ) up to four characters packed in one cell, the first in the low \ byte: how the capsule prints its own short messages, a literal at a time. : (EMIT4) L: if DONE dup EMIT 8/ jump L DONE: drop ; \ ---- section 5.8: the number base ---------------------------------------- : (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36 BASE b! @b dup -2 + -if L1 drop drop 10 ; L1: drop dup -37 + -if L2 drop ; L2: drop drop 10 ;