Files
LithosAnanke/capsules/v4/sys/qmath.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

189 lines
8.4 KiB
Plaintext

\ qmath.f18 -- Q48.16 fixed point: a signed double with sixteen bits of
\ fraction (D-8, D-10).
\
\ DECOMPOSITION.md 5.26. Each word is the definition given there and
\ executed on the mesh node by test_foundation.c and test_printing.c, here in
\ the host node's vocabulary. Rests on core.f18, forth.f18, numout.f18 and
\ words.f18.
\
\ ERRORS. Q./ by zero, and Q.SQRT and Q.LOG outside their domain, leave the
\ result D-11 and D-12 give and then raise an error (D-18): codes 11,
\ "Division by zero", and 12, "Argument out of range".
\
\ Constants the loader supplies:
\ MSB MAXHI the high cells of Q min and Q max
\ HIMASK every bit but the top sixteen
\ 2N+15 N-18 N-17 loop counts, N the cell width in bits
\ (Q/) (QE) (QR) (QL) (QT) (QP) word addresses of the words' scratch
\ cells: 5, 8, 5, 7, 6 and 4 of them; (Q/) is the ROM's Q./'s
\ ROM-Q.* ROM-Q./ the ROM's entries (MACHINE.md 2.2)
\ the logical double shift right: one +* step with S = 0, the top bit cleared
macro (UD2/) push a! 0 pop +* MAXHI and push drop a pop endmacro
: (QERR12) NODE-ERROR b! 12 !b ;
\ ---- conversion and constants ----
set HDR-NFA here ", Q.FROM-INT #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.FROM-INT ( n -- q ) push 0 a! 0 pop N-17 FOR +* UNEXT push drop a pop ;
set HDR-NFA here ", Q.TO-INT #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.TO-INT ( q -- n ) push a! 0 pop 15 FOR +* UNEXT drop drop a ;
set HDR-NFA here ", Q.1 #id, #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.1 65536 0 ;
set HDR-NFA here ", Q.0 #id, #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.0 0 0 ;
set HDR-NFA here ", Q.SCALE #id, #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.SCALE 65536 0 ;
\ ---- the double words under other names ----
set HDR-NFA here ", Q.+ #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.+ jump D+
set HDR-NFA here ", Q.- #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.- jump D-
set HDR-NFA here ", Q.ABS #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.ABS jump DABS
set HDR-NFA here ", Q.NEG #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.NEG jump DNEGATE
set HDR-NFA here ", Q.= #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.= jump D=
set HDR-NFA here ", Q.< #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.< jump D<
set HDR-NFA here ", Q.> #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.> 2SWAP jump D<
set HDR-NFA here ", Q.0= #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.0= jump D0=
set HDR-NFA here ", Q.MAX #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.MAX jump DMAX
set HDR-NFA here ", Q.MIN #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.MIN jump DMIN
\ ---- multiply ----
set HDR-NFA here ", Q.* #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.* ROM-Q.* push ; \ ( a b -- c ) the ROM's entry 4 (MACHINE.md 2.2)
\ ---- divide ----
\ D2*C and (UQ/), Q./'s core, are the ROM's (capsules/v4/rom/math.f18).
set HDR-NFA here ", Q./ #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q./ ROM-Q./ push ; \ ( a b -- q ) the ROM's entry 5
\ ---- e to the x ----
set HDR-NFA here ", Q.EXP #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.EXP ( q -- e )
over over OR if ONE drop
dup (QE)+6 b! !b -if L1 DNEGATE L1:
over over -1048576 -1 D+ push drop pop -if BIG drop
over over (QE)+2 a! SWAP !+ ! over over (QE) a! SWAP !+ !
65536 0 D+ (QE)+4 a! SWAP !+ !
2 (QE)+7 b! !b
LOOP:
(QE)+2 a! @+ @ (QE) a! @+ @ Q.*
(QE)+7 b! @b Q.FROM-INT Q./
over over (QE)+2 a! SWAP !+ !
(QE)+4 a! @+ @ D+ (QE)+4 a! SWAP !+ !
(QE)+2 a! @+ @ if HI0 drop drop jump CONT
HI0: drop -if SM drop jump CONT
SM: -50 + -if CONT1 drop jump DONE
CONT1: drop
CONT: (QE)+7 b! @b 1 + dup !b -11 + -if DONE1 drop jump LOOP
DONE1: drop
DONE: (QE)+4 a! @+ @ (QE)+6 b! @b -if POS drop 65536 0 2SWAP jump Q./
POS: drop ;
BIG: drop drop drop (QE)+6 b! @b -if BIGP drop 0 0 ; BIGP: drop -1 MAXHI ;
ONE: drop drop drop 65536 0 ;
\ ---- square root ----
set HDR-NFA here ", Q.SQRT #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.SQRT ( q -- r )
dup -if POS drop drop drop 0 0 jump (QERR12)
POS: drop over over OR if ZERO drop
over 65536 xor over OR if ONE drop
over over (QR) a! SWAP !+ ! (UD2/) 16384 0 D+ (QR)+2 a! SWAP !+ !
8 (QR)+4 b! !b
LOOP: (QR) a! @+ @ (QR)+2 a! @+ @ Q./ (QR)+2 a! @+ @ D+ (UD2/)
over over (QR)+2 a! @+ @ DNEGATE D+ -if L1 DNEGATE L1:
if HI0 drop drop jump NXT
HI0: drop -if SM drop jump NXT
SM: -10 + -if NXT1 drop drop drop (QR)+2 a! @+ @ ;
NXT1: drop
NXT: (QR)+2 a! SWAP !+ !
(QR)+4 b! @b -1 + dup !b if DONE drop jump LOOP
DONE: drop (QR)+2 a! @+ @ ;
ZERO: drop ;
ONE: drop ;
\ ---- natural logarithm ----
set HDR-NFA here ", Q.LOG #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.LOG ( x -- ln x )
dup -if POS drop jump ERR
POS: drop over over OR if ZERO drop 0 (QL)+2 b! !b
DOWN: dup if CHKLO drop jump SHR
CHKLO: drop over -131072 and if DOWNDONE drop
SHR: (UD2/) (QL)+2 b! @b 1 + !b jump DOWN
DOWNDONE: drop drop
UP: dup -65536 and if UPSHIFT drop jump NORM
UPSHIFT: drop 2* (QL)+2 b! @b -1 + !b jump UP
NORM: dup (QL) b! !b -65536 + (QL)+1 b! !b 6 (QL)+3 b! !b
NEWTON: (QL)+1 b! @b dup (QL)+4 b! !b 65536 + (QL)+5 b! !b
131072 (QL)+6 b! !b
EXPL: (QL)+4 b! @b 0 (QL)+1 b! @b 0 Q.* drop
0 (QL)+6 b! @b 0 Q./ drop dup (QL)+4 b! !b
dup (QL)+5 b! @b + !b
-50 + -if EXPC drop jump EXPD
EXPC: drop (QL)+6 b! @b 65536 + dup !b -720896 + -if EXPD2 drop jump EXPL
EXPD2: drop
EXPD: (QL) b! @b (QL)+5 b! @b push inv pop + inv
dup (QL)+4 b! !b
if DZ -if DPOS
inv 1 + 0 (QL)+5 b! @b 0 Q./ drop
(QL)+1 b! @b SWAP push inv pop + inv -if KEEP drop 0 KEEP: (QL)+1 b! !b
jump TEST
DPOS: 0 (QL)+5 b! @b 0 Q./ drop (QL)+1 b! @b + !b jump TEST
DZ: drop
TEST: (QL)+4 b! @b -if AP inv 1 + AP: -100 + -if CONT drop jump FIN
CONT: drop (QL)+3 b! @b -1 + dup !b if FIN0 drop jump NEWTON
FIN0: drop
FIN: (QL)+1 b! @b (QL)+2 b! @b
-if KP inv 1 + 45426 UM* drop inv 1 + jump KS KP: 45426 UM* drop
KS: + dup -if SP drop -1 ; SP: drop 0 ;
ZERO: drop
ERR: drop drop 0 0 jump (QERR12)
\ ---- sine and cosine ----
: (Q.REDUCE) ( x -- r )
dup (QT) b! !b -if L1 DNEGATE L1:
0 411774 UM/MOD drop 411774 UM/MOD drop
(QT) b! @b -if P1 drop inv 1 + jump J1 P1: drop J1:
dup -205888 + -if BIG drop
dup 205887 + -if OK drop 411774 + ;
OK: drop ;
BIG: drop -411774 + ;
\ The Taylor loop both use; each sets (QT) up and jumps here.
: (TRIG)
T: (QT)+2 b! @b 0 (QT)+1 b! @b 0 Q.* drop
0 (QT)+4 b! @b dup -1 + UM* drop 65536 UM* drop 0 Q./ drop
dup (QT)+2 b! !b
(QT)+5 b! @b if ADDT drop inv 1 + jump ACC ADDT: drop
ACC: (QT)+3 b! @b + !b (QT)+5 b! @b inv !b
(QT)+2 b! @b -10 + -if CONT drop jump END
CONT: drop (QT)+4 b! @b 2 + dup !b -12 + -if END2 drop jump T
END2: drop
END: (QT)+3 b! @b (QT) b! @b -if PR drop inv 1 + jump SD PR: drop
SD: dup -if SP drop -1 ; SP: drop 0 ;
set HDR-NFA here ", Q.SIN #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.SIN ( x -- sin x )
(Q.REDUCE) dup (QT) b! !b -if A1 inv 1 + A1:
dup (QT)+2 b! !b dup (QT)+3 b! !b
0 over 0 Q.* drop (QT)+1 b! !b
3 (QT)+4 b! !b -1 (QT)+5 b! !b jump (TRIG)
set HDR-NFA here ", Q.COS #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.COS ( x -- cos x )
(Q.REDUCE) -if A1 inv 1 + A1:
0 (QT) b! !b 0 over 0 Q.* drop (QT)+1 b! !b
65536 (QT)+2 b! !b 65536 (QT)+3 b! !b
2 (QT)+4 b! !b -1 (QT)+5 b! !b jump (TRIG)
\ ---- printing ----
\ The integer part, a point, five digits, a blank; always in decimal.
set HDR-NFA here ", Q.PRINT #id, #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.PRINT ( q -- )
dup (QP)+3 b! !b -if A DNEGATE A: (QP)+2 b! !b dup (QP)+1 b! !b
BASE b! @b (QP) b! !b 10 BASE b! !b
65535 and 4 FOR dup 2* 2* + UNEXT 10 FOR 2/ UNEXT
0 <# # # # # # drop drop 46 HOLD
(QP)+1 b! @b (QP)+2 b! @b dup push
push a! 0 pop 15 FOR +* UNEXT drop drop a
pop 15 FOR 2/ UNEXT HIMASK and
#S (QP)+3 b! @b SIGN #>
(QP) b! @b BASE b! !b
TYPE jump SPACE