rajamesandClaude Opus 5.5
11b5d402b1
MACHINE.md 2.2. UM*, UM/MOD, D+, DNEGATE, Q.* and Q./ are entries 0-5 of the host ROM and of a mesh node's ROM, from one source (rom/math.f18) and one entry list (v4/rom_entries.h). The host ROM starts at entry 18. The mesh ROM is 277 words; the host ROM 2372. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
144 lines
5.0 KiB
Plaintext
144 lines
5.0 KiB
Plaintext
\ math.f18 -- the ROM's shared math (docs/v4.0.0/MACHINE.md 2.2).
|
|
\
|
|
\ Six routines a payload calls through the ROM's entry table, as a GA144
|
|
\ application calls its node ROM's multiply and divide steps, and their
|
|
\ helpers. Both ROMs carry them: the host node's and a mesh node's. They
|
|
\ were the system's (capsules/v4/sys: core.f18, numout.f18, qmath.f18) and
|
|
\ do exactly what they did there; the system's words of those names now call
|
|
\ these. No names, no headers, no FORTH.
|
|
\
|
|
\ Constants from the map (tools/mkmap.c): N-1 NODE-ERROR MSB MAXHI 2N+15
|
|
\ N-18 N-17, and (Q/), Q./'s five scratch cells, fixed in the memory map
|
|
\ (MACHINE.md 2.1).
|
|
\
|
|
\ ERRORS. Q./ by zero leaves the result D-11 gives and stores 11, "Division
|
|
\ by zero", into NODE-ERROR (D-18).
|
|
|
|
macro SWAP over push push drop pop pop endmacro
|
|
macro - push inv pop + inv endmacro \ x y -- x-y
|
|
macro NIP push drop pop endmacro
|
|
macro ROT push SWAP pop SWAP endmacro
|
|
macro OR over inv and xor endmacro
|
|
|
|
\ ( u1 u2 -- ulo uhi ) entry 0
|
|
: (UM*)
|
|
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 ;
|
|
|
|
\ ( ulo uhi ud -- urem uquot ) entry 1. One step a bit, the divisor in
|
|
\ A. Exact for uhi < ud.
|
|
: (UM/MOD)
|
|
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 ;
|
|
|
|
\ ( d1 d2 -- d3 ) entry 2
|
|
: (D+)
|
|
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 + ;
|
|
|
|
\ ( d -- -d ) entry 3
|
|
: (DNEGATE)
|
|
inv over if L1 drop push inv 1 + pop ;
|
|
L1: drop 1 + ;
|
|
|
|
\ ( q -- n ) the system's Q.TO-INT, which Q.* needs
|
|
: (Q>INT) push a! 0 pop 15 FOR +* UNEXT drop drop a ;
|
|
|
|
\ ( a b -- c ) entry 4
|
|
: (Q.*)
|
|
SWAP push over over (UM*) drop
|
|
push push over pop
|
|
-if L1 SWAP jump L2 L1: SWAP drop 0 L2:
|
|
pop SWAP - push
|
|
push over pop (UM*) pop +
|
|
ROT pop dup push
|
|
over -if L3 drop dup jump L4 L3: drop 0 L4:
|
|
push (UM*) pop - (D+)
|
|
ROT pop (UM*)
|
|
SWAP push 0 (D+) pop
|
|
push over pop SWAP (Q>INT) push (Q>INT) pop SWAP ;
|
|
|
|
: (QERR11) NODE-ERROR b! 11 !b ;
|
|
|
|
: (D2*C) ( lo hi cin -- lo' hi' cout )
|
|
a! dup -if L1 drop 1 jump L2 L1: drop 0 L2: push
|
|
over -if L3 drop 1 jump L4 L3: drop 0 L4:
|
|
over + +
|
|
push 2* a + pop pop ;
|
|
|
|
: (UQ/) ( a0 a1 b0 b1 -- q0 q1 )
|
|
(Q/)+2 a! SWAP !+ ! (Q/) a! SWAP !+ ! 0 0 0
|
|
2N+15 FOR
|
|
push (Q/) a! @+ @ pop (D2*C)
|
|
push (Q/)+1 a! ! (Q/) a! ! pop (D2*C)
|
|
if CMP drop jump TAKE
|
|
CMP: drop (Q/)+3 b! @b
|
|
over over xor if EQH -if SAMEH
|
|
drop drop -if NT1 jump TAKE NT1: jump NOTAKE
|
|
SAMEH: drop over SWAP push inv pop + inv
|
|
-if T2 drop jump NOTAKE T2: drop jump TAKE
|
|
EQH: drop drop over (Q/)+2 b! @b
|
|
over over xor -if SAMEL
|
|
drop drop -if NT3 drop jump TAKEL NT3: drop jump NOTAKEL
|
|
SAMEL: drop push inv pop + inv
|
|
-if T4 drop jump NOTAKEL T4: drop jump TAKEL
|
|
TAKEL: drop (Q/)+2 b! @b push inv pop + inv 0 1 jump END
|
|
NOTAKEL: 0 jump END
|
|
TAKE: push (Q/)+2 b! @b over over push inv pop + inv push
|
|
over over xor -if SB drop NIP -if NB drop 1 jump BD NB: drop 0 jump BD
|
|
SB: drop push inv pop + inv -if NB2 drop 1 jump BD NB2: drop 0
|
|
BD: pop pop (Q/)+3 b! @b push inv pop + inv
|
|
push SWAP pop SWAP - 1 jump END
|
|
NOTAKE: 0
|
|
END:
|
|
NEXT
|
|
push (Q/) a! @+ @ pop (D2*C) drop push push drop drop pop pop ;
|
|
|
|
: (Q./) ( a b -- q ) \ entry 5
|
|
over over OR if ZERO drop
|
|
push over pop SWAP over xor (Q/)+4 b! !b
|
|
-if L1 (DNEGATE) L1: push push -if L2 (DNEGATE) L2: pop pop
|
|
dup if CHK drop jump DIV
|
|
CHK: drop over -131072 and if CHK2 drop jump DIV
|
|
CHK2: drop push push dup pop dup push N-18 FOR 2* UNEXT
|
|
over over xor -if SAME drop drop -if NOOV jump OV
|
|
SAME: drop push inv pop + inv -if OV
|
|
NOOV: drop pop pop jump DIV
|
|
OV: drop drop drop pop pop drop drop
|
|
(Q/)+4 b! @b -if OVP drop 0 MSB ; OVP: drop -1 MAXHI ;
|
|
DIV: (UQ/) (Q/)+4 b! @b -if L3 drop (DNEGATE) ; L3: drop ;
|
|
ZERO: drop drop drop
|
|
over over OR if Z0 drop -if ZP drop drop 0 MSB jump (QERR11)
|
|
ZP: drop drop -1 MAXHI jump (QERR11)
|
|
Z0: drop jump (QERR11)
|