rajamesandClaude Opus 5.5
a73580e949
The host node starts in its ROM (entry 12), and the boot feeds it the system's source through the console: capsules/v4/sys/map-64.f18, the fourteen .f18 blobs and end.f18, each found, hash-checked and signature-checked as any capsule, then EOT. The ROM assembles the system and starts it at (IDLE); the host reads the image record (v4_image_from_node) for what only the assembled system knows. A ROM error is reported with its blob, line and meaning, then PARITY:FAIL. Deleted: v4/tools/mkimage.c, capsules/v4/nucleus-64.f18, v4/capsule/*.v4, v4/tools/v4tof18.py. The .f18 files are the source now. - text.c speaks the rest of the ROM's language (set, here, store, start; v4_text_value, v4_text_start), so the oracle reads the same source: test_host_rom_nucleus compares the ROM against text.c on the .f18 files, word for word, image record included. Host tests load the .f18 files. - mkmap image writes v4_map_image (the map's description of the system); hosted and the kernel link the ROM and the map instead of v4_image_64.c. - Hera (Captain Bob's ruling, option 1): births stream the system the ROM assembled, as assembled code; hera.4th is unchanged. test_host_unit's host builds the system with the ROM. - New parity lines: PARITY:V4_F18 per blob, PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216. Acceptance: amd64, aarch64, riscv64 boot to ok> with PARITY:V4_POST tests=538 pass=538 fail=0, POST: PASSED, and PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a on all three -- the same hash as the prebuilt nucleus gave. make -C v4 test test-32 hosted-check: all pass. Logs: logs/20261015-141648, -141938, -142350. Startup cost under QEMU TCG, the ROM's assembly (last V4_F18 line to V4_ROM): amd64 26.7 s of 132 s to ok>; aarch64 41.0 s of 195 s; riscv64 20.5 s of 101 s. Hosted native: +0.85 s. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
154 lines
6.8 KiB
Plaintext
154 lines
6.8 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) ----
|
|
\ One step a bit, the divisor in A. Exact for uhi < ud.
|
|
: UM/MOD ( ulo uhi ud -- urem uquot )
|
|
a! N-1 FOR
|
|
-if L0
|
|
2* over -if L1 drop 1 + jump L2
|
|
L1: drop L2: push 2* pop
|
|
jump SUB
|
|
L0:
|
|
2* over -if L3 drop 1 + jump L4
|
|
L3: drop L4: push 2* pop
|
|
dup a xor -if L5
|
|
drop -if NOSUB jump SUB
|
|
L5: drop dup inv a + inv -if L6
|
|
drop jump NOSUB
|
|
L6: push drop pop jump SETBIT
|
|
SUB: inv a + inv
|
|
SETBIT: push 1 + pop
|
|
NOSUB:
|
|
NEXT
|
|
over push push drop pop pop ;
|
|
|
|
\ ---- pictured output ----
|
|
set HDR-NFA here ", <# #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: <# ( -- ) HEND HLD b! !b ;
|
|
set HDR-NFA here ", HOLD #, 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 #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ;
|
|
set HDR-NFA here ", # #, 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 #, 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 ", #> #, 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 #, 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 #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: DECIMAL 10 BASE a! ! ;
|
|
set HDR-NFA here ", HEX #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: HEX 16 BASE a! ! ;
|
|
set HDR-NFA here ", OCTAL #, 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 #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: DOT-R ( n width -- ) 0 (W)+1 b! !b jump (.BODY)
|
|
set HDR-NFA here ", . #, 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 #, 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. #, 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 #, 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. #, 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 ", ? #, 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 #, 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 #, 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 ;
|