feat(v4.0.0): call-free UM/MOD loop for D-2 stack headroom

The first UM/MOD was exact but called 0<, U<, SWAP and OR inside its
loop, so it left its caller only 3 return-stack entries. SM/REM pushes
two signs before calling it, so under /MOD, M/MOD or */MOD the caller's
return address would be silently overwritten (D-2 circular stacks).

The loop now makes no calls. It branches on hi's top bit with -if, does
the unsigned hi' >= d test as U< does but with in-line sign tests,
subtracts with `inv a + inv`, and sets the quotient bit with `1 +` on an
even lo'. The final SWAP is in line.

Measured on the golden model at 32- and 64-bit cells:
  headroom   data 3 -> 6 cells under args, return 3 -> 6 entries
  speed      ~1355-1605 -> ~227-313 instruction words per call
Still exact for every uhi < ud (edge-vector triples and 20000 random
cases, optimised and ASan+UBSan). Retargeting each of the four in-loop
branches to the wrong label fails more than 12000 checks each.

DECOMPOSITION.md: section 4 UM/MOD replaced, with its derivation and
stack limits.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-02 22:35:49 -04:00
co-authored by Claude Opus 5.5
parent 41f59afeb3
commit 3b9d1e4337
2 changed files with 96 additions and 40 deletions
+30 -14
View File
@@ -221,23 +221,39 @@ dependency order.
2* a 0< NEGATE + pop + ; \ lo' hi'
\ ---- divide: 32-step restoring division, divisor held in A --------------
\ Each step shifts hi:lo left one bit and, when the shifted-out bit of hi was
\ set or hi' >= d, subtracts d from hi' and sets the new low bit of lo. The
\ unsigned compare is done by sign tests in line (as U< does), and x - d is
\ `inv a + inv`, so the loop body makes no calls: it needs one return-stack
\ entry beyond its own count.
: UM/MOD ( ulo uhi ud -- urem uquot )
a!
31 FOR
over 0< NEGATE push \ R: lo's top bit (1/0)
dup 0< push \ R: hi's top bit (-1/0)
2* pop pop SWAP push OR pop \ lo hi' t hi shifted, lo bit brought in
push SWAP 2* SWAP pop \ lo' hi' t
over a U< 0= OR \ lo' hi' flag t OR hi' >= d
IF a - SWAP 1 OR SWAP THEN
a! 31 FOR
-if L0 \ hi's top bit set:
2* over -if L1 drop 1 + jump L2 \ hi' = 2hi + top bit of lo
L1: drop L2: push 2* pop \ lo' = 2lo
jump SUB \ true hi' >= 2^n > d
L0:
2* over -if L3 drop 1 + jump L4
L3: drop L4: push 2* pop
dup a xor -if L5 \ top bits of hi' and d differ:
drop -if NOSUB jump SUB \ hi' >= d iff hi' has it
L5: drop dup inv a + inv -if L6 \ same: hi' >= d iff hi'-d >= 0
drop jump NOSUB
L6: push drop pop jump SETBIT
SUB: inv a + inv \ hi' - d
SETBIT: push 1 + pop \ lo' is even: + 1 sets bit 0
NOSUB:
NEXT
SWAP ;
\ Executed on the golden model unchanged (2026-10-02): exact, q*d + r = uhi:ulo
\ with r < d, for every uhi < ud at 32- and 64-bit cells. Outside that range
over push push drop pop pop ; \ SWAP in line
\ Executed on the golden model (2026-10-02): exact, q*d + r = uhi:ulo with
\ r < d, for every uhi < ud at 32- and 64-bit cells. Outside that range
\ (uhi >= ud, including ud = 0) the result is unspecified, as in FORTH-79; it
\ always terminates after 32 steps. Stack use (D-2): at most 3 data cells may
\ lie under the three arguments and at most 3 return-stack entries under its
\ return address. For UM* the same limits are 6 and 4.
\ always terminates after 32 steps. Stack use (D-2): up to 6 data cells may
\ lie under the three arguments and up to 6 return-stack entries under its
\ return address. For UM* the same limits are 6 and 4. This replaces a
\ first version built on U<, 0<, SWAP and OR calls, which was also exact but
\ left only 3 and 3 (too few for SM/REM inside /MOD) and stepped about five
\ times as many instruction words.
\ ---- signed division, truncating toward zero (v3 semantics) -------------
: SM/REM ( d n -- rem quot )
+66 -26
View File
@@ -8,8 +8,8 @@
*
* UM* is the full-range version that section 4 gives under D-3, and is checked
* against the reference v4_umul over every pair of the edge vectors and 20000
* pseudo-random pairs at each cell width. UM/MOD is exactly as section 4
* gives it, checked against q*d + r = uhi:ulo, r < d over the edge vectors and
* pseudo-random pairs at each cell width. UM/MOD, the call-free version
* section 4 gives, checked against q*d + r = uhi:ulo, r < d over the edge vectors and
* 20000 pseudo-random cases with uhi < ud. Both are also probed for how much
* of the 10- and 9-deep circular stacks (D-2) they leave to their caller.
*
@@ -127,38 +127,78 @@ static void build(void)
O(RPOP); O(ADD); O(SEMI);
/* : UM/MOD ( ulo uhi ud -- urem uquot ) section 4
* a!
* 31 FOR
* over 0< NEGATE push
* dup 0< push
* 2* pop pop SWAP push OR pop
* push SWAP 2* SWAP pop
* over a U< 0= OR
* IF a - SWAP 1 OR SWAP THEN
* a! 31 FOR
* -if L0
* 2* over -if L1 drop 1 + jump L2 L1: drop L2: push 2* pop
* jump SUB
* L0:
* 2* over -if L3 drop 1 + jump L4 L3: drop L4: push 2* pop
* dup a xor -if L5
* drop -if NOSUB jump SUB
* L5: drop dup inv a + inv -if L6
* drop jump NOSUB
* L6: push drop pop jump SETBIT
* SUB: inv a + inv
* SETBIT: push 1 + pop
* NOSUB:
* NEXT
* SWAP ;
* NEGATE in line; IF as section 2 compiles it. */
* over push push drop pop pop ;
* No calls inside the loop, and SWAP is in line. */
{
v4_cell loop;
v4_asm_ref skip, done;
v4_cell loop, l_sub, l_setbit, l_nosub;
v4_asm_ref r0, r1, r2, r3, r4, r5, r6, to_sub1, to_sub2, to_nosub1,
to_nosub2, to_setbit;
w_ummod = v4_asm_label(&as);
O(BANG_A); LIT(V4_CELL_BITS - 1); O(PUSH);
loop = v4_asm_label(&as);
O(OVER); CALL(w_zless); O(INV); LIT(1); O(ADD); O(PUSH);
O(DUP); CALL(w_zless); O(PUSH);
O(TWO_STAR); O(RPOP); O(RPOP); CALL(w_swap); O(PUSH); CALL(w_or); O(RPOP);
O(PUSH); CALL(w_swap); O(TWO_STAR); CALL(w_swap); O(RPOP);
O(OVER); O(PUSH_A); CALL(w_uless); CALL(w_zequal); CALL(w_or);
skip = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(PUSH_A); CALL(w_minus);
CALL(w_swap); LIT(1); CALL(w_or); CALL(w_swap);
done = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, skip, v4_asm_label(&as));
r0 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
/* hi's top bit was set: shift, then subtract regardless */
O(TWO_STAR); O(OVER);
r1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
O(DROP); LIT(1); O(ADD);
r2 = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, r1, v4_asm_label(&as));
O(DROP);
v4_asm_resolve(&as, done, v4_asm_label(&as));
v4_asm_resolve(&as, r2, v4_asm_label(&as));
O(PUSH); O(TWO_STAR); O(RPOP);
to_sub1 = v4_asm_branch_fwd(&as, V4_OP_JUMP);
/* L0: top bit clear: shift, then compare hi' with d */
v4_asm_resolve(&as, r0, v4_asm_label(&as));
O(TWO_STAR); O(OVER);
r3 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
O(DROP); LIT(1); O(ADD);
r4 = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, r3, v4_asm_label(&as));
O(DROP);
v4_asm_resolve(&as, r4, v4_asm_label(&as));
O(PUSH); O(TWO_STAR); O(RPOP);
O(DUP); O(PUSH_A); O(XOR);
r5 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
O(DROP);
to_nosub1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
to_sub2 = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, r5, v4_asm_label(&as)); /* L5 */
O(DROP); O(DUP); O(INV); O(PUSH_A); O(ADD); O(INV);
r6 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF);
O(DROP);
to_nosub2 = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, r6, v4_asm_label(&as)); /* L6 */
O(PUSH); O(DROP); O(RPOP);
to_setbit = v4_asm_branch_fwd(&as, V4_OP_JUMP);
l_sub = v4_asm_label(&as);
O(INV); O(PUSH_A); O(ADD); O(INV);
l_setbit = v4_asm_label(&as);
O(PUSH); LIT(1); O(ADD); O(RPOP);
l_nosub = v4_asm_label(&as);
v4_asm_branch(&as, V4_OP_NEXT, loop);
CALL(w_swap); O(SEMI);
O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI);
v4_asm_resolve(&as, to_sub1, l_sub);
v4_asm_resolve(&as, to_sub2, l_sub);
v4_asm_resolve(&as, to_setbit, l_setbit);
v4_asm_resolve(&as, to_nosub1, l_nosub);
v4_asm_resolve(&as, to_nosub2, l_nosub);
}
CHECK(v4_asm_ok(&as), "foundation words assemble");