diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index fd893f59..2cfb4c70 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -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 ) diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index b94fff3f..55401678 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -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");