tab
        ttl       Floating Point Package
        bin
        dc.w      $fe00

************************************
*                                  *
*     Floating Point Package       *
*                                  *
* Copyright M. R. King 1982, 1984. *
* All rights reserved.             *
*                                  *
************************************

         dc.b     'Floating Point Package. '
         dc.b     'Copyright M.R.King, 1982, 1984. '
         dc.b     'All rights reserved.'
         ds.w     0
float    movem.l  d1,-(sp)
         move.w   #150*128,d1
         tst.l    d0
         beq.s    floatret
         bpl.s    floatpos
         eor.w    #$8000,d1
         neg.l    d0
floatpos cmp.l    #$00800000,d0
         bcc.s    floatsr
floatll  lsl.l    d0
         sub.w    #128,d1
         btst.l   #23,d0
         beq.s    floatll
         bra.s    floatex
floatrl  lsr.l    d0
         add.w    #128,d1
floatsr  cmp.l    #$00FFFFFF,d0
         bcc.s    floatrl
floatex  swap     d0
         and.w    #$007F,d0
         or.w     d1,d0
         swap     d0
floatret movem.l  (sp)+,d1
         rts

rnegate  tst.l    d0
         beq.s    fpnegret
         eor.l    #$80000000,d0
fpnegret rts

intpt    movem.l  d1-d2,-(sp)
*move.l  d0,-(sp)
*move.l  #$00008000,d0
*trap #0
*move.l  (sp)+,d0
         swap     d0
         move.w   d0,d1
         and.w    #$7F,d0
         or.w     #$80,d0
         swap     d0
         move.w   d1,d2
         lsr.w    #7,d1
         and.w    #$FF,d1
         sub.w    #150,d1
         bcc.s    intptsl
         neg.w    d1
         cmp.w    #24,d1
         bcc.s    intptzer
         tst.w    d2
         bpl.s    intptpos
         move.l   #-1,d2
         lsl.l    d1,d2
         not.l    d2
         and.l    d0,d2
         bne.s    intptni
         lsr.l    d1,d0
         neg.l    d0
         bra.s    intptret
intptni  lsr.l    d1,d0
         not.l    d0
         bra.s    intptret
intptsl  cmp.w    #9,d1
         bcc.s    intptofl
         tst.w    d2
         bpl.s    intptlp
         neg.l    d0
intptlp  asl.l    d1,d0
         bvc.s    intptret
intptofl movem.l  (sp)+,d1-d2
         move.l   #-$21,d0
         jmp      signal
intptpos lsr.l    d1,d0
intptret movem.l  (sp)+,d1-d2
         rts
intptzer tst.w    d2
         movem.l  (sp)+,d1-d2
         bpl.s    intptzp
         tst.l    d0
         beq.s    intptzr
         move.l   #-1,d0
         rts
intptzp  move.l   #0,d0
intptzr  rts

trunc    movem.l  d1-d2,-(sp)
         swap     d0
         move.w   d0,d1
         and.w    #$7F,d0
         or.w     #$80,d0
         swap     d0
         move.w   d1,d2
         lsr.w    #7,d1
         and.w    #$FF,d1
         sub.w    #150,d1
         bcc.s    truncsl
         neg.w    d1
         cmp.w    #24,d1
         bcc.s    trunczer
         lsr.l    d1,d0
         tst.w    d2
         bpl.s    truncst
         neg.l    d0
         bra.s    truncret
truncsl  cmp.w    #9,d1
         bcc.s    truncofl
         tst.w    d2
         bpl.s    trunclp
         neg.l    d0
trunclp  asl.l    d1,d0
         bvc.s    truncret
truncofl movem.l  (sp)+,d1-d2
         move.l   #-$21,d0
         jmp      signal
truncst  tst.l    d0
truncret movem.l  (sp)+,d1-d2
         rts
trunczer clr.l    d0
         bra.s    truncret

rdiv     movem.l  d1-d4,-(sp)
         clr.w    d4
         tst.l    d1
         bgt.s    fdiv1pos
         eor.w    #$0100,d4
         and.l    #$7FFFFFFF,d1
         bne.s    fdiv1pos
         movem.l  (sp)+,d1-d4
         move.l   #-$41,d0
         jmp      signal
