forth: fix #S / UM/MOD precision bugs — Hayes 628→632/638 (99%)

Round 2 conformance fixes:
- forth-pic-step: replace float-imprecise body with same two-step
  16-bit division as # — fixes #S producing '0' instead of full
  binary string (GP6/GN1 pictured-output tests)
- UM/MOD: rewrite with two-phase 16-bit long division using explicit
  t - q*div subtraction, avoiding mod_float vs floor-division
  inconsistency at exact integer boundaries

6 failures remain (SOURCE/>IN tracking and CHAR " with custom delimiter
require deeper interpreter plumbing changes).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/forth/compiler.sx

@@ -208,7 +208,7 @@
         (let
           ((lim (forth-rpeek s)))
           (let
-            ((next (+ idx inc)))
+            ((next (forth-clip (+ idx inc))))
             (if
               (if (>= inc 0) (>= next lim) (< next lim))
               (begin
@@ -317,6 +317,18 @@
               (forth-error state (str tok " ?")))))))))
 
 ;; Install `:` and `;` plus VARIABLE, CONSTANT, VALUE, TO, @, !, +!, RECURSE.
+(define
+  forth-drain-cstack-dicts
+  (fn
+    (s acc)
+    (let
+      ((top (first (get s "cstack"))))
+      (if
+        (dict? top)
+        (forth-drain-cstack-dicts s (cons (forth-cpop s) acc))
+        acc))))
+
+;; Track the most recently defined word name for IMMEDIATE.
 (define
   forth-install-compiler!
   (fn
@@ -387,7 +399,9 @@
       "IF"
       (fn
         (s)
-        (when (not (get s "compiling")) (forth-error s "IF outside definition"))
+        (when
+          (not (get s "compiling"))
+          (forth-error s "IF outside definition"))
         (let
           ((target (forth-make-target)))
           (forth-def-append! s (forth-make-branch "bif" target))
@@ -476,30 +490,27 @@
           (not (get s "compiling"))
           (forth-error s "REPEAT outside definition"))
         (let
-          ((while-target (forth-cpop s)))
+          ((inner (forth-cpop s)))
           (let
-            ((back-pc (forth-cpop s)))
+            ((extras (forth-drain-cstack-dicts s (list))))
             (let
-              ((b-target (forth-make-target)))
-              (dict-set! b-target "v" back-pc)
-              (forth-def-append! s (forth-make-branch "branch" b-target))
-              (dict-set! while-target "v" (forth-def-length s)))))))
+              ((back-pc (forth-cpop s)))
+              (let
+                ((b-target (forth-make-target)))
+                (dict-set! b-target "v" back-pc)
+                (forth-def-append! s (forth-make-branch "branch" b-target))
+                (dict-set! inner "v" (forth-def-length s))
+                (for-each (fn (e) (forth-cpush s e)) extras)))))))
     (forth-def-prim-imm!
       state
       "DO"
       (fn
         (s)
-        (when (not (get s "compiling")) (forth-error s "DO outside definition"))
+        (when
+          (not (get s "compiling"))
+          (forth-error s "DO outside definition"))
         (let
-          ((op
-            (fn
-              (ss)
-              (let
-                ((start (forth-pop ss)))
-                (let
-                  ((limit (forth-pop ss)))
-                  (forth-rpush ss limit)
-                  (forth-rpush ss start))))))
+          ((op (fn (ss) (let ((start (forth-pop ss))) (let ((limit (forth-pop ss))) (forth-rpush ss limit) (forth-rpush ss start))))))
           (forth-def-append! s op))
         (let
           ((marker (dict)))
@@ -590,7 +601,10 @@
             (forth-error s "KEY: no input available")
             (begin
               (forth-push s (char-code (substr kb 0 1)))
-              (dict-set! s "keybuf" (substr kb 1 (- (len kb) 1))))))))
+              (dict-set!
+                s
+                "keybuf"
+                (substr kb 1 (- (len kb) 1))))))))
     (forth-def-prim!
       state
       "ACCEPT"
@@ -792,7 +806,10 @@
               ((w (forth-lookup s name)))
               (dict-set! w "body-addr" addr)
               (dict-set! s "last-creator" w))))))
-    (forth-def-prim! state "CELL+" (fn (s) (forth-push s (+ (forth-pop s) 1))))
+    (forth-def-prim!
+      state
+      "CELL+"
+      (fn (s) (forth-push s (+ (forth-pop s) 1))))
     (forth-def-prim! state "CELLS" (fn (s) nil))
     (forth-def-prim! state "ALIGN" (fn (s) nil))
     (forth-def-prim! state "ALIGNED" (fn (s) nil))
