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
@@ -179,7 +179,7 @@ definition below depends on one, it says so.
|
||||
| **D-15** | Division by zero in `/` `MOD` `/MOD` `*/` `*/MOD` `M/MOD` (ruled 2026-10-04). | **Guarded: the word reports it and the line ends.** Each of these words tests its divisor before anything else. If it is zero the word prints v3's message, its own name and `: Division by zero`, takes its operands off the stack as v3 does, ends any definition that was open, prints ` ERROR` and returns to the prompt, from however deep; its caller is not returned to. `M/MOD` says so too, where v3 printed ` ERROR` alone. Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. `Q./` keeps D-11 (saturate and flag). `UM/MOD` and `SM/REM` are internal and unguarded: their callers have checked. What a mesh node, with no console, does on a zero divisor comes with the mesh (step 2); §4's definitions, which the mesh-node tests execute, still leave it unspecified. |
|
||||
| **D-16** | Stack overflow and underflow; `DEPTH`, `PICK`, `ROLL` (ruled 2026-10-04; revises D-2). | **Guarded: a stack fault.** Each stack counts what it holds. Before every opcode the node checks that the stacks hold what the opcode takes — including a `T` or `S` it only reads — and have room for what it leaves. If not, the opcode does nothing and the node faults exactly as for a bad address (D-14), to that kind's handler: `Stack overflow`, `Stack underflow`, `Return stack overflow`, `Return stack underflow`, then ` ERROR` and the prompt. **Every fault, D-14's included, empties both stacks**: the handler does not return, and what a word stopped part-way has left on the data stack is of no use to its caller. (v3 keeps what the failing word had not taken, and names the word: `DROP: Stack underflow`.) The fault handler is a table of five words, one per kind, each a jump (`(FAULTS)` in `v4/capsule/quit.v4`). Two registers (§7) are all a programme sees of the stacks: `DSTACK-DEPTH` and `RSTACK-DEPTH` read as the depth, and a store to one empties that stack. There is still no stack pointer and no address for a stack cell, so `SP@` and `SP!` stay retired; `.S` waits for number output to reach the capsule. The sizes were unchanged by this ruling, 10 and 9 (D-17 then deepens the host node's): one more value, or one more level of call, is now an error message where it used to be silent corruption. Executed on the golden model (2026-10-04): `tests/test_exec.c` for every opcode at every depth of both stacks, `tests/test_host_quit.c` from the prompt. |
|
||||
| **D-17** | Stack sizes on the host node (2026-10-04, following D-16). | **32 values and 32 return entries on the host node; a mesh node keeps the F18's 10 and 9.** Once the stacks are counted (D-16) their size is a parameter of the node, like its memory, and the host node is the one that runs the interpreter and the compiler underneath the user's programme: at 10 and 9 the prompt left a programme about six values, and `/` could be used only four words deep. The mechanism is the same at both sizes — top registers over a ring — and so is every word's definition. v3's stacks are deeper still. In the golden model the sizes are `V4_DATA_RING` and `V4_RET_RING` (`stack.h`), set for the host-node tests in `v4/Makefile`. |
|
||||
| **D-18** | Every other error (ruled 2026-10-04: "guard all errors"). | **A word that finds an error raises it, and the line ends there.** The word takes its own arguments off the stack and stores an error code in `NODE-ERROR` (§7). On a node with a prompt that store is a trap, a sixth kind of fault beside D-14's and D-16's: nothing after it executes, the return stack is emptied, and the prompt prints the code's message, ends any definition that was open, prints ` ERROR` and waits for the next line. Unlike the other faults it leaves the data stack as the word left it. The codes: 1 `Negative count` (`CMOVE`, `TYPE`), 2 `Not a number` (`NUMBER`), 3 `Number too long` (`HOLD` into a full buffer), 4 `Not a character` (`HOLD`), 5 `Dictionary full` (`,` `C,` `ALLOT`, any defining word), 6 `Name missing` (a defining word with nothing after it), 7 `Control structure mismatch`, 8 `Control structures too deep`, 9 `Shift count out of range`, 10 `Protected word`; −1 means the word printed its own message (`UNKNOWN WORD: 'xxx'`, `xxx: compile-only`). Before this ruling these set the flag and the line ran on to its end. v3 stops at once too; its messages name the word (`LOOP: missing DO`) where v4's name the fault. With the trap not attached `NODE-ERROR` is plain memory and the word returns, which is how the words are tested below the prompt. D-11, D-12 and D-13 said "set `NODE-ERROR`"; on a node with a prompt that now means this. Executed on the golden model (2026-10-04): `tests/test_exec.c`, `tests/test_host_quit.c`. |
|
||||
| **D-18** | Every other error (ruled 2026-10-04: "guard all errors"). | **A word that finds an error raises it, and the line ends there.** The word takes its own arguments off the stack and stores an error code in `NODE-ERROR` (§7). On a node with a prompt that store is a trap, a sixth kind of fault beside D-14's and D-16's: nothing after it executes, the return stack is emptied, and the prompt prints the code's message, ends any definition that was open, prints ` ERROR` and waits for the next line. Unlike the other faults it leaves the data stack as the word left it. The codes: 1 `Negative count` (`CMOVE`, `TYPE`), 2 `Not a number` (`NUMBER`), 3 `Number too long` (`HOLD` into a full buffer), 4 `Not a character` (`HOLD`), 5 `Dictionary full` (`,` `C,` `ALLOT`, any defining word), 6 `Name missing` (a defining word with nothing after it), 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 means the word printed its own message (`UNKNOWN WORD: 'xxx'`, `xxx: compile-only`). Before this ruling these set the flag and the line ran on to its end. v3 stops at once too; its messages name the word (`LOOP: missing DO`) where v4's name the fault. With the trap not attached `NODE-ERROR` is plain memory and the word returns, which is how the words are tested below the prompt. D-11, D-12 and D-13 said "set `NODE-ERROR`"; on a node with a prompt that now means this. Executed on the golden model (2026-10-04): `tests/test_exec.c`, `tests/test_host_quit.c`. |
|
||||
|
||||
**Consequences of D-2 that every definition must respect.** The data stack holds 10 items and the
|
||||
return stack 9, and every `call`, `FOR`, `DO` loop frame and `push` uses return-stack slots. Nesting
|
||||
@@ -758,7 +758,7 @@ call would bury what it works on. A **compile-only** word may not be executed by
|
||||
`v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`,
|
||||
`LEAVE`, `@`, the in-line variables and so on).
|
||||
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`), `system.v4` (`WORDS`, `FORGET`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`), `system.v4` (`WORDS`, `FORGET`), `qmath.v4` (the Q48.16 words of §5.26: `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`; `DUMP` is in `numout.v4`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. From the prompt, 122 results of the Q words printed by `Q.PRINT` — which shows all sixteen bits of a fraction — are digit for digit v3's, at both cell widths. Under D-18, `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 (codes 11 `Division by zero` and 12 `Argument out of range`); v3 returns 0 and says nothing. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
|
||||
**The stacks and the compiler.** The interpreter and compiler run on the same stacks as the user's
|
||||
words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -55,6 +55,7 @@
|
||||
#define HBUF_W (SVARS - 16) /* the hold buffer: 16 cells = 64 bytes */
|
||||
#define HEND ((HBUF_W + 16) * 4)
|
||||
#define XVARS (HBUF_W - 4) /* (X): words.v4, 4 cells */
|
||||
#define QBASE (XVARS - 40) /* the Q words' and DUMP's scratch cells, 39 in all */
|
||||
#define WBUF (WBUF_W * 4)
|
||||
#define TIB (TIB_W * 4)
|
||||
#define PAD (PAD_W * 4)
|
||||
@@ -115,6 +116,20 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "(S)", SVARS);
|
||||
v4_text_constant(tx, "(W)", WVARS);
|
||||
v4_text_constant(tx, "(X)", XVARS);
|
||||
v4_text_constant(tx, "(Q/)", QBASE); /* 5 cells */
|
||||
v4_text_constant(tx, "(QE)", QBASE + 5); /* 8 */
|
||||
v4_text_constant(tx, "(QR)", QBASE + 13); /* 5 */
|
||||
v4_text_constant(tx, "(QL)", QBASE + 18); /* 7 */
|
||||
v4_text_constant(tx, "(QT)", QBASE + 25); /* 6 */
|
||||
v4_text_constant(tx, "(QP)", QBASE + 31); /* 4 */
|
||||
v4_text_constant(tx, "(DP)", QBASE + 35); /* 4 */
|
||||
v4_text_constant(tx, "ADDR-DIGITS", V4_CELL_BITS / 4);
|
||||
v4_text_constant(tx, "MSB", (v4_cell)V4_MSB);
|
||||
v4_text_constant(tx, "MAXHI", (v4_cell)(V4_MSB - 1u));
|
||||
v4_text_constant(tx, "HIMASK", (v4_cell)(((v4_ucell)1 << (V4_CELL_BITS - 16)) - 1u));
|
||||
v4_text_constant(tx, "2N+15", 2 * V4_CELL_BITS + 15);
|
||||
v4_text_constant(tx, "N-18", V4_CELL_BITS - 18);
|
||||
v4_text_constant(tx, "N-17", V4_CELL_BITS - 17);
|
||||
v4_text_constant(tx, "MAX-INT", (v4_cell)(V4_MSB - 1u));
|
||||
v4_text_constant(tx, "HLD", HLD);
|
||||
v4_text_constant(tx, "FENCE", FENCE);
|
||||
|
||||
+157
-2
@@ -185,6 +185,145 @@ static const transcript script[] = {
|
||||
{ "2 BASE ! 5 . DECIMAL\n", "UNKNOWN WORD: '5'\n ERROR\nok> ", 1 },
|
||||
{ ": T 10 0 DO I . LOOP ; T\n", "0 1 2 3 4 5 6 7 8 9 ok\nok> ", 1 },
|
||||
{ "DEPTH . 1 2 DEPTH . . .\n", "0 2 2 1 ok\nok> ", 1 },
|
||||
/* qmath.v4: every result printed by Q.PRINT, which shows all sixteen bits of the fraction */
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.00000 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.00000 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "2.71823 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.84147 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.54028 ok\nok> ", 1 },
|
||||
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "2.00000 ok\nok> ", 1 },
|
||||
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.41424 ok\nok> ", 1 },
|
||||
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.69314 ok\nok> ", 1 },
|
||||
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "7.38894 ok\nok> ", 1 },
|
||||
{ "2 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.90930 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.PRINT\n", "1.50000 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.22473 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.40550 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "4.48153 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.99748 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.07073 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.PRINT\n", "0.33332 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.57733 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.39553 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.32719 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.94496 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.PRINT\n", "1.75000 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.32298 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.55966 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "5.75444 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.98399 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "10.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.16235 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.30261 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "12842.30421 ok\nok> ", 1 },
|
||||
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.PRINT\n", "3.14285 ok\nok> ", 1 },
|
||||
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.77279 ok\nok> ", 1 },
|
||||
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "1.14517 ok\nok> ", 1 },
|
||||
{ "22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "23.15980 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.PRINT\n", "0.00999 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.09996 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.01004 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.00999 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.99995 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.PRINT\n", "15.93750 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.99217 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.76870 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.PRINT\n", "333.33332 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "18.25744 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "5.80915 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.31947 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.94760 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.PRINT\n", "0.62500 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.79055 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.86820 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.58511 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.81095 ok\nok> ", 1 },
|
||||
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "9.00000 ok\nok> ", 1 },
|
||||
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.00003 ok\nok> ", 1 },
|
||||
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.19726 ok\nok> ", 1 },
|
||||
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "5720.68249 ok\nok> ", 1 },
|
||||
{ "9 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.41204 ok\nok> ", 1 },
|
||||
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "15.00000 ok\nok> ", 1 },
|
||||
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "3.87297 ok\nok> ", 1 },
|
||||
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "2.70808 ok\nok> ", 1 },
|
||||
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "387262.21916 ok\nok> ", 1 },
|
||||
{ "15 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.65025 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.PRINT\n", "0.14285 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "0.37799 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.EXP Q.PRINT\n", "1.15351 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.SIN Q.PRINT\n", "0.14237 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.COS Q.PRINT\n", "0.98982 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.* Q.PRINT\n", "2.62500 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "3.25000 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q./ Q.PRINT\n", "0.85713 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "1.75000 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "1.50000 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.< .\n", "-1 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
|
||||
{ "3 Q.FROM-INT 2 Q.FROM-INT Q./ 7 Q.FROM-INT 4 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.* Q.PRINT\n", "0.99998 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "3.33332 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q./ Q.PRINT\n", "0.11109 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "3.00000 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.33332 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.< .\n", "-1 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
|
||||
{ "1 Q.FROM-INT 3 Q.FROM-INT Q./ 3 Q.FROM-INT 1 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.* Q.PRINT\n", "50.08920 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "19.08035 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q./ Q.PRINT\n", "5.07102 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "15.93750 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "3.14285 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.> .\n", "-1 ok\nok> ", 1 },
|
||||
{ "255 Q.FROM-INT 16 Q.FROM-INT Q./ 22 Q.FROM-INT 7 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.* Q.PRINT\n", "3.33149 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "333.34332 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q./ Q.PRINT\n", "33351.65342 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "333.33332 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.00999 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.> .\n", "-1 ok\nok> ", 1 },
|
||||
{ "1000 Q.FROM-INT 3 Q.FROM-INT Q./ 1 Q.FROM-INT 100 Q.FROM-INT Q./ Q.= .\n", "0 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.* Q.PRINT\n", "0.39062 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "1.25000 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "0.62500 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "0.62500 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 8 Q.FROM-INT Q./ 5 Q.FROM-INT 8 Q.FROM-INT Q./ Q.= .\n", "-1 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.* Q.PRINT\n", "100.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.+ Q.PRINT\n", "20.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MAX Q.PRINT\n", "10.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.MIN Q.PRINT\n", "10.00000 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.< .\n", "0 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.> .\n", "0 ok\nok> ", 1 },
|
||||
{ "10 Q.FROM-INT 1 Q.FROM-INT Q./ 10 Q.FROM-INT 1 Q.FROM-INT Q./ Q.= .\n", "-1 ok\nok> ", 1 },
|
||||
{ "Q.1 Q.PRINT Q.0 Q.PRINT Q.SCALE Q.PRINT\n", "1.00000 0.00000 1.00000 ok\nok> ", 1 },
|
||||
{ "7 Q.FROM-INT 2 Q.FROM-INT Q./ Q.TO-INT . 100 Q.FROM-INT Q.TO-INT .\n", "3 100 ok\nok> ", 1 },
|
||||
{ "Q.0 Q.0= . Q.1 Q.0= . Q.0 Q.SQRT Q.PRINT Q.1 Q.SQRT Q.PRINT Q.0 Q.EXP Q.PRINT\n", "-1 0 0.00000 1.00000 1.00000 ok\nok> ", 1 },
|
||||
{ "5 Q.FROM-INT 3 Q.FROM-INT Q.- Q.PRINT Q.1 Q.ABS Q.PRINT\n", "2.00000 1.00000 ok\nok> ", 1 },
|
||||
{ "HEX 10 Q.FROM-INT Q.PRINT 10 . DECIMAL\n", "16.00000 10 ok\nok> ", 1 },
|
||||
{ "20 Q.FROM-INT Q.EXP Q.0= . Q.1 Q.LOG Q.PRINT\n", "0 0.00000 ok\nok> ", 1 },
|
||||
/* v4's own: signed values (D-8), which v3 prints as large unsigned numbers, and the errors */
|
||||
{ "-3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.PRINT -7 Q.FROM-INT Q.PRINT\n", "-1.50000 -7.00000 ok\nok> ", 0 },
|
||||
{ "3 Q.FROM-INT -2 Q.FROM-INT Q.* Q.PRINT -3 Q.FROM-INT -2 Q.FROM-INT Q.* Q.PRINT\n", "-6.00000 6.00000 ok\nok> ", 0 },
|
||||
{ "-5 Q.FROM-INT Q.ABS Q.PRINT 5 Q.FROM-INT Q.NEG Q.PRINT\n", "5.00000 -5.00000 ok\nok> ", 0 },
|
||||
{ "-1 Q.FROM-INT Q.1 Q.< . -1 Q.FROM-INT Q.1 Q.MAX Q.PRINT\n-1 Q.FROM-INT Q.1 Q.MIN Q.PRINT\n", "-1 1.00000 ok\nok> -1.00000 ok\nok> ", 0 },
|
||||
{ "-1 Q.FROM-INT Q.EXP Q.PRINT -3 Q.FROM-INT 2 Q.FROM-INT Q./ Q.TO-INT .\n", "0.36787 -2 ok\nok> ", 0 },
|
||||
{ "4 Q.FROM-INT Q.SIN Q.PRINT 2 Q.FROM-INT Q.COS Q.PRINT\n-1 Q.FROM-INT Q.SIN Q.PRINT\n", "-0.75680 -0.41615 ok\nok> -0.84147 ok\nok> ", 0 },
|
||||
{ "1 Q.FROM-INT 2 Q.FROM-INT Q./ Q.LOG Q.PRINT\n", "-0.69314 ok\nok> ", 0 },
|
||||
{ "-1 Q.FROM-INT 3 Q.FROM-INT Q./ -1 Q.FROM-INT 7 Q.FROM-INT Q./ Q.* . .\n", "0 3120 ok\nok> ", 0 },
|
||||
{ "-4 Q.FROM-INT Q.SIN . . 4 Q.FROM-INT Q.COS . .\n", "0 49598 -1 -42838 ok\nok> ", 0 },
|
||||
{ "Q.0 Q.0 Q./ 65 EMIT\nDEPTH .\n", "Division by zero\n ERROR\nok> 2 ok\nok> ", 0 },
|
||||
{ "7 Q.1 Q.0 Q./ 65 EMIT\nDEPTH .\n", "Division by zero\n ERROR\nok> 3 ok\nok> ", 0 },
|
||||
{ "7 -4 Q.FROM-INT Q.SQRT 65 EMIT\nDEPTH . . . .\n", "Argument out of range\n ERROR\nok> 3 0 0 7 ok\nok> ", 0 },
|
||||
{ "Q.0 Q.LOG 65 EMIT\n-1 Q.FROM-INT Q.LOG\n", "Argument out of range\n ERROR\nok> Argument out of range\n ERROR\nok> ", 0 },
|
||||
{ "7 PAD -1 DUMP 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
|
||||
{ "PAD 0 DUMP\n", " ok\nok> ", 1 },
|
||||
/* CASE, ['], S", FORGET */
|
||||
{ ": C1 CASE 1 OF 65 EMIT ENDOF 2 OF 66 EMIT ENDOF 67 EMIT ENDCASE ;\n1 C1 2 C1 3 C1\n.S\n", " ok\nok> ABC ok\nok> <0> \n ok\nok> ", 1 },
|
||||
{ ": C2 CASE 1 OF 10 ENDOF 2 OF 20 ENDOF DUP 100 + SWAP ENDCASE ;\n1 C2 . 2 C2 . 7 C2 .\n.S\n", " ok\nok> 10 20 107 ok\nok> <0> \n ok\nok> ", 1 },
|
||||
@@ -331,8 +470,8 @@ int main(void)
|
||||
printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
{
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 10), "the capsule assembles");
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4", "qmath.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 11), "the capsule assembles");
|
||||
}
|
||||
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
|
||||
@@ -694,6 +833,22 @@ int main(void)
|
||||
CHECK(is(say(";\n"), " ok\nok> ") && strncmp(say("VLIST\n"), "HALFWAY YAK ZEBRA ", 18) == 0, "VLIST is the same word; a finished definition is shown");
|
||||
}
|
||||
|
||||
/* ---- DUMP: v3's layout, with this node's address ---- */
|
||||
{
|
||||
char want[256];
|
||||
size_t at;
|
||||
boot_bare();
|
||||
CHECK(is(say("PAD 24 ERASE PAD 16 65 FILL 126 PAD 17 + C! 200 PAD 18 + C! 127 PAD 19 + C!\n"), " ok\nok> "), "sixteen A's, a zero, a tilde, a byte above 127, a DEL");
|
||||
at = (size_t)snprintf(want, sizeof want, "%0*llX: ", V4_CELL_BITS / 4, (unsigned long long)PAD);
|
||||
at += (size_t)snprintf(want + at, sizeof want - at, "41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 |AAAAAAAAAAAAAAAA|\n");
|
||||
at += (size_t)snprintf(want + at, sizeof want - at, "%0*llX: ", V4_CELL_BITS / 4, (unsigned long long)PAD + 16);
|
||||
at += (size_t)snprintf(want + at, sizeof want - at, "00 7E C8 7F |.~..|\n");
|
||||
snprintf(want + at, sizeof want - at, " ok\nok> ");
|
||||
CHECK(is(say("PAD 20 DUMP\n"), want), "a line and four bytes, in hex though BASE is ten");
|
||||
CHECK(is(say("BASE @ .\n"), "10 ok\nok> "), "and BASE is put back");
|
||||
CHECK(is(say("8 BASE ! PAD 24 DUMP DECIMAL\n"), want), "the same from octal");
|
||||
}
|
||||
|
||||
/* ---- a full dictionary ---- */
|
||||
boot_bare();
|
||||
n.mem[DP] = (DICT_END_W - 2) * 4;
|
||||
|
||||
Reference in New Issue
Block a user