fdiv1pos tst.l    d0
         bgt.s    fdiv0pos
         and.l    #$7FFFFFFF,d0
         beq.s    fdivret
         eor.w    #$0100,d4
fdiv0pos bsr      fpextrct
         add.w    #151,d2
         sub.w    d3,d2
         bcs.s    fdivzero
         clr.l    d3
fpdivlp  sub.w    #1,d2
         bcs.s    fdivzero
         lsl.l    d3
         cmp.l    d1,d0
         bcs.s    fdvnosub
         sub.l    d1,d0
         add.l    #1,d3
fdvnosub lsl.l    d0
         btst.l   #23,d3
         beq.s    fpdivlp
         cmp.w    #256,d2
         bcs.s    fdivnofl
         movem.l  (sp)+,d1-d4
         move.l   #-$21,d0
         jmp      signal
fdivnofl or.w     d4,d2
         lsl.w    #7,d2
         swap     d3
         and.w    #$007F,d3
         or.w     d2,d3
         swap     d3
         move.l   d3,d0
fdivret  movem.l  (sp)+,d1-d4
         rts
fdivzero clr.l    d0
         bra.s    fdivret

rmult    movem.l  d1-d6,-(sp)
         clr.w    d6
         tst.l    d0
         bgt.s    fmul0pos
         and.l    #$7FFFFFFF,d0
         beq      fmulret
         eor.w    #$0100,d6
fmul0pos tst.l    d1
         bgt.s    fmul1pos
         and.l    #$7FFFFFFF,d1
         beq.s    fmulzero
         eor.w    #$0100,d6
fmul1pos bsr      fpextrct
         add.w    d3,d2
         sub.w    #126,d2
         bcs.s    fmulzero
         move.l   d0,d3
         move.l   d1,d4
         mulu     d0,d1
         swap     d0
         swap     d4
         mulu     d4,d0
         swap     d1
         move.w   d4,d5
         mulu     d3,d5
         add.w    d5,d1
         clr.w    d5
         swap     d5
         addx.l   d5,d0
         swap     d3
         swap     d4
         mulu     d4,d3
         add.w    d3,d1
         clr.w    d3
         swap     d3
         addx.l   d3,d0
         lsl.l    #8,d0
         rol.w    #8,d1
         move.b   d1,d0
         lsl.w    d1
         btst.l   #23,d0
         bne.s    fmnoshft
         roxl.l   d0
         sub.w    #1,d2
         bcs.s    fmulzero
         lsl.w    d1
fmnoshft clr.l    d1
         addx.l   d1,d0
         btst.l   #24,d0
         beq.s    fmnocarr
         lsr.l    d0
         add.w    #1,d2
fmnocarr cmp.w    #256,d2
         bcs.s    fmulnofl
         movem.l  (sp)+,d1-d6
         move.l   #-$21,d0
         jmp      signal
fmulzero clr.l    d0
         bra.s    fmulret
fmulnofl swap     d0
         and.w    #$007F,d0
         or.w     d6,d2
         lsl.w    #7,d2
         or.w     d2,d0
         swap     d0
fmulret  movem.l  (sp)+,d1-d6
         rts

fpextrct swap    d0
         move.w  d0,d2
         and.w   #$007F,d0
         or.w    #$0080,d0
         swap    d0
         lsr.w   #7,d2
         swap    d1
         move.w  d1,d3
         and.w   #$007F,d1
         or.w    #$0080,d1
         swap    d1
         lsr     #7,d3
         rts

rplus    movem.l  d1-d4,-(sp)
         clr.w    d4
         tst.l    d0
         bne.s    fadd0nz
         move.l   d1,d0
         bra      fpasret
fadd0nz  bpl.s    fadd0pos
         and.l    #$7FFFFFFF,d0
         exg      d0,d1
         bra.s    fsub1pos
fadd0pos tst.l    d1
         beq      fpasret
         bpl.s    fadd1pos
         and.l    #$7FFFFFFF,d1
         bra.s    fsub0pos
fadd1pos cmp.l    d1,d0
         bcc.s    fadd0big
         exg      d0,d1
