rajamesandClaude Opus 5.5
1bf19d6224
capsules/v4/sys: the nucleus's fourteen sources as .f18 blobs (made once by v4/tools/v4tof18.py: header becomes the ROM's directives, every other token and line kept), the memory map as map-<width>.f18 (mkmap sys, from one table in host_map.h that host_load reads too), and end.f18, the switch-on state mkimage.c set in C, the image record, and start (IDLE). test_host_rom_nucleus.c: the ROM, fed those blobs through the console, builds RAM identical word for word to mkimage.c's, outside its own state and the image record, and starts at (IDLE), at both widths. The cost: 60.7 million instructions, 1.5 s on the C model. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
248 lines
10 KiB
Plaintext
248 lines
10 KiB
Plaintext
\ qmath.v4 -- 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.v4, forth.v4, numout.v4 and
|
|
\ words.v4.
|
|
\
|
|
\ 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
|
|
|
|
\ 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 ----
|
|
set HDR-NFA here ", Q.FROM-INT #, 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 #, 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 #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.1 65536 0 ;
|
|
set HDR-NFA here ", Q.0 #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.0 0 0 ;
|
|
set HDR-NFA here ", Q.SCALE #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.SCALE 65536 0 ;
|
|
|
|
\ ---- the double words under other names ----
|
|
set HDR-NFA here ", Q.+ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.+ jump D+
|
|
set HDR-NFA here ", Q.- #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.- jump D-
|
|
set HDR-NFA here ", Q.ABS #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.ABS jump DABS
|
|
set HDR-NFA here ", Q.NEG #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.NEG jump DNEGATE
|
|
set HDR-NFA here ", Q.= #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.= jump D=
|
|
set HDR-NFA here ", Q.< #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.< jump D<
|
|
set HDR-NFA here ", Q.> #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.> 2SWAP jump D<
|
|
set HDR-NFA here ", Q.0= #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.0= jump D0=
|
|
set HDR-NFA here ", Q.MAX #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.MAX jump DMAX
|
|
set HDR-NFA here ", Q.MIN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : Q.MIN jump DMIN
|
|
|
|
\ ---- 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 ;
|
|
|
|
\ ---- 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 ;
|
|
|
|
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)
|
|
|
|
\ ---- e to the x ----
|
|
set HDR-NFA here ", Q.EXP #, 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 #, 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 #, 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 #, 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 #, 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 #, 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
|