home *** CD-ROM | disk | FTP | other *** search
- *------------------------------------------------------------------
- * double.asm: PDC library interface to IEEE double floating point
- * library supplied by Commodore.
- * Loosely based on the Paul Petersen PDC v1.0 library source
- * Maintenance Notes:
- * 13Aug88 - Created by Jal
- * 18Jan89 - .Fd2s and .Fs2d added (LDH)
- *------------------------------------------------------------------
-
- AG_OpenLib equ $00030000
- AO_MathLib equ $00008005
- bias SET -30
-
- libref MACRO
- _LVO\1 EQU bias
- bias SET bias-6
- ENDM
-
- *------------------------------------------------------------------
- * Note: In order to generate the correct biases, these *Must* be in the
- * same order as the mathieeedoubbas_lib.fd file.
- *------------------------------------------------------------------
-
- libref IEEEDPFix
- libref IEEEDPFlt
- libref IEEEDPCmp
- libref IEEEDPTst
- libref IEEEDPAbs
- libref IEEEDPNeg
- libref IEEEDPAdd
- libref IEEEDPSub
- libref IEEEDPMul
- libref IEEEDPDiv
- libref IEEEDPFloor ; needs release 1.2 or beyond
- libref IEEEDPCeil ; needs release 1.2 or beyond
-
- XDEF _MathIeeeDoubBasBase
- XDEF .FDopen
-
- XREF _Alert
- XREF _exit
- XREF _OpenLibrary
-
- *------------------------------------------------------------------
-
- SECTION DoubleData,DATA
-
- _MathIeeeDoubBasBase dc.l 0
- MATHName dc.b 'mathieeedoubbas.library',0
-
- SECTION Double,CODE
-
- *
- * Make sure the MathIeeeDoubBasBase is loaded correctly
- *
-
- .FDopen:
- movem.l D0-D1/A0-A1,-(A7) ; save temporary registers
- pea 0 ; any version will do....
- pea MATHName ; Load the name of library
- jsr _OpenLibrary ; Open the library
- addq #8,A7
- move.l D0,_MathIeeeDoubBasBase ; Save the return code
- bne.s 1$ ; If non-zero then OK
-
- pea 0 ; Parameter for Alert.
- pea AG_OpenLib!AO_MathLib ; Signal an error.
- jsr _Alert
- addq #8,A7
- pea 100 ; push return code
- jsr _exit ; and exit
- 1$:
- movem.l (A7)+,D0-D1/A0-A1 ; restore temporaries
- rts
-
- *-------------------------------------------------------------------
- * Do a one parameter MathIeeeDouble function.
- *-------------------------------------------------------------------
- .FDdo1:
- tst.l _MathIeeeDoubBasBase
- bne.s 1$
- jsr .FDopen
- 1$:
- movem.l A6,-(A7)
- move.l _MathIeeeDoubBasBase,A6
- add.l 4(A7),A6
- jsr (A6)
- movem.l (A7)+,A6
- addq #4,A7 ; unstack the function offset.
- rts
-
- *-------------------------------------------------------------------
- * Do a two parameter MathIeeeDouble function.
- *-------------------------------------------------------------------
- .FDdo2
- tst.l _MathIeeeDoubBasBase
- bne.s 1$
- jsr .FDopen
- 1$:
- movem.l D2-D3/A6,-(A7)
- movem.l (A0),D2-D3
- move.l _MathIeeeDoubBasBase,A6
- add.l 12(A7),A6
- jsr (A6)
- movem.l (A7)+,D2-D3/A6
- addq #4,A7 ; Unstack the function offset.
- rts
-
- *********************************************************************
- *
- * Double multiply arguments are in D0,D1 & (A0)
- *
- XDEF .FDmul
- .FDmul:
- pea _LVOIEEEDPMul
- jmp .FDdo2
-
- *********************************************************************
- *
- * Double divide arguments are in D0,D1 & (A0)
- *
- XDEF .FDdiv
- .FDdiv:
- pea _LVOIEEEDPDiv
- jmp .FDdo2
-
- *********************************************************************
- *
- * Double add arguments are in D0,D1 & (A0)
- *
- XDEF .FDadd
- .FDadd:
- pea _LVOIEEEDPAdd
- jmp .FDdo2
-
- *********************************************************************
- *
- * Double subtract arguments are in D0,D1 & (A0)
- *
- XDEF .FDsub
- .FDsub:
- pea _LVOIEEEDPSub
- jmp .FDdo2
-
- *********************************************************************
- *
- * Double negate argument is in D0,D1
- *
- XDEF .FDneg
- .FDneg:
- pea _LVOIEEEDPNeg
- jmp .FDdo1
-
- *********************************************************************
- *
- * Double compare arguments are in D0,D1 and (A0)
- *
- XDEF .FDcmp
- .FDcmp:
- pea _LVOIEEEDPCmp
- jmp .FDdo2
-
- *********************************************************************
- *
- * Convert long to double : Input in D0
- *
- XDEF .Fl2d
- .Fl2d:
- pea _LVOIEEEDPFlt
- jmp .FDdo1
-
- *********************************************************************
- *
- * Convert double to long : Input in D0,D1
- *
- XDEF .Fd2l
- .Fd2l:
- pea _LVOIEEEDPFix
- jmp .FDdo1
- *********************************************************************
- *
- * Convert double to single : Input in D0:D1 : Output in D0
- *
- XDEF .Fd2s
- .Fd2s
- move.l d2,-(sp)
- DoMant ; Chop mantissa down to size (23 bits)
- rol.l #3,d1 ; Chopping ain't nice, but it's an
- andi.l #7,d1 ; expedient.
- move.l d0,d2
- andi.l #$FFFFF,d2
- lsl.l #3,d2
- or.l d2,d1
- DoExp
- move.l d0,d2 ; Shrink exp from 11 to 8 bits
- swap d2 ; and excess-1023 to excess-127
- lsr.l #4,d2
- andi.l #$07ff,d2
- cmpi.w #1151,d2 ; 1023+128 = 1151 (Max exponent)
- ble.s ExpNotHi
- move.w #255,d2 ; Overflow ... result effectively inf.
- bra ExpOK
- ExpNotHi
- cmpi.w #896,d2 ; 1023-127 = 896 (Min exponent)
- bge.s ExpNotLo
- moveq.l #0,d1 ; Underflow ... result effectively 0
- bra done
- ExpNotLo
- sub.w #896,d2 ; Adjust exponent's bias
- ExpOK
- swap d2 ; Put exponent in its place
- lsl.l #7,d2
- Combine
- or.l d2,d1 ; Merge exponent and mantissa
- done
- andi.l #$80000000,d0 ; Merge with sign
- or.l d1,d0
- move.l (sp)+,d2 ; Shave and a haircut .....
- rts ; two bits!
-
- *********************************************************************
- *
- * Convert single to double : Input in D0 : Output in D0:D1
- *
- XDEF .Fs2d
- .Fs2d:
- movem.l d2-d3,-(sp)
- move.l d0,d1
- ror.l #3,d1
- move.l d1,d2
- and.l #$FFFFF,d2 ; Nab the upper mantissa in d2
- and.l #$E0000000,d1 ; Isolate the lower in d1
- ExpandExp
- move.l d0,d3
- swap d3
- lsr.l #7,d3
- and.l #$FF,d3
- add.l #896,d3 ; Now expand to 11 bits (excess-1023)
- lsl.l #4,d3
- swap d3
- and.l #$80000000,d0 ; Save the sign, toss the rest
- or.l d3,d0 ; Merge the new exponent w/sign
- or.l d2,d0 ; Likewise the mantissa
- movem.l (sp)+,d2-d3
- rts ; return to caller
-
- *********************************************************************
- *
- * Implement the abs function.: Input in D0/D1 : Output in D0:D1
- *
- XDEF _abs
- _abs:
- movem.l 4(A7),D0-D1
- pea _LVOIEEEDPAbs
- jmp .FDdo1
-
- *********************************************************************
- *
- * Implement the floor function.: Input in D0/D1 : Output in D0:D1
- *
- XDEF _floor
- _floor:
- movem.l 4(A7),D0-D1
- pea _LVOIEEEDPFloor
- jmp .FDdo1
-
- *********************************************************************
- *
- * Implement the ceil function.: Input in D0/D1 : Output in D0:D1
- *
- XDEF _ceil
- _ceil:
- movem.l 4(A7),D0-D1
- pea _LVOIEEEDPCeil
- jmp .FDdo1
-
- END
-