fadd0big bsr      fpextrct
         sub.w    d3,d2
         add.w    d2,d3
         cmp.w    #24,d2
         bcc      fasquick
         lsr.l    d2,d1
         add.l    d1,d0
         btst.l   #24,d0
         beq      fasquick
         add.l    #1,d0
         lsr.l    #1,d0
         add.b    #1,d3
         bcc.s    fasquick
         movem.l  (sp)+,d1-d4
         move.l   #-$21,d0
         jmp      signal
rminus   movem.l  d1-d4,-(sp)
         clr.w    d4
         tst.l    d1
         beq.s    fpasret
         bpl.s    fsub1pos
         and.l    #$7FFFFFFF,d1
         exg      d0,d1
         bra.s    fadd0pos
fsub1pos tst.l    d0
         bne.s    fsub0nz
         move.l   d1,d0
         eor.l    #$80000000,d0
         bra.s    fpasret
fsub0nz  bpl.s    fsub0pos
         and.l    #$7FFFFFFF,d0
         eor.w    #$0100,d4
         bra.s    fadd1pos
fsub0pos cmp.l    d1,d0
         bcc.s    fsub0big
         exg      d0,d1
         eor.w    #$0100,d4
fsub0big bsr      fpextrct
         sub.w    d3,d2
         add.w    d2,d3
         cmp.w    #24,d2
         bcc.s    fasquick
         lsr.l    d2,d1
         sub.l    d1,d0
         beq.s    fpasret
         bhi.s    fsubsrch
         neg.l    d0
         eor.w    #$0100,d4
         bra      fsubsrch
fsbsrchl sub.b    #1,d3
         bcs.s    fsubzero
         lsl.l    d0
fsubsrch btst.l   #23,d0
         beq.s    fsbsrchl
fasquick or.w     d3,d4
         lsl.w    #7,d4
         swap     d0
         and.w    #$007F,d0
         or.w     d4,d0
         swap     d0
fpasret  tst.l    d0
         bpl.s    fpasretp
         and.l    #$7FFFFFFF,d0
         beq.s    fpasretp
         eor.l    #$80000000,d0
fpasretp movem.l  (sp)+,d1-d4
         rts
fsubzero clr.l    d0
         bra.s    fpasretp

fracpt   movem.l  d1-d2,-(sp)
* move.l d0,-(sp)
* move.l #$8000,d0
* trap #0
* move.l (sp)+,d0
         swap     d0
         move.w   d0,d1
         bpl.s    fractpen
         and.w    #$7F,d0
         or.w     #$80,d0
         swap     d0
         lsr.w    #7,d1
         and.w    #$FF,d1
         sub.w    #126,d1
         blo.s    fracptal
         cmp.w    #24,d1
         bcc.s    fracptzr
         lsl.l    d1,d0
         move.w   #126,d1
         neg.l    d0
         and.l    #$00FFFFFF,d0
         bne.s    fracptsc
         bra.s    fracptzr
fracptsl sub.w    #1,d1
         bcs.s    fracptzr
         lsl.l    #1,d0
fracptsc btst.l   #23,d0
         beq.s    fracptsl
         bra.s    fracptex
fracptal neg.w    d1
         lsr.l    d1,d0
         sub.l    #$1000000,d0
         beq.s    fracptzr
         neg.l    d0
         move.w   #126,d1
fracptex lsl.w    #7,d1
         swap     d0
         and.w    #$007F,d0
         or.w     d1,d0
         swap     d0
fracptrt movem.l  (sp)+,d1-d2
         rts
fracptzr clr.l    d0
         bra.s    fracptrt

fraction movem.l  d1-d2,-(sp)
         swap     d0
         move.w   d0,d1
fractpen and.w    #$7F,d0
         swap     d0
         lsr.w    #7,d1
         move.w   d1,d2
         and.w    #$FF,d1
         and.w    #$0100,d2
         sub.w    #126,d1
         bls.s    fractal
         cmp.w    #24,d1
         bcc.s    fractzr
         lsl.l    d1,d0
         move.w   #126,d1
         and.l    #$00FFFFFF,d0
         bne.s    fractsc
         bra.s    fractzr
fractsl  sub.w    #1,d1
         bcs.s    fractzr
         lsl.l    #1,d0
