rajamesandClaude Opus 5.5
afd9d46d29
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>
189 lines
8.3 KiB
Plaintext
189 lines
8.3 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 #, 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.* 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./ #, 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 #, 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
|