seems to be working

fix32.tal

@@ -1,9 +1,48 @@
 ( fix32.tal )
 ( )
-( 32-bit fixed point using 1000, i.e. 0x03e8, as a denominator. )
+( 32-bit fixed point using 1000 as a denominator. )
+( )
+( LONG                FRACTION        DECIMAL )
+( 0000 0000             0/1000          0.000 )
+( 0000 0001             1/1000          0.001 )
+( 0000 000a            10/1000          0.010 )
+( 0000 0064           100/1000          0.100 )
+( 0000 00fa           250/1000          0.250 )
+( 0000 01f4           500/1000          0.500 )
+( 0000 03e8          1000/1000          1.000 )
+( 0000 3e80         16000/1000         16.000 )
+( 0001 0000         65536/1000         65.536 )
+( 7fff ffff    2147483647/1000    2147483.647 )
+( 8000 0000            invalid        invalid )
+( 8000 0001   -2147483647/1000   -2147483.647 )
+( ffff fc18         -1000/1000         -1.000 )
+( ffff ffff            -1/1000         -0.001 )
+( )
+( instead of overflowing operations will saturate )
+( at the maximum/minimum values. )
+( )
+( rounding caused by division will round toward )
+( the nearest even value. for example: )
+( )
+(     0.000 / 2 = 0.000 )
+(     0.001 / 2 = 0.000 )
+(     0.002 / 2 = 0.001 )
+(     0.003 / 2 = 0.002 )
+(     0.004 / 2 = 0.002 )
+(     0.005 / 2 = 0.002 )
+(     0.006 / 2 = 0.003 )
+(     0.007 / 2 = 0.004 )
+( )
+( this is done to prevent numerical bias. it is also )
+( called banker's rounding, or round-half-to-even. )
+( )
+( x/** signifies a 32-bit fixed point value. )
+( x** signfiies a 32-bit value of any kind. )
 
 %POP4 { POP2 POP2 }
 %POP8 { POP2 POP2 POP2 POP2 }
+%STH4 { STH2 STH2 }
+%STH4r { STH2r STH2r }
 %DENOM16 { #03e8 }
 %DENOM32 { #0000 #03e8 }
 
@@ -34,8 +73,8 @@
     NIPr STHr ?{ u32-negate } JMP2r      ( z** )
 
 @x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
-    OVR2 #8000 LTH2 ,&yp STR STH2 STH2
+    OVR2 #8000 LTH2 ,&yp STR STH4
-    OVR2 #8000 LTH2 ,&xp STR STH2r STH2r
+    OVR2 #8000 LTH2 ,&xp STR STH4r
     LIT2 [ &xp $1 &yp $1 ] JMP2r
 
 ( TODO: test these implementations )
@@ -70,37 +109,34 @@
 ( TODO: support signed operations )
 
 @x32-add ( x/** y/** -> z/** )
-    !u32-add
+    STH4 OVR2 #8000 AND2           ( x** xs* [ylo* yhi*] )
+    STH2kr #8000 AND2              ( x** xs* ys* [ylo* yhi*] )
+    EQU2k ?{ POP4 STH4r !u32-add } ( z** xs* ys* [ylo* yhi*] )
+    POP2 ROT2 ROT2 STH4r           ( sign* x** y** )
+    u32-add ROT2 STH2              ( z** [sign*] )
+    OVR2 #8000 AND2 STH2kr         ( z** zs* sign* [sign*] )
+    NEQ2 ?{ POP2r JMP2r }          ( z** [sign*] )
+    POP4 POPr STHr ?&negative      ( )
+    #7fff #ffff JMP2r              ( 7fff* ffff* )
+    &negative #8000 #0001 JMP2r    ( 8000* 0001* )
 
 @x32-sub ( x/** y/** -> z/** )
-    !u32-sub
+    u32-negate !x32-add
 
 @x32-negate ( x/** y/** -> z/** )
     !u32-negate
 
-( multiply a fixed point number by an unsigned integer )
-@x32-scaled-mul32 ( x/** y** -> z/** )
-    !u32-mul
-
-( multiply a fixed point number by an unsigned integer )
-@x32-scaled-mul16 ( x/** y* -> z/** )
-    !u32-mul16
-
-@x32-scaled-div32 ( x/** y** -> z/** )
-    !u32-div
-
 @x32-mul ( x/** y/** -> z/** )
     ;x32-mul-unsigned !x32-signed-op
 
 ( [x*y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
 @x32-mul-unsigned ( x/** y/** -> z/** )
-    STH2 STH2 DENOM32           ( x** 1000** [ylo* yhi*] )
+    STH4 DENOM32 u32-divmod     ( q=x/1000** r=x%1000** [ylo* yhi*] )
-    u32-divmod                  ( q=x/1000** r=x%1000** [ylo* yhi*] )
     STH2kr OVR2r STH2r u32-mul  ( q** ry** [ylo* yhi*] )
     DENOM32 u32-divmod          ( q** rq=ry/1000** rr=ry%1000** [ylo* yhi*] )
     NIP2 ,&r1 STR2              ( q** rq** [ylo* yhi*] ; <-rr1 )
     ROT2 STH2 ROT2 STH2r        ( ry/1000** q** [ylo* yhi*] )
-    STH2r STH2r u32-mul         ( ry/1000** qy** )
+    STH4r u32-mul               ( ry/1000** qy** )
     u32-add                     ( z=qy+ry/1000** )
     DUP2 #0001 AND2 STH2        ( z** [odd*] )
     #0000 LIT2 [ &r1 $2 ]       ( z** rr** [odd*] )
@@ -129,15 +165,22 @@
     STH2kr OVR2r STH2r              ( z** w** y** [ylo* yhi*] )
     #0000 #0001 u32-sub             ( z** w** y-1** [ylo* yhi*] )
     #01 u32-rshift u32-add          ( z** v=w+y-1/2** [ylo* yhi*] )
-    STH2r STH2r u32-div !u32-add    ( z+v/y** )
+    STH4r u32-div !u32-add          ( z+v/y** )
 
 ( print an x32 number to stdout )
 @x32-emit ( x/** -> )
     ;x32-emit/draw-ch !x32-draw
     &draw-ch ( c^ -> ) #18 DEO JMP2r
 
-( draw an x32 number using the given character-drawing subroutine )
 @x32-draw ( x/** draw-char* -> )
+    STH2 OVR2 #8000 LTH2 ?{
+        LIT "- STH2kr JSR2
+        u32-negate
+    }
+    STH2r ( >> )
+
+( draw an x32 number using the given character-drawing subroutine )
+@x32-draw-unsigned ( x/** draw-char* -> )
     ,&f STR2 LITr 00             ( x** [0^] )
     &loop                        ( x1** [... count^] )
         #0000 #000a u32-divmod   ( q** r** )
@@ -147,8 +190,7 @@
         INCr LITr ". SWPr        ( q** [... c^ dot^ count+2^] )
     &next                        ( q** [... count+n^ )
         OVR2 OVR2                ( q** q** [... count+n^] )
-        u32-non-zero ?&loop      ( q** [... count+n^] )
+        u32-non-zero ?&loop POP4 ( [... count+n^] )
-        POP2 POP2                ( [... count+n^] )
     &pad                         ( [... count+n^] )
         STHkr #04 GTH ?&unroll   ( [... count+n^] )
         STHkr #03 NEQ ?{ INCr LITr ". SWPr }

test-fix32.tal

@@ -7,6 +7,10 @@
 ( program )
 |0100
     #0000 #03e8 #0000 #07d0 LIT "+ ;x32-add #0000 #0bb8 test-binop ( 1 + 2 = 3 )
+    #ffff #fc18 #ffff #fc18 LIT "+ ;x32-add #ffff #f830 test-binop ( -1 + -1 = -2 )
+    #7fff #ffff #7fff #ffff LIT "+ ;x32-add #7fff #ffff test-binop ( inf + inf = inf )
+    #8000 #0001 #8000 #0001 LIT "+ ;x32-add #8000 #0001 test-binop ( -inf + -inf = -inf )
+    #0001 #e078 #ffff #a628 LIT "+ ;x32-add #0001 #86a0 test-binop ( 123.0 + -23.0 = 100.0 )
     #0a18 DEO
     #0000 #03e8 #0000 #03e8 LIT "* ;x32-mul #0000 #03e8 test-binop ( 1 * 1 = 1 )
     #0000 #07d0 #0000 #0bb8 LIT "* ;x32-mul #0000 #1770 test-binop ( 2 * 3 = 6 )
@@ -29,12 +33,20 @@
     #0000 #0005 #0000 #07d0 LIT "/ ;x32-div #0000 #0002 test-binop ( 0.005 / 2 = 0.002 )
     #0000 #0007 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.007 / 2 = 0.004 )
     #0000 #0009 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.009 / 2 = 0.004 )
+    #ffff #fffd #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.003 / 2 = -0.002 )
+    #ffff #fffb #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.005 / 2 = -0.002 )
+    #ffff #fff9 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.007 / 2 = -0.004 )
+    #ffff #fff7 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.009 / 2 = -0.004 )
     #0a18 DEO
     #0000 #0001 x32-emit #0a18 DEO
     #0000 #03e8 x32-emit #0a18 DEO
+    #0001 #0000 x32-emit #0a18 DEO
     #0001 #e078 x32-emit #0a18 DEO
     #0123 #4567 x32-emit #0a18 DEO
     #7fff #ffff x32-emit #0a18 DEO
+    #8000 #0001 x32-emit #0a18 DEO
+    #ffff #fc18 x32-emit #0a18 DEO
+    #ffff #ffff x32-emit #0a18 DEO
     #800f DEO BRK
 
 ~fix32.tal