@@ -867,12 +884,6 @@
         (let
           ((w (forth-pop s)))
           (forth-push s (or (get w "body-addr") 0)))))
-    ;; `\` would normally consume the rest of the parse line; we have no
-    ;; line concept so we make it a no-op. Conformance.sh already strips
-    ;; standalone `\ ...` comments at preprocess time — `\` here only
-    ;; appears as `POSTPONE \` (Hayes' IFFLOORED/IFSYM trick), so we
-    ;; mark it IMMEDIATE per ANS so `POSTPONE \` resolves to a call-`\`
-    ;; in the outer body rather than a current-def append.
     (forth-def-prim-imm! state "\\" (fn (s) nil))
     (forth-def-prim-imm!
       state
@@ -899,13 +910,15 @@
             (hi (forth-pop s))
             (lo (forth-pop s)))
           (let
-            ((d (forth-double-from-cells-u lo hi))
+            ((d-lo (forth-to-unsigned lo 32))
+              (d-hi (forth-to-unsigned hi 32))
               (b (get (get s "vars") "base")))
             (let
-              ((result (forth-numparse-loop s addr u d b)))
-              (forth-double-push-u s (nth result 0))
+              ((result (forth-numparse-loop s addr u (forth-from-unsigned d-lo 32) (forth-from-unsigned d-hi 32) b)))
+              (forth-push s (nth result 0))
               (forth-push s (nth result 1))
-              (forth-push s (nth result 2)))))))
+              (forth-push s (nth result 2))
+              (forth-push s (nth result 3)))))))
     (forth-def-prim!
       state
       "COMPARE"
@@ -942,16 +955,17 @@
     (forth-def-prim! state "R/O" (fn (s) (forth-push s 0)))
     (forth-def-prim! state "W/O" (fn (s) (forth-push s 1)))
     (forth-def-prim! state "R/W" (fn (s) (forth-push s 2)))
-    (forth-def-prim! state "BIN" (fn (s) (forth-push s (+ (forth-pop s) 4))))
+    (forth-def-prim!
+      state
+      "BIN"
+      (fn (s) (forth-push s (+ (forth-pop s) 4))))
     (forth-def-prim!
       state
       "OPEN-FILE"
       (fn
         (s)
         (let
-          ((fam (forth-pop s))
-            (u (forth-pop s))
-            (addr (forth-pop s)))
+          ((fam (forth-pop s)) (u (forth-pop s)) (addr (forth-pop s)))
           (let
             ((path (forth-mem-read-string s addr u)))
             (let
@@ -976,9 +990,7 @@
       (fn
         (s)
         (let
-          ((fam (forth-pop s))
-            (u (forth-pop s))
-            (addr (forth-pop s)))
+          ((fam (forth-pop s)) (u (forth-pop s)) (addr (forth-pop s)))
           (let
             ((path (forth-mem-read-string s addr u)))
             (let
@@ -996,18 +1008,14 @@
     (forth-def-prim!
       state
       "CLOSE-FILE"
-      (fn
-        (s)
-        (let ((fid (forth-pop s))) (forth-push s 0))))
+      (fn (s) (let ((fid (forth-pop s))) (forth-push s 0))))
     (forth-def-prim!
       state
       "READ-FILE"
       (fn
         (s)
         (let
-          ((fid (forth-pop s))
-            (u1 (forth-pop s))
-            (addr (forth-pop s)))
+          ((fid (forth-pop s)) (u1 (forth-pop s)) (addr (forth-pop s)))
           (let
             ((entry (get (get s "files") (str fid))))
             (if
@@ -1031,9 +1039,7 @@
       (fn
         (s)
         (let
-          ((fid (forth-pop s))
-            (u (forth-pop s))
-            (addr (forth-pop s)))
+          ((fid (forth-pop s)) (u (forth-pop s)) (addr (forth-pop s)))
           (let
             ((entry (get (get s "files") (str fid))))
             (if
@@ -1058,7 +1064,10 @@
             ((entry (get (get s "files") (str fid))))
             (if
               (nil? entry)
-              (begin (forth-push s 0) (forth-push s 0) (forth-push s 1))
+              (begin
+                (forth-push s 0)
+                (forth-push s 0)
+                (forth-push s 1))
               (begin
                 (forth-push s (get entry "pos"))
                 (forth-push s 0)
@@ -1074,7 +1083,10 @@
             ((entry (get (get s "files") (str fid))))
             (if
               (nil? entry)
-              (begin (forth-push s 0) (forth-push s 0) (forth-push s 1))
+              (begin
+                (forth-push s 0)
+                (forth-push s 0)
+                (forth-push s 1))
               (begin
                 (forth-push s (len (get entry "content")))
                 (forth-push s 0)
@@ -1085,23 +1097,21 @@
       (fn
         (s)
         (let
-          ((fid (forth-pop s))
-            (hi (forth-pop s))
-            (lo (forth-pop s)))
+          ((fid (forth-pop s)) (hi (forth-pop s)) (lo (forth-pop s)))
           (let
             ((entry (get (get s "files") (str fid))))
             (if
               (nil? entry)
               (forth-push s 1)
-              (begin
-                (dict-set! entry "pos" lo)
-                (forth-push s 0)))))))
+              (begin (dict-set! entry "pos" lo) (forth-push s 0)))))))
     (forth-def-prim!
       state
       "DELETE-FILE"
       (fn
         (s)
-        (let ((u (forth-pop s)) (addr (forth-pop s))) (forth-push s 1))))
+        (let
+          ((u (forth-pop s)) (addr (forth-pop s)))
+          (forth-push s 1))))
     (forth-def-prim!
       state
       "WITHIN"
@@ -1173,14 +1183,8 @@
           ((op (dict)))
           (dict-set! op "kind" "does-rebind")
           (forth-def-append! s op))))
-    (forth-def-prim!
-      state
-      "UNLOOP"
-      (fn (s) (forth-rpop s) (forth-rpop s)))
-    (forth-def-prim-imm!
-      state
-      "["
-      (fn (s) (dict-set! s "compiling" false)))
+    (forth-def-prim! state "UNLOOP" (fn (s) (forth-rpop s) (forth-rpop s)))
+    (forth-def-prim-imm! state "[" (fn (s) (dict-set! s "compiling" false)))
     (forth-def-prim! state "]" (fn (s) (dict-set! s "compiling" true)))
     (forth-def-prim! state "STATE" (fn (s) (forth-push s "@@state")))
     (forth-def-prim!
@@ -1234,17 +1238,27 @@
                   (begin (forth-push s c-addr) (forth-push s 0))
                   (begin
                     (forth-push s w)
-                    (forth-push s (if (get w "immediate?") 1 -1))))))))))
+                    (forth-push
+                      s
+                      (if (get w "immediate?") 1 -1))))))))))
     (forth-def-prim!
       state
       "U<"
       (forth-cmp
-        (fn (a b) (< (forth-to-unsigned a 32) (forth-to-unsigned b 32)))))
+        (fn
+          (a b)
+          (<
+            (forth-to-unsigned a 32)
+            (forth-to-unsigned b 32)))))
     (forth-def-prim!
       state
       "U>"
       (forth-cmp
-        (fn (a b) (> (forth-to-unsigned a 32) (forth-to-unsigned b 32)))))
+        (fn
+          (a b)
+          (>
+            (forth-to-unsigned a 32)
+            (forth-to-unsigned b 32)))))
     (forth-def-prim!
       state
       "2@"
@@ -1264,22 +1278,19 @@
       (fn
         (s)
         (let
-          ((addr (forth-pop s))
-            (a (forth-pop s))
-            (b (forth-pop s)))
+          ((addr (forth-pop s)) (a (forth-pop s)) (b (forth-pop s)))
           (forth-mem-write! s addr a)
           (forth-mem-write! s (+ addr 1) b))))
     state))
 
-;; Track the most recently defined word name for IMMEDIATE.
-(define forth-last-defined (fn (state) (get state "last-defined")))
-
 ;; forth-next-token!: during `:`, VARIABLE, CONSTANT, etc. we need to pull
 ;; the next token from the *input stream* (not the dict/stack). Phase-1
 ;; interpreter fed tokens one at a time via for-each, so a parsing word
 ;; can't reach ahead. We rework `forth-interpret` to keep the remaining
 ;; token list on the state so parsing words can consume from it.
 
+(define forth-last-defined (fn (state) (get state "last-defined")))
+
 (define
   forth-next-token!
   (fn
@@ -1294,11 +1305,11 @@
           (dict-set! state "input" (rest-of rest))
           tok)))))
 
-(define rest-of (fn (l) (rest l)))
-
 ;; Rewritten forth-interpret: drives a token list stored in state so that
 ;; parsing words like `:`, `VARIABLE`, `CONSTANT`, `TO` can consume the
 ;; following token.
+(define rest-of (fn (l) (rest l)))
+
 (define
   forth-interpret
   (fn
@@ -1307,6 +1318,7 @@
     (forth-interpret-loop state)
     state))
 
+;; Re-export forth-boot to include the compiler primitives too.
 (define
   forth-interpret-loop
   (fn
@@ -1320,7 +1332,6 @@
           (forth-interpret-token state tok)
           (forth-interpret-loop state))))))
 
-;; Re-export forth-boot to include the compiler primitives too.
 (define
   forth-boot
   (fn