diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 0bece632..a4b7c480 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -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 diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index d42e5934..510dbc90 100644 --- a/v4/capsule/core.v4 +++ b/v4/capsule/core.v4 @@ -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 diff --git a/v4/capsule/numout.v4 b/v4/capsule/numout.v4 index 244b0abd..e6958023 100644 --- a/v4/capsule/numout.v4 +++ b/v4/capsule/numout.v4 @@ -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 ; diff --git a/v4/capsule/qmath.v4 b/v4/capsule/qmath.v4 new file mode 100644 index 00000000..5267e29b --- /dev/null +++ b/v4/capsule/qmath.v4 @@ -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 diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index 4e31919f..82ba91da 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -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 diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index d3325d27..5aa5139b 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -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); diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 989c65a4..030af356 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -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;