Files
LithosAnanke/capsules/v4/sys/numout.f18
T
Claude e8e7ec8b9f feat(v4): word accounts at call -- the word ID in the header, the kernel's records, the Stadium charged per tick (#189)
ENGINE step 4 Phase 2 (plan docs/v4.0.0/plans/2026-11-13-engine-step4-phase2-word-accounts.md). Rulings,
Captain Bob 2026-11-13: "ID field in the header"; "Per heartbeat tick"; the ACL "All of it in Phase 4".

- The word ID, at xt-4 before the flags (ENGINE.md 3b). The system's words are numbered as they are
  assembled, by a new directive, #id, (and #ids, the count), in the C assembler (text.c) and in the
  machine ROM's (capsules/v4/rom), which counts in the system's own (NEXT-ID). (HEADER) numbers later
  words; FORGET gives back the IDs it frees, always the newest; COLD resets to (BOOT-ID); (SEAL) records
  it. All 313 system headers carry the cell.
- The kernel's records (v4/mesh.h): (TELL-DEFINED) and (TELL-FORGOTTEN), requests -19/-20 on port 0,
  which the kernel puts in (WORD-DEFINED)/(WORD-FORGOTTEN) when it seals a node, and reads the system's
  own words once. A bit per address marks a word's xt (calls into the ROM or headerless code are not
  words); at call, the bit test and a count. v4_mesh_charge hands the owner the calls since.
- The Stadium: stadium_words_charge -- N calls as N of stadium_word_dispatch's dispatches, shared by calls
  when the reservoir is short; sk_v4.c charges every node's words at the tick beside its opcodes, and
  stadium_word_forget before an ID is used again.
- Tests first: test_text.c, test_host_dict.c, test_host_quit.c (numbering, FORGET, COLD),
  test_mesh_boot.c (44 checks), kernel/tests/test_stadium_words.c; qemu_session.py: Hera's words
  admitted after POST.
- amd64: Stadium words: promotions=141 after POST, CONSERVED; POST 539/539; word_count=377;
  dict_hash 0xa854ba15b437d288 (the new cell); the boot 142 s against Phase 1's 153 s.
- v4 test, test-32: all pass; v4-checks: 80 programs under the sanitizers, 0 failures; the hosted
  builds alike. docs/reference/v4-dictionary.tsv: the two new words; FABRIC-3 XLVIII.24.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_017RzZgrf7V7Zk2iczBXDRbm
2026-11-13 19:12:44 +00:00

136 lines
6.5 KiB
Plaintext

