divu    d2,d6           | Division of shifted remainder        movew   d6,d4           | Complete 1/B approximation|        movel   d2,d6        clrw    d6              | Create a shifted C in d6 (16 bits)        lsrl    #1,d6           | Insure no division overflow        divu    d2,d6           | C/B approximation        mulu    d7,d6        lsrl    #8,d6           | Position correction term        lsrl    #7,d6        subl    d6,d4        lsll    #1,d4           | Left shift approximation        subxl   d6,d6           | Do not overflow        orl     d6,d4           | 28+ bit 1/B approx in d4, B in d2:d3        swap    d2|        movel   d4,d0           | Save X0 in d0        bsr     DPD500          | d4 * d2:d3 -> d2:d3 (in place)        negl    d3        negxl   d2        movel   d0,d4        bsr     DPD500|        asll    #1,d3        roxll   #1,d2        jcc     DPD080          | J/ no shift out        moveq   #-1,d2          | Set d2:d3 to FFFFFFFF:FFFFFFFF        moveq   #-1,d3DPD080:        |dsw    0|        movel   sp@+,d4 | Fetch dividend        movel   sp@+,d5        jra     DPM050||  DPD500:  Multiply D2:D3 by D4, top 64 bits of result in D2:D3|DPD500:        movew   d2,d1        mulu    d4,d1           | BY partial product        swap    d2        swap    d3        movew   d3,d7        movew   d2,d6        mulu    d4,d7        mulu    d4,d6           | AY:CY in d6:d7        movew   d6,d7        clrw    d6        swap    d6        swap    d7              | LSR #16,d6:d7        addl    d1,d7        clrl    d1        addxl   d1,d6           | 00:BY + 0A:YC|        swap    d4        movew   d3,d5        movew   d2,d1        mulu    d4,d5        mulu    d4,d1           | AX:CX in d1:d5        addl    d5,d7        addxl   d1,d6           | AX:CX + 00:BY + 0A:CY|        swap    d2        swap    d3        mulu    d4,d3        mulu    d4,d2           | BX:DX in d2:d3        movew   d2,d3        clrw    d2        swap    d2        swap    d3              | LSR #16,d2:d3        addl    d7,d3        addxl   d6,d2           | Result in d2:d3|        swap    d4              | Restore d4        rts#endif|       endc                    ;+++++/*||       page||  DPCMP|  =====|  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    DFUZZ,51                | Fifty-one bits of fuzzDPCMP:        bsr     GETDP2        cmpiw   #0x7FF,d0        jne     DPC020          | J/ X is not INF or NaN|        lsll    #1,d2           | Remove implicit bit        jeq     DPC005          | J/ X is INF|DPC001:        |dsw    0               | **  X does not compare to Y  **        moveq   #CCRV,d0        | CCR V bit        movew   d0,ccr        jmp     a0@             | Return|DPC005:        cmpiw   #0x7FF,d1        jne     DPC009          | J/ Y is not INF or NaN|        lsll    #1,d4        jne     DPC001          | J/ Y is NaN (does not compare)|        cmpaw   a2,a3        jeq     DPC001          | /* J/ INF's with same sign - no compare */|DPC009:        movew   a2,d0           | /* Result based on compl. of X's sign */        eoriw   #CCRN,d0        jra     DPC011|DPC010:        movew   a3,d0           | /* Set result based on Y's sign */DPC011:        andiw   #CCRN,d0        movew   d0,ccr        jmp     a0@||DPC020:        cmpiw   #0x7FF,d1        jne     DPC030          | J/ Y is not NaN or INF|        lsll    #1,d4        jne     DPC001          | J/ Y is NaN - no comparison        jra     DPC010          | /* Result is based on Y's sign */|DPC030:        cmpaw   a2,a3        jne     DPC010          | /* J/ signs different - use Y's sign */|        movew   d0,d6        movew   d0,d7           | /* Assume X's exp is larger */        subw    d1,d6           | Calc difference in exponents        jpl     DPC031          | J/ positive        movew   d1,d7           | /* Y's exp is larger */        negw    d6DPC031:        |dsw    0|        lsrw    #1,d6        jeq     DPC040          | 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     DPC011          | Result based on value in d0|DPC040:        movew   d7,sp@- | Save max exp value, return address        movel   a0,sp@-|        movew   a2,d7        notw    d7              | Flip sign of opnd (force subtract)        moveaw  d7,a2|        pea     DPC041        movel   sp@+,a0 | Return address in a0|        jra     DPXSUB|DPC041:        movel   sp@+,d0        movel   sp@+,d1        moveal  sp@,a0        movel   d1,sp@        movel   d0,sp@-        movel   a0,sp@-        bsr     GETDP1          | Fetch and unpack result|        movew   sp@+,d5 | Recall max exp value|        andw    d0,d0        jeq     DPC050          | J/ zero result|        subw    d0,d5        cmpiw   #DFUZZ,d5        jge     DPC050          | J/ within FFUZZ specification - zero|        movew   a2,d0           | Sign of result into d0        jra     DPC011          | Comparison result from sign of sub|DPC050:        subw    d0,d0           | Force CCR to say "Z"        jmp     a0@             | Return/*||       page||  GETDP2|  ======|  Routine called to extract two double precision arguments from|  the system stack and place them in the 68000`s registers.|*/GETDP2:        moveal  sp@+,a1 | /* GETDP2's return address */        moveal  sp@+,a0 | Calling routines return address|        movel   sp@+,d0 | Get TOS (source) operand        movel   sp@+,d3 | Get low long word        subw    d2,d2           | Clear carry        roxll   #1,d0           | Sign bit to bit 0        subxw   d2,d2           | Fill d2 with sign bit        moveaw  d2,a2           | Sign bit info to a2        roll    #8,d0           | Left justify mantissa, position exp        roll    #3,d0        movel   d0,d2           | Copy into mantissa register        andiw   #0x7FF,d0       | Mask to exponent field        jeq     GETD21          | J/ zero value|        eorw    d0,d2           | Zero exponent bits in d2        lsrl    #1,d2           | Position mantissa        bset    #31,d2          | Set implicit bit in d2        roll    #8,d3           | Position lo long word of mantissa        roll    #3,d3        eorw    d3,d2           | Clever use of EOR to move bits        andiw   #0xF800,d3      | Trim off bits moved into d2        eorw    d3,d2           | Remove noise in d2|GETD21:        |dsw    0|        movel   sp@+,d1 | Get NOS (source) operand        movel   sp@+,d5        subw    d4,d4           | Clear carry        roxll   #1,d1           | Sign bit carry        subxw   d4,d4           | Replicate sign bit throughout d4        moveaw  d4,a3           | Sign bit info into a3        roll    #8,d1           | Left justify mantissa, position exp        roll    #3,d1        movel   d1,d4           | Copy into mantissa register        andiw   #0x7FF,d1       | Mask to exponent field        jeq     GETD22          | J/ zero value|        eorw    d1,d4           | Zero exponent bits in d4        lsrl    #1,d4           | Position mantissa        bset    #31,d4          | Set implicit bit in d4        roll    #8,d5           | Position low long word of mantissa        roll    #3,d5        eorw    d5,d4           | Clever use of EOR to move bits        andiw   #0xF800,d5      | Trim off bits moved into d4        eorw    d5,d4           | Remove noise in d4|GETD22:        jmp     a1@             | Return to caller, its ret addr in a0/*|||       page||  GETDP1|  ======|  Routine called to extract a double precision argument from the|  system stack and place it (unpacked) into the 68000's registers.|*/GETDP1:        moveal  sp@+,a1 | /* Get GETDP1's return address */        moveal  sp@+,a0 | Get calling routines return address|        movel   sp@+,d0 | Get argument        movel   sp@+,d3        subw    d2,d2           | Clear carry        roxll   #1,d0           | Sign bit into carry        subxw   d2,d2           | Replicate sign bit throughout d2        moveaw  d2,a2           | Sign bit info into a2        roll    #8,d0           | Left justify mantissa, position exp        roll    #3,d0        movel   d0,d2        andiw   #0x7FF,d0       | Mask to exponent field        jeq     GETD11          | J/ zero value|        eorw    d0,d2           | Zero exponent bits in d2        lsrl    #1,d2           | Position mantissa        bset    #31,d2          | Set implicit bit        roll    #8,d3           | Position lo long word of mantissa        roll    #3,d3        eorw    d3,d2           | Clever use of EOR to move bits        andiw   #0xF800,d3      | Trim off bits moved to d3        eorw    d3,d2           | Remove noise in d2|GETD11:        jmp     a1@             | Return to caller, its ret addr in a0/*|||       page||  DOPRSL|  ======|  Double precision floating point result (main entry w/ round).|  Mantissa in D2:D3, exponent in D0, sign in A2, and return address|  in A0.  Place a formatted value on the stack.|*/DOPRSL:        addl    #0x400,d3       | Round the value        jcc     DOPR01          | J/ no carry out        addql   #1,d2        jcc     DOPR01          | J/ no carry out|        roxrl   #1,d2           | Adjust mantissa and exponent        roxrl   #1,d3        addqw   #1,d0|DOPR01:        andw    d0,d0        jle     DUNFRS          | J/ underflow|        cmpiw   #0x7FF,d0       | Check for overflow        jge     DINFRS          | J/ overflow|        andiw   #0xF800,d3      | Trim mantissa        eorw    d2,d3           | EOR to move over 11 bits        andiw   #0xF800,d2      | Remove bits moved        eorw    d2,d3           | Remove noise in d3        subw    d1,d1           | Clear carry        roxll   #1,d2           | Implicit bit into carry        addw    d0,d2           | Exponent into d2        rorl    #8,d2           | Reposition high word        rorl    #3,d2        movew   a2,d0           | Sign bit into carry        aslw    #1,d0        roxrl   #1,d2        rorl    #8,d3        rorl    #3,d3        movel   d3,sp@- | Place value on stack        movel   d2,sp@-|        moveb   #0,FPERR        | No floating point error        jmp     a0@             | Return|||DNANRS:        moveq   #-1,d0          | Set d0 to 0xFFFFFFFF        movel   d0,sp@- | NaN value        movel   d0,sp@-|        moveb   #ERNAN,FPERR        moveb   #-1,NANFLG        jmp     a0@||DINFRS:        movel   a2,d0           | Get sign information        movel   #0xFFE00000,d1        aslw    #1,d0           | Sign bit into carry        roxrl   #1,d1        clrl    sp@-            | Low long word = 00000000        movel   d1,sp@-|        moveb   #EROVF,FPERR        moveb   #-1,INFFLG        jmp     a0@||DUNFRS:        moveb   #ERUNF,FPERR        moveb   #-1,UNFFLG        jra     DZER01||DZERRS:        moveb   #0,FPERR||DZER01:        clrl    sp@-        clrl    sp@-        jmp     a0@||       end