( fix32.tal )
( )
( 32-bit fixed point using 1000, i.e. 0x03e8, as a denominator.

%POP4 { POP2 POP2 }
%POP8 { POP2 POP2 POP2 POP2 }
%DENOM16 { #03e8 }
%DENOM32 { #0000 #03e8 }

|0100
    ( test cases -- compare the two 32-bit values on wst )

    #0000 #03e8 ( a=1 )
    #0000 #07d0 ( b=2 )
    x32-add     ( a+b )
    #0000 #0bb8 ( c=3 )
    #010e DEO POP4 POP4 #0a18 DEO

    #0000 #07d0 ( a=2 )
    #0000 #0bb8 ( b=3 )
    x32-mul     ( a*b )
    #0000 #1770 ( c=6 )
    #010e DEO POP4 POP4 #0a18 DEO

    #0000 #4a38 ( a=19 )
    #0000 #6978 ( b=27 )
    x32-mul     ( a*b )
    #0007 #d3d8 ( c=513 )
    #010e DEO POP4 POP4 #0a18 DEO

    #0000 #1d4c ( a=7.5 )
    #0000 #05dc ( b=1.5 )
    x32-div     ( a/b )
    #0000 #1388 ( c=5.0 )
    #010e DEO POP4 POP4 #0a18 DEO

    #010e DEO #800f DEO BRK ( ensure stack is empty )

@x32-eq ( x/** y/** -> bool^ ) !u32-eq
@x32-ne ( x/** y/** -> bool^ ) !u32-ne

@x32-is-zero ( x/** -> bool^ ) !u32-is-zero
@x32-non-zero ( x/** -> bool^ ) !u32-non-zero
@x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 JMP2r
@x32-is-negative ( x/** -> bool^ ) POP2 #7fff GTH2 JMP2r

@x32-from-u8 ( x^ -> x/** )
    #0000 ROT OVR SWP DENOM32 !u32-mul

@x32-from-u16 ( x* -> x/** )
    #0000 SWP2 DENOM32 !u32-mul

@x32-from-u32 ( x** -> x/** )
    DENOM32 !u32-mul

@x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
    OVR2 #8000 LTH2 ,&yp STR STH2 STH2
    OVR2 #8000 LTH2 ,&xp STR STH2r STH2r
    LIT2 [ &xp $1 &yp $1 ] JMP2r

( TODO: test these implementations )
@x32-lt-old ( x** y** -> x<y^ )
    STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{    ( ; do x and y have different signs? )
        POP2r POP2r POP2 #8000 GTH2 JMP2r ( ; signs differ, is x negative? )
    } GTH2r STHr ?{                       ( ; same signs, is xlo < ylo? )
        LTH2 JMP2r                        ( ; no, is xhi < yhi? )
    } GTH2 #00 EQU JMP2r                  ( ; yes, is xhi <= yhi? )

( TODO: test these implementations )
@x32-gt-old ( x** y** -> x<y^ )
    STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{    ( ; do x and y have different signs? )
        POP2r POP2r POP2 #8000 LTH2 JMP2r ( ; signs differ, is x positive? )
    } LTH2r STHr ?{                       ( ; same signs, is xlo > ylo? )
        GTH2 JMP2r                        ( ; no, is xhi > yhi? )
    } LTH2 #00 EQU JMP2r                  ( ; yes, is xhi >= yhi? )

@x32-lt ( x/** y/** -> bool^ )
    x32-prepare-cmp NEQk ?{ POP2 !u32-lt } LTH STH POP8 STHr JMP2r

@x32-gt ( x/** y/** -> bool^ )
    x32-prepare-cmp NEQk ?{ POP2 !u32-gt } GTH STH POP8 STHr JMP2r

@x32-lteq ( x/** y/** -> bool^ )
    x32-prepare-cmp NEQk ?{ POP2 !u32-lteq } LTH STH POP8 STHr JMP2r

@x32-gteq ( x/** y/** -> bool^ )
    x32-prepare-cmp NEQk ?{ POP2 !u32-gteq } GTH STH POP8 STHr JMP2r

@x32-add ( x/** y/** -> z/** )
    !u32-add

@x32-sub ( x/** y/** -> z/** )
    !u32-sub

@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

( [x * y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
@x32-mul ( x/** y/** -> z/** )
    STH2 STH2 DENOM32  ( x/** 1000** [ylo* yhi*] )
    u32-divmod                  ( q** r** [ylo* yhi*] )
    STH2kr OVR2r STH2r u32-mul    ( q** ry** [ylo* yhi*] )
    DENOM32 u32-div             ( q** ry1000** [ylo* yhi*] )
    ROT2 STH2 ROT2 STH2r        ( ry1000** q** [ylo* yhi*] )
    STH2r STH2r u32-mul         ( ry1000** qy** )
    u32-add     ( qy+ry/1000** )
    JMP2r                       ( z/** )

( [x * 1000]/y = floor[x/y]*1000 + [[x%y]*1000]/y )
@x32-div ( x/** y/** -> z/** )
    STH2k OVR2 STH2             ( x/** y/** [ylo* yhi*] )
    u32-divmod
    DENOM32 u32-mul        ( q** r1000** [ylo* yhi*] )
    STH2r STH2r u32-div      ( q** r1000/y** [ylo* yhi*] )
    ROT2 STH2 ROT2 STH2r            ( r1000/y** q** [ylo* yhi*] )
    DENOM32 u32-mul               ( r1000/y** q1000** )
    u32-add     ( q+r1000/y** )
    JMP2r                       ( z/** )

~math32.tal