\ numout.f18 -- printing numbers: pictured output, the . words, and .S
\
\ DECOMPOSITION.md 5.8: <# # #S HOLD SIGN #> . .R U. U.R D. D.R ? SPACES
\ DECIMAL HEX OCTAL, each the definition given there and executed on the mesh
\ node by test_pictured.c, test_numout.c and test_printing.c; and .S, which
\ D-16 makes possible again. Part of the compiler capsule. Rests on core.f18
\ and forth.f18.
\
\ Constants the loader supplies:
\ HEND byte address just past the hold buffer, which is 64 bytes
\ -HFLOOR minus the lowest address HOLD may store at: -(HEND - 62)
\ HLD word address of the variable: where the picture has got to
\ (W) word address of three cells of scratch for this file:
\ (W)+0 the width a number is to be printed in
\ (W)+1 whether a blank follows it (W)+2 .S's count
macro (-ROT) SWAP push SWAP pop endmacro
\ ---- unsigned division (section 4) ----
\ Exact for uhi < ud. The ROM's entry 1 (MACHINE.md 2.2).
: UM/MOD ROM-UM/MOD push ; \ ( ulo uhi ud -- urem uquot )
\ ---- pictured output ----
set HDR-NFA here ", <# #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: <# ( -- ) HEND HLD b! !b ;
set HDR-NFA here ", HOLD #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: HOLD ( c -- )
dup -256 and if OKC drop drop NODE-ERROR b! 4 !b ; \ not a character
OKC: drop HLD b! @b -HFLOOR + -if ROOM
drop drop NODE-ERROR b! 3 !b ; \ the buffer is full
ROOM: drop HLD b! @b -1 + dup !b jump C!
set HDR-NFA here ", SIGN #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ;
set HDR-NFA here ", # #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: # ( ud1 -- ud2 )
0 (BASE) UM/MOD (-ROT) \ qhi lo rem1
(BASE) UM/MOD (-ROT) \ qlo qhi rem
dup -10 + -if L1 drop 48 + jump L2 L1: drop 55 + L2: jump HOLD
set HDR-NFA here ", #S #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: #S ( ud -- 0 0 ) L: # over over OR if L1 drop jump L L1: drop ;
set HDR-NFA here ", #> #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: #> ( ud -- baddr u ) drop drop HLD b! @b HEND over push inv pop + inv ;
\ ---- spaces and the number base ----
set HDR-NFA here ", SPACES #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: SPACES ( n -- ) -if L drop ; L: if DONE SPACE -1 + jump L DONE: drop ;
set HDR-NFA here ", DECIMAL #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DECIMAL 10 BASE a! ! ;
set HDR-NFA here ", HEX #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: HEX 16 BASE a! ! ;
set HDR-NFA here ", OCTAL #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: OCTAL 8 BASE a! ! ;
\ ---- numbers ----
\ One picture for signed singles, one for unsigned, one for doubles. Each
\ plain word is its .R word with a width of 0 and the blank flag set, and all
\ six share one tail, which prints the blank only when the flag is set.
\ ( baddr u -- ) right-justified in the width, then the blank if wanted
: (.TAIL)
(W) b! @b -if POS drop jump OUT \ width < 0
POS: over - SPACES \ width - u spaces
OUT: TYPE (W)+1 b! @b if DONE drop jump SPACE
DONE: drop ;
: (.BODY) ( n width -- )
(W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> jump (.TAIL)
: (U.BODY) ( u width -- )
(W) b! !b 0 <# #S #> jump (.TAIL)
: (D.BODY) ( d width -- )
(W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump (.TAIL)
set HDR-NFA here ", .R #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DOT-R ( n width -- ) 0 (W)+1 b! !b jump (.BODY)
set HDR-NFA here ", . #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DOT ( n -- ) -1 (W)+1 b! !b 0 jump (.BODY)
set HDR-NFA here ", U.R #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: U-DOT-R ( u width -- ) 0 (W)+1 b! !b jump (U.BODY)
set HDR-NFA here ", U. #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: U-DOT ( u -- ) -1 (W)+1 b! !b 0 jump (U.BODY)
set HDR-NFA here ", D.R #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: D-DOT-R ( d width -- ) 0 (W)+1 b! !b jump (D.BODY)
set HDR-NFA here ", D. #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: D-DOT ( d -- ) -1 (W)+1 b! !b 0 jump (D.BODY)
\ ( addr -- ) print what the cell holds
set HDR-NFA here ", ? #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: QUESTION a! @ jump DOT
\ ( -- ) as v3: the depth between < and >, then every value on the stack,
\ the deepest first, each followed by a blank; then a new line. The stack is
\ left as it was. It reads each value with PICK, so it needs a few cells of
\ the stack free to work in.
set HDR-NFA here ", .S #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DOT-S
60 EMIT DEPTH 0 U-DOT-R 62 EMIT SPACE
DEPTH (W)+2 b! !b
L: (W)+2 b! @b if DONE
PICK DOT
(W)+2 b! @b -1 + !b jump L
DONE: drop jump CR
\ ---- DUMP ----
\ ( baddr u -- ) u bytes from the byte address baddr, sixteen to a line: the
\ address, the bytes in hex, and the bytes as characters between bars.
\ Everything it keeps between words is in (DP): the saved BASE, the address,
\ the count and the column. ADDR-DIGITS is two for each byte of a cell.
: (DB) ( -- c ) (DP)+1 b! @b (DP)+3 b! @b + jump C@
set HDR-NFA here ", DUMP #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: DUMP
-if OK drop drop NODE-ERROR b! 1 !b ;
OK: (DP)+2 b! !b (DP)+1 b! !b
BASE b! @b (DP) b! !b 16 BASE b! !b
LINE: (DP)+2 b! @b if DONE drop
(DP)+1 b! @b 0 <# ADDR-DIGITS (DP)+3 b! !b
AD: # (DP)+3 b! @b -1 + dup !b if ADX drop jump AD
ADX: drop #> TYPE 58 EMIT SPACE
0 (DP)+3 b! !b
HX: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVE
drop SPACE SPACE SPACE jump HN
HAVE: drop (DB) 0 <# # # #> TYPE SPACE
HN: (DP)+3 b! @b 1 + dup !b -16 + -if HXX drop jump HX
HXX: drop SPACE 124 EMIT
0 (DP)+3 b! !b
CH: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVC jump CHX
HAVC: drop (DB)
dup -32 + -if GE drop drop 46 jump EM
GE: drop dup -127 + -if BIG drop jump EM
BIG: drop drop 46
EM: EMIT
(DP)+3 b! @b 1 + dup !b -16 + -if CHX drop jump CH
CHX: drop 124 EMIT CR
(DP)+1 b! @b 16 + !b
(DP)+2 b! @b -16 + -if MORE jump DONE
MORE: !b jump LINE
DONE: drop (DP) b! @b BASE b! !b ;