fractsc  btst.l   #23,d0
         beq.s    fractsl
         bra.s    fractex
fractal  add.w    #126,d1
fractex  or.w     d2,d1
         lsl.w    #7,d1
         swap     d0
         and.w    #$007F,d0
         or.w     d1,d0
         swap     d0
fractrt  movem.l  (sp)+,d1-d2
         rts
fractzr  clr.l    d0
         bra.s    fractrt

rpower   movem.l d1-d3,-(sp)
         move.l d1,d3
         beq.s rpzer
         bpl.s rppos
         neg.l d3
         move.l d0,d1
         move.l #$3f800000,d0
         bsr rdiv
rppos    move.l #$3f800000,d2
         move.l d0,d1
rploop   btst #0,d3
         beq.s rpno
         move.l d2,d0
         bsr rmult
         move.l d0,d2
rpno     lsr.l #1,d3
         beq.s rpret
         move.l d1,d0
         bsr rmult
         move.l d0,d1
         bra rploop
rpret    move.l d2,d0
         movem.l (sp)+,d1-d3
         rts
rpzer    move.l #$3f800000,d2
         bra rpret

intpower movem.l d1-d3,-(sp)
         move.l d1,d3
         beq.s intpzer
         bmi.s intpneg
         moveq #1,d2
         move.l d0,d1
intploop btst #0,d3
         beq.s intpno
         move.l d2,d0
         jsr mull
         move.l d0,d2
intpno   lsr.l #1,d3
         beq.s intpret
         move.l d1,d0
         jsr mull
         move.l d0,d1
         bra intploop
intpret  move.l d2,d0
         movem.l (sp)+,d1-d3
         rts
intpzer  moveq #1,d2
         bra intpret
intpneg  clr.l d2
         bra intpret

sqrt     move.w   ccr,-(sp)
         and.l    #$7FFFFFFF,d0
         beq.s    psqrtret
         movem.l  d1-d4,-(sp)
         swap     d0
         move.w   d0,d1
         and.w    #$007F,d0
         or.w     #$0080,d0
         swap     d0
         lsl.l    #7,d0
         sub.w    #$3F80,d1
         asr.w    #1,d1
         add.w    #$3F00,d1
         btst.l   #6,d1
         beq.s    fpsqrtns
         lsl.l    #1,d0
fpsqrtns move.l   #0,d2
         move.l   #0,d3
         move.l   #23,d4
fpsqrtlp lsl.l    #1,d0
         roxl.l   #1,d2
         lsl.l    #1,d0
         roxl.l   #1,d2
         lsl.l    #1,d3
         add.l    #1,d3
         sub.l    d3,d2
         bcs.s    fpsqrtob
         add.l    #1,d3
         dbra     d4,fpsqrtlp
         bra.s    fpsqrtnm
fpsqrtob add.l    d3,d2
         sub.l    #1,d3
         dbra     d4,fpsqrtlp
fpsqrtnm add.w    #$0080,d1
         add.l    #1,d3
         lsr.l    #1,d3
         btst.l   #24,d3
         bne.s    fpsqrtnm
         and.w    #$7F80,d1
         move.w   d1,d0
         swap     d3
         and.w    #$007F,d3
         or.l     d3,d0
         movem.l  (sp)+,d1-d4
psqrtret move.w   (sp)+,ccr
         swap     d0
         rts

printstring equ $10c4
signal      equ $1114
mull        equ $1120
freestore   equ $3ff0
nl          equ 10

define macro
   lea \1,a0
   move.l #\2,d0
   bsr defext
   endm

begin equ *
   define intpower,$1144
   define rplus,$1148
   define rminus,$114c
   define rmult,$1150
   define rdiv,$1154
   define rpower,$1158
   define rnegate,$115c
   define float,$1160
   define fracpt,$1164
   define intpt,$1168
   define sqrt,$116c
   lea begin,a0
   move.l a0,freestore
   lea done,a0
   jsr printstring
   rts

defext exg d0,a0
   add.w 2(a0),a0
   move.l d0,4(a0)
   rts

done dc.b end-*-1,'FLOATING loaded',nl
end equ *
   ds.w 0
   bra.w begin
   end