feat(v4.0.0): the Q48.16 words and DUMP at the prompt
- capsule/qmath.v4: Q.FROM-INT Q.TO-INT Q.1 Q.0 Q.SCALE Q.+ Q.- Q.* Q./ Q.ABS Q.NEG Q.= Q.< Q.> Q.0= Q.MAX Q.MIN Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS Q.PRINT -- the definitions test_foundation.c executes on the mesh node, now in the host node's vocabulary. - numout.v4: DUMP. - 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): "Division by zero", "Argument out of range". v3 returns 0 silently. - tests/test_host_quit.c: 122 results printed by Q.PRINT are transcripts of the v3 binary, the same at both cell widths; signed values, the errors and DUMP's layout besides. 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
e7d686c7a2
commit
ab272cc2ad
@@ -15,6 +15,7 @@
|
||||
\ 4 Not a character 5 Dictionary full 6 Name missing
|
||||
\ 7 Control structure mismatch 8 Control structures too deep
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ 11 Division by zero (Q./) 12 Argument out of range
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
@@ -116,3 +116,38 @@ header .S
|
||||
PICK DOT
|
||||
(W)+2 b! @b -1 + !b jump L
|
||||
DONE: drop jump CR
|
||||
|
||||
\ ---- DUMP ----
|
||||
\ ( baddr u -- ) u bytes from the byte address baddr, sixteen to a line: the
|
||||
\ address, the bytes in hex, and the bytes as characters between bars.
|
||||
\ Everything it keeps between words is in (DP): the saved BASE, the address,
|
||||
\ the count and the column. ADDR-DIGITS is two for each byte of a cell.
|
||||
: (DB) ( -- c ) (DP)+1 b! @b (DP)+3 b! @b + jump C@
|
||||
header DUMP
|
||||
: DUMP
|
||||
-if OK drop drop NODE-ERROR b! 1 !b ;
|
||||
OK: (DP)+2 b! !b (DP)+1 b! !b
|
||||
BASE b! @b (DP) b! !b 16 BASE b! !b
|
||||
LINE: (DP)+2 b! @b if DONE drop
|
||||
(DP)+1 b! @b 0 <# ADDR-DIGITS (DP)+3 b! !b
|
||||
AD: # (DP)+3 b! @b -1 + dup !b if ADX drop jump AD
|
||||
ADX: drop #> TYPE 58 EMIT SPACE
|
||||
0 (DP)+3 b! !b
|
||||
HX: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVE
|
||||
drop SPACE SPACE SPACE jump HN
|
||||
HAVE: drop (DB) 0 <# # # #> TYPE SPACE
|
||||
HN: (DP)+3 b! @b 1 + dup !b -16 + -if HXX drop jump HX
|
||||
HXX: drop SPACE 124 EMIT
|
||||
0 (DP)+3 b! !b
|
||||
CH: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVC jump CHX
|
||||
HAVC: drop (DB)
|
||||
dup -32 + -if GE drop drop 46 jump EM
|
||||
GE: drop dup -127 + -if BIG drop jump EM
|
||||
BIG: drop drop 46
|
||||
EM: EMIT
|
||||
(DP)+3 b! @b 1 + dup !b -16 + -if CHX drop jump CH
|
||||
CHX: drop 124 EMIT CR
|
||||
(DP)+1 b! @b 16 + !b
|
||||
(DP)+2 b! @b -16 + -if MORE jump DONE
|
||||
MORE: !b jump LINE
|
||||
DONE: drop (DP) b! @b BASE b! !b ;
|
||||
|
||||
@@ -0,0 +1,247 @@
|
||||
\ 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 ----
|
||||
header Q.FROM-INT
|
||||
: Q.FROM-INT ( n -- q ) push 0 a! 0 pop N-17 FOR +* UNEXT push drop a pop ;
|
||||
header Q.TO-INT
|
||||
: Q.TO-INT ( q -- n ) push a! 0 pop 15 FOR +* UNEXT drop drop a ;
|
||||
header Q.1 inline : Q.1 65536 0 ;
|
||||
header Q.0 inline : Q.0 0 0 ;
|
||||
header Q.SCALE inline : Q.SCALE 65536 0 ;
|
||||
|
||||
\ ---- the double words under other names ----
|
||||
header Q.+ : Q.+ jump D+
|
||||
header Q.- : Q.- jump D-
|
||||
header Q.ABS : Q.ABS jump DABS
|
||||
header Q.NEG : Q.NEG jump DNEGATE
|
||||
header Q.= : Q.= jump D=
|
||||
header Q.< : Q.< jump D<
|
||||
header Q.> : Q.> 2SWAP jump D<
|
||||
header Q.0= : Q.0= jump D0=
|
||||
header Q.MAX : Q.MAX jump DMAX
|
||||
header Q.MIN : Q.MIN jump DMIN
|
||||
|
||||
\ ---- multiply ----
|
||||
header Q.*
|
||||
: 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 ;
|
||||
|
||||
header Q./
|
||||
: 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 ----
|
||||
header Q.EXP
|
||||
: 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 ----
|
||||
header Q.SQRT
|
||||
: 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 ----
|
||||
header Q.LOG
|
||||
: 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 ;
|
||||
|
||||
header Q.SIN
|
||||
: 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)
|
||||
header Q.COS
|
||||
: 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.
|
||||
header Q.PRINT
|
||||
: 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
|
||||
+3
-1
@@ -96,7 +96,7 @@ header ABORT
|
||||
-if POS drop 2 jump (REPL)
|
||||
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
||||
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
||||
-1 + if M10
|
||||
-1 + if M10 -1 + if M11 -1 + if M12
|
||||
drop 2 jump (REPL)
|
||||
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL)
|
||||
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL)
|
||||
@@ -108,6 +108,8 @@ header ABORT
|
||||
M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (REPL)
|
||||
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL)
|
||||
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (REPL)
|
||||
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (REPL)
|
||||
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
|
||||
|
||||
\ The table the loader gives the node: six words, one for each kind of
|
||||
\ fault in the node's order, each a jump. A jump fills its word, so they
|
||||
|
||||
Reference in New Issue
Block a user