admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): division by zero is guarded (D-15); division words in the capsule

Browse Source 
Ruled 2026-10-04: guarded, an error shown, back to the prompt.

- capsule/forth.v4: / MOD /MOD */ */MOD M/MOD, M* and S>D join the
  vocabulary.  Each dividing word tests its divisor first; zero prints
  v3's message ("/: Division by zero"), ends an open definition, prints
  ERROR and returns to the prompt from however deep.
- SM/REM here has UM/MOD written into it and keeps its signs in memory,
  and */MOD has M* written in, so that division can be used inside words
  that other words call: / from four words deep, */MOD from three.
- forth.v4 now loads after quit.v4, which the guard leaves through.
- tests: v3 transcripts for each message; /MOD, /, MOD and */MOD against
  C on every pair of edge values.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 12:23:30 -04:00
co-authored by Claude Opus 5.5
parent b3d2d56d11
commit 361dcd1148
5 changed files with 156 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/capsule/forth.v4
+94 -2
View File
@@ -3,8 +3,10 @@
\
\ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.5, 5.18).
\ A word flagged inline is copied into a definition in place of a call; the
\ ones that touch the return stack are compile-only as well. Rests on core.v4
\ and compile.v4's loader constants.
\ ones that touch the return stack are compile-only as well. Rests on core.v4,
\ compile.v4's loader constants, and quit.v4, which the division words leave
\ through when the divisor is zero. (F) is three cells of scratch for
\ this file.
\ ---- stack ----
header DUP inline : DUP dup ;
@@ -49,6 +51,96 @@ header 2- inline : 2- -2 + ;
header 2* inline : TWO* 2* ;
header 2/ inline : TWO/ 2/ ;
\ ---- division (sections 4 and 5.6) ----
\ Division by zero is guarded (D-15): each word tests its divisor before it
\ does anything else, and a zero divisor prints v3's message --
\ /: Division by zero
\ -- and ends the line with ERROR, from however deep, as an address fault
\ does. Nothing is left for the word's caller: it is not returned to.
\ ( name -- ) name is up to four characters of the word's name (EMIT4)
: (DIV0)
(EMIT4) $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4) \ ": Division b"
$657A2079 (EMIT4) $6F72 (EMIT4) CR \ "y zero"
2 jump (REPL)
\ ( d n -- rem quot ) truncating toward zero: the quotient has the sign of
\ d xor n, the remainder the sign of d. This is section 4's SM/REM with its
\ UM/MOD -- restoring division, one step a bit, the divisor in A -- written
\ into it, and the two signs kept in (F) where section 4 has them on the
\ return stack. A word that divides is then four return entries deep, not
\ eight, so division can be used inside words that other words call (D-2).
\ The answer is the same. Exact when the quotient fits a cell; its callers
\ have seen to it that n is not zero.
: SM/REM
over over xor (F) a! ! \ the quotient's sign, in its top bit
over (F)+1 a! ! \ the remainder's
-if L0 inv 1 + L0: a! \ A: |n|
-if L1 DNEGATE L1: \ |d|
N-1 FOR
-if S0
2* over -if S1 drop 1 + jump S2
S1: drop S2: push 2* pop
jump SUB
S0:
2* over -if S3 drop 1 + jump S4
S3: drop S4: push 2* pop
dup a xor -if S5
drop -if NOSUB jump SUB
S5: drop dup inv a + inv -if S6
drop jump NOSUB
S6: push drop pop jump SETBIT
SUB: inv a + inv
SETBIT: push 1 + pop
NOSUB:
NEXT
over push push drop pop pop \ urem uquot
(F)+1 a! @ -if L2 drop push inv 1 + pop jump L3 L2: drop L3:
(F) a! @ -if L4 drop inv 1 + ; L4: drop ;
header S>D
: S>D ( n -- d ) dup -if P drop -1 ; P: drop 0 ;
\ The product's sign waits in (F), not on the return stack, for the same
\ reason as SM/REM's.
header M*
: M* ( n1 n2 -- d )
over over xor (F) a! ! -if A inv 1 + A: push -if B inv 1 + B: pop UM*
(F) a! @ -if P drop jump DNEGATE P: drop ;
\ ( n1 n2 n3 -- rem quot ) n1 * n2 as a double, divided by n3, which is
\ not zero. M* is written in, and n3 waits in (F)+2, so that the multiply
\ is as few return entries down as it can be.
: (*/MOD)
(F)+2 a! !
over over xor (F) a! ! -if A inv 1 + A: push -if B inv 1 + B: pop UM*
(F) a! @ -if P drop DNEGATE jump Q P: drop Q:
(F)+2 a! @ jump SM/REM
header /MOD
: /MOD ( n1 n2 -- rem quot )
if Z push S>D pop jump SM/REM
Z: $444F4D2F jump (DIV0)
header /
: / ( n1 n2 -- quot )
if Z push S>D pop SM/REM NIP ;
Z: $2F jump (DIV0)
header MOD
: MOD ( n1 n2 -- rem )
if Z push S>D pop SM/REM drop ;
Z: $444F4D jump (DIV0)
header */MOD
: */MOD ( n1 n2 n3 -- rem quot )
if Z jump (*/MOD)
Z: $4F4D2F2A (EMIT4) $44 jump (DIV0)
header */
: */ ( n1 n2 n3 -- quot )
if Z (*/MOD) NIP ;
Z: $2F2A jump (DIV0)
header M/MOD
: M/MOD ( d n -- rem quot )
if Z jump SM/REM
Z: $4F4D2F4D (EMIT4) $44 jump (DIV0)
\ ---- logic and comparison ----
header AND inline : AND and ;
header XOR inline : XOR xor ;