admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4): the system's UM*, UM/MOD, D+, DNEGATE, Q.* and Q./ call the ROM

Browse Source 
MACHINE.md 2.2.  Each is its entry's address, push and ;.  Every node the
tests make carries the host ROM (host_load, Hera's births, the depth and
mesh tests' own nodes), and a division by zero inside the ROM returns to
the prompt (hosted-check).  test_host_quit's fetch outside memory moves
past the ROM's range: 16384 is the ROM's first word now the tests' system
has its ROM, as the product's always had.  dict_hash 0xfec8c47cfc6f437f.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-15 20:16:50 -04:00
co-authored by Claude Opus 5.5
parent 11b5d402b1
commit afd9d46d29
14 changed files with 123 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files
capsules/v4/sys/qmath.f18
+5 -64
View File
@@ -15,12 +15,12 @@
\ 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
\ 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
: (QERR11) NODE-ERROR b! 11 !b ;
: (QERR12) NODE-ERROR b! 12 !b ;
\ ---- conversion and constants ----
@@ -46,72 +46,13 @@ set HDR-NFA here ", Q.MIN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here :
\ ---- multiply ----
set HDR-NFA here ", Q.* #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q.* ( a b -- c )
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.TO-INT push Q.TO-INT pop SWAP ;
: Q.* ROM-Q.* push ; \ ( a b -- c ) the ROM's entry 4 (MACHINE.md 2.2)
\ ---- divide ----
: 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 ;
\ D2*C and (UQ/), Q./'s core, are the ROM's (capsules/v4/rom/math.f18).
set HDR-NFA here ", Q./ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
: Q./ ( a b -- q )
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)
: Q./ ROM-Q./ push ; \ ( a b -- q ) the ROM's entry 5
\ ---- e to the x ----
set HDR-NFA here ", Q.EXP #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here