feat(v4): the system's UM*, UM/MOD, D+, DNEGATE, Q.* and Q./ call the ROM
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
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
11b5d402b1
commit
afd9d46d29
@@ -33,34 +33,14 @@ macro NIP push drop pop endmacro
|
||||
|
||||
\ ---- section 4: multiply ------------------------------------------------
|
||||
set HDR-NFA here ", UM* #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: UM* ( u1 u2 -- ulo uhi )
|
||||
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 ;
|
||||
: UM* ROM-UM* push ; \ ( u1 u2 -- ulo uhi ) the ROM's entry 0 (MACHINE.md 2.2)
|
||||
|
||||
\ ---- section 5.7: doubles ------------------------------------------------
|
||||
set HDR-NFA here ", D+ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: D+ ( d1 d2 -- d3 )
|
||||
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+ ROM-D+ push ; \ ( d1 d2 -- d3 ) the ROM's entry 2
|
||||
|
||||
set HDR-NFA here ", DNEGATE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
: DNEGATE ( d -- -d )
|
||||
inv over if L1 drop push inv 1 + pop ;
|
||||
L1: drop 1 + ;
|
||||
: DNEGATE ROM-DNEGATE push ; \ ( d -- -d ) the ROM's entry 3
|
||||
|
||||
\ ---- section 5.3: bytes --------------------------------------------------
|
||||
\ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has
|
||||
|
||||
@@ -114,5 +114,11 @@ constant DSTACK-DEPTH 16369
|
||||
constant RSTACK-DEPTH 16368
|
||||
constant CFBASE 16288
|
||||
constant CFEND 16320
|
||||
constant ROM-UM* 16384
|
||||
constant ROM-UM/MOD 16385
|
||||
constant ROM-D+ 16386
|
||||
constant ROM-DNEGATE 16387
|
||||
constant ROM-Q.* 16388
|
||||
constant ROM-Q./ 16389
|
||||
constant DICT-W 8192
|
||||
constant (IMG) 14593
|
||||
|
||||
@@ -114,5 +114,11 @@ constant DSTACK-DEPTH 16369
|
||||
constant RSTACK-DEPTH 16368
|
||||
constant CFBASE 16288
|
||||
constant CFEND 16320
|
||||
constant ROM-UM* 16384
|
||||
constant ROM-UM/MOD 16385
|
||||
constant ROM-D+ 16386
|
||||
constant ROM-DNEGATE 16387
|
||||
constant ROM-Q.* 16388
|
||||
constant ROM-Q./ 16389
|
||||
constant DICT-W 8192
|
||||
constant (IMG) 14593
|
||||
|
||||
@@ -17,26 +17,8 @@
|
||||
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 ;
|
||||
\ 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 ", <# #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user