||FPM040:        addw    d1,d0           | Calculate result`s exponent        subw    #FBIAS-1,d0     | Remove double bias, assume shift|#if (CPU != MC68000 && CPU != MC68010)        mulul   d2,d2:d3#else|       ifne    comp64-1        ;+++++        movew   d2,d4           | Copy Lo byte to d4 (B)        movew   d3,d5           | Copy Lo byte to d5 (D)        swap    d2              | Position for high byte multiply (A)        mulu    d2,d5           | A mid multiplication result (AD)        swap    d3              | Position for high byte multiply (C)        mulu    d3,d4           | A mid multiplication result (CB)        mulu    d3,d2           | High order words multiplied (CA)        addl    d4,d5           | Combine mid multiply results (CB + AD)        subxw   d5,d5           | Preserve carry while...        negw    d5              | ...positioning the...        swap    d5              | ...result before...        addl    d5,d2           | ...combining partial products#endif|       endc                    ;+++++        jmi     FOPRSL          | Result normalized w/o shift|        subqw   #1,d0        addl    d2,d2           | Do a left shift        jra     FOPRSL/*||       page||  FPDIV|  =====|  Single precision division operation.|*/FPRDIV:        bsr     GETFP2          | Get both operands        exg     a2,a3           | Flip the operands        exg     d0,d1        exg     d2,d3        jra     FPD001|FPDIV:        bsr     GETFP2|FPD001:        movew   a2,d4           | /* Compute result's sign */        movew   a3,d5        eorw    d4,d5        moveaw  d5,a2|        andw    d0,d0        jne     FPD010          | J/ divisor is not zero|        andw    d1,d1        jeq     FNANRS          | J/ 0.0 / 0.0 -> NaN        cmpiw   #0xFF,d1        jne     FINFRS          | J/ num / 0.0 -> INF        lsll    #1,d3        jeq     FINFRS          | J/ INF / 0.0 -> INF        jra     FNANRS          | J/ NaN / 0.0 -> NaN|FPD010:        cmpiw   #0xFF,d0        jne     FPD020          | J/ divisor is a normal number|        lsll    #1,d2        jne     FNANRS          | J/  ?  / NaN -> NaN        andw    d1,d1        jeq     FZERRS          | J/ 0.0 / INF -> 0.0        cmpiw   #0xFF,d1        jne     FUNFRS          | J/ num / INF -> 0.0 (w/ underflow)        jra     FNANRS          | J/ NaN,INF / INF -> NaN|FPD020:        andw    d1,d1        jeq     FZERRS          | J/ 0.0 / num -> 0.0        cmpiw   #0xFF,d1        jne     FPD040          | J/ num / num|        lsll    #1,d3        jeq     FINFRS          | J/ INF / num -> INF        jra     FNANRS          | J/ NaN / num -> NaN/*|||  Division Algorithm:   A/(B+C) = A/B - A/B*C/B + A/B*(C/B)^2 - ...|                                = A/B * (1 - C/B + (C/B)^2)||  Choose C to be the low order byte of the 24 bit mantissa.  The|  third and succeeding corrections terms (C squared and above)|  can be neglected because they are at least thirty bits down.|*/FPD040:        subw    d1,d0        negw    d0        addw    #FBIAS,d0       | Restore bias#if (CPU != MC68000 && CPU != MC68010)        lsrl    #1,d3        clrl    d4        divul   d2,d3:d4        movel   d4,d2#else|       ifne    comp64-1        ;+++++        exg     d2,d3|        movel   d2,d4           | Copy A        lsrl    #1,d4           | Insure no overflow during divide        swap    d3        divu    d3,d4           | Top fifteen bits of A/B        movew   d4,d2           | A/B ultimately into d2        movew   d4,d5           | Copy for later opn (A/B * C)        swap    d2              | Position MS word        clrw    d4              | Zero low order bits in d4        divu    d3,d4           | Division of shifted remainder        movew   d4,d2           | Complete A/B operation|        movel   d3,d4        clrw    d4              | Create a shifted C in d4        lsrl    #1,d4           | Insure no division overflow        divu    d3,d4           | Division (complete since C is 8 bits)|        mulu    d5,d4           | A/B * C        lsrl    #8,d4           | Position A/B * C        lsrl    #7,d4        subl    d4,d2#endif|       endc                    ;+++++        jmi     FOPRSL          | J/ result normalized|        subqw   #1,d0        addl    d2,d2           | Normalize it        jra     FOPRSL/*||       page||  FPCMP|  =====|  Single Precision comparison routine.||  Compare the two arguments provided and set the condition code|  register bits N, Z, and V as follows:||      N  Z  V   Relation|      =  =  =   ====================================|      1  0  0   X > Y   (X is top argument on stack)|      0  1  0   X = Y   (within FFUZZ specification)|      0  0  0   X < Y|      0  0  1   X does not compare to Y||*/|       .set    FFUZZ,20                | Twenty bits of fuzzFPCMP:        bsr     GETFP2        cmpiw   #0xFF,d0        jne     FPC020          | J/ X is not INF or NaN|        lsll    #1,d2           | Remove implicit bit        jeq     FPC005          | J/ X is INF|FPC001:        |dsw    0               | **  X does not compare to Y  **        moveq   #CCRV,d0        | CCR V bit        movew   d0,ccr        jmp     a0@             | Return|FPC005:        cmpiw   #0xFF,d1        jne     FPC009          | J/ Y is not INF or NaN|        lsll    #1,d3        jne     FPC001          | J/ Y is NaN (does not compare)|        cmpaw   a2,a3        jeq     FPC001          | /* J/ INF's with same sign - no compare */|FPC009:        movew   a2,d0           | /* Result based on compl. of X's sign */        eoriw   #CCRN,d0        jra     FPC011|FPC010:        movew   a3,d0           | /* Set result based on Y's sign */FPC011:        andiw   #CCRN,d0        movew   d0,ccr        jmp     a0@||FPC020:        cmpiw   #0xFF,d1        jne     FPC030          | J/ Y is not NaN or INF|        lsll    #1,d3        jne     FPC001          | J/ Y is NaN - no comparison        jra     FPC010          | /* Result is based on Y's sign */|FPC030:        cmpaw   a2,a3        jne     FPC010          | /* J/ signs different - use Y's sign */|        movew   d0,d4        movew   d0,d5           | /* Assume X's exp is larger */        subw    d1,d4           | Calc difference in exponents        jpl     FPC031          | J/ positive        movew   d1,d5           | /* Y's exp is larger */        negw    d4FPC031:        |dsw    0|        lsrw    #1,d4        jeq     FPC040          | Must subtract to obtain result|        subw    d0,d1        subxw   d0,d0           | Set d0 to sign of Y[exp]-X[exp]        movew   a2,d1        eorw    d1,d0           | Flip if negative values        jra     FPC011          | Result based on value in d0|FPC040:        movew   d5,sp@- | Save max exp value, return address        movel   a0,sp@-|        movew   a2,d5        notw    d5              | Flip sign of opnd (force subtract)        moveaw  d5,a2|        pea     FPC041        movel   sp@+,a0 | Return address in a0|        jra     FPXSUB|FPC041:        movel   sp@+,d0        movel   sp@,a0        movel   d0,sp@        movel   a0,sp@-|        bsr     GETFP1          | Fetch and unpack result|        movew   sp@+,d5 | Recall max exp value|        andw    d0,d0        jeq     FPC050          | J/ zero result|        subw    d0,d5        cmpiw   #FFUZZ,d5        jge     FPC050          | J/ within FFUZZ specification - zero|        movew   a2,d0           | Sign of result into d0        jra     FPC011          | Comparison result from sign of sub|FPC050:        subw    d0,d0           | Force CCR to say "Z"        jmp     a0@             | Return/*||       page||  GETFP2|  ======|  Routine called to extract two single precision arguments from|  the system stack and place them in the 68000`s registers.|*/GETFP2:        moveal  sp@+,a1 | /* GETFP2's return address */        moveal  sp@+,a0 | Calling routines return address|        movel   sp@+,d0 | Get TOS (source) operand        asll    #1,d0           | Sign bit to carry        subxw   d2,d2           | Fill d2 with sign bit        movew   d2,a2           | Sign bit info to a2        roll    #8,d0           | Left justify mantissa, position exp        movel   d0,d2           | Copy into mantissa register        andiw   #0xFF,d0                | Mask to exponent field        jeq     GETF21          | J/ zero value|        andiw   #0xFE00,d2      | Zero sign bit and exponent bits in d2        lsrl    #1,d2           | Position mantissa        bset    #31,d2          | Set implicit bit in d2|GETF21:        |dsw    0|        movel   sp@+,d1 | Get NOS (source) operand        asll    #1,d1           | Sign bit to carry        subxw   d3,d3           | Replicate sign bit throughout d3        movew   d3,a3           | Sign bit info into a3        roll    #8,d1           | Left justify mantissa, position exp        movel   d1,d3           | Copy into mantissa register        andiw   #0xFF,d1                | Mask to exponent field        jeq     GETF22          | J/ zero value|        andiw   #0xFE00,d3      | Zero sign bit and exponent bits in d3        lsrl    #1,d3           | Position mantissa        bset    #31,d3          | Set implicit bit in d3|GETF22:        jmp     a1@             | Return to caller, its ret addr in a0/*|||       page||  GETFP1|  ======|  Routine called to extract a single precision argument from the|  system stack and place it (unpacked) into the 68000's registers.|*/GETFP1:        moveal  sp@+,a1 | /* Get GETFP1's return address */        moveal  sp@+,a0 | Get calling routines return address|        movel   sp@+,d0 | Get argument        asll    #1,d0           | Sign bit into carry        subxw   d2,d2           | Replicate sign bit throughout d2        movew   d2,a2           | Sign bit info into a2        roll    #8,d0           | Left justify mantissa, position exp        movel   d0,d2        andiw   #0xFF,d0                | Mask to exponent field        jeq     GETF11          | J/ zero value|        andiw   #0xFE00,d2      | Zero sign bit and exponent bits in d2        lsrl    #1,d2           | Position mantissa        bset    #31,d2          | Set implicit bit|GETF11:        jmp     a1@             | Return to caller, its ret addr in a0/*|||       page||  FOPRSL|  ======|  Single precision floating point result (main entry w/ round).|  Mantissa in D2, exponent in D0, sign in A2, and return address|  in A0.  Place a format value on the stack.|*/FOPRSL:        addl    #0x80,d2                | Round the value        jcc     FOPR01          | J/ no carry out|        roxrl   #1,d2           | Adjust mantissa and exponent        addqw   #1,d0|FOPR01:        andw    d0,d0        jle     FUNFRS          | J/ underflow|        cmpiw   #0xFF,d0                | Check for overflow        jge     FINFRS          | J/ overflow|FOPR02:        andiw   #0xFF00,d2      | Trim mantissa        asll    #1,d2           | Drop implicit bit        addw    d0,d2           | Blend in the exponent        rorl    #8,d2           | Reposition value        movew   a2,d0        aslw    #1,d0           | Sign bit into carry/extend        roxrl   #1,d2           | Finish construction of value        movel   d2,sp@-|        moveb   #0,FPERR        | No floating point error        jmp     a0@             | Return|||FNANRS:        moveq   #-1,d0          | Set d0 to 0xFFFFFFFF        movel   d0,sp@- | NaN value|        moveb   #ERNAN,FPERR        moveb   #-1,NANFLG        jmp     a0@||FINFRS:        movel   a2,d0           | Get sign information        movel   #0xFF000000,d1        aslw    #1,d0        roxrl   #1,d1        movel   d1,sp@-|        moveb   #EROVF,FPERR        moveb   #-1,INFFLG        jmp     a0@||FUNFRS:        moveb   #ERUNF,FPERR        moveb   #-1,UNFFLG        jra     FZER01||FZERRS:        moveb   #0,FPERR||FZER01:        subl    d0,d0        movel   d0,sp@-        jmp     a0@|||       end