; Routine zur Berechnung von pi nach der Formel
   ; * pi = 48*arctan(1/18) + 32*arctan(1/57) - 20*arctan(1/239) *
   ; * a*arctan(1/b) = a/b - a/(b**3 * 3) + a/(b**5 * 5) -+ ...  * 
   ; Achtung! bei Unterprogrammspruengen erfolgt (i.d.R.) keine
   ; Registersicherung; deshalb gilt folgende Registerverwendung:
   ; a0 Endekontrolle
   ; a1 adressiert temp
   ; a2 adressiert sum
   ; a3 adresiert pi
   ; a4 aktueller Stand in temp
   ; a5 aktueller Stand in sum
   ; a6 Hilfsregister
   ; d0 Schleifenzaehler
   ; d1 Vorzeichen
   ; d2 Faktor/frei
   ; d3 Argument
   ; d4 Summationsindex (n)
   ; d5,d6 frei
   ; d7 Endekontrolle 
   ; Parameter:  in:  (a5) +8,12,16,20
   ;            out:  (a5)+8 enthaelt pi als Binaer-Bruch der laenge (a5)+20
   public   _compi
_compi:     
   movem.l  d0-a6,-(a7)
   ; Parameteruebergabe: A(pi), A(temp), A(sum), llen
   lea      pi(pc),a0
   move.l   8(a5),(a0)     A(pi)
   move.l   12(a5),4(a0)   A(temp)
   move.l   16(a5),8(a0)   A(sum)
   move.l   20(a5),12(a0)  llen
   move.l   20(a5),d0
   moveq    #2,d1
   mulu     d1,d0
   move.l   d0,16(a0)      wlen
   mulu     d1,d0
   move.l   d0,20(a0)      flen
   moveq    #0,d1	;Vorzeichen
   moveq    #48,d2	;Faktor
   moveq    #18,d3	;Argument
   bsr      arctan
   move.l   temp(pc),a1
   move.l   sum(pc),a2
   move.l   llen(pc),d0
   subq.l   #1,d0
clear1:
   clr.l    (a1)+
   clr.l    (a2)+
   dbra     d0,clear1
   moveq    #0,d1	;Vorzeichen
   moveq    #32,d2	;Faktor
   moveq    #57,d3	;Argument
   bsr      arctan
   move.l   temp(pc),a1
   move.l   sum(pc),a2
   move.l   llen(pc),d0
   subq.l   #1,d0
clear2:
   clr.l    (a1)+
   clr.l    (a2)+
   dbra     d0,clear2
   moveq    #1,d1	;Vorzeichen
   moveq    #20,d2	;Faktor
   moveq    #0,d3
   addi.l   #239,d3	;Argument
   bsr      arctan
   movem.l  (a7)+,d0-a6
   rts      
arctan:                 ;Input d1,d2,d3
   move.l   wlen(pc),d7 ;Abbruchkriterium init
   move.l   temp(pc),a4 ;aktueller Stand temp
   move.l   sum(pc),a5  ;aktueller Stand sum
   move.l   temp(pc),a1 
   move.l   d2,(a1)	;temp=d2
   bsr      divtemp     ;temp=d2/d3
   moveq    #1,d4	;n=1
   bsr      divsum      ;sum = temp/n 
   tst.w    d1		;Vorzeichen? 0 = +, 1 = -
   beq      arcadd
   bsr      sub		;pi = pi - sum 
   moveq    #0,d1	;alternierend 
   bra      arcloop
arcadd:
   bsr      add		;pi = pi + sum
   moveq    #1,d1	;alternierend
arcloop:
   moveq    #1,d4	;n=1
   muls     d3,d3	;d=d3**2
tanloop: 
   bsr      divtemp	;temp=temp/d3
   addq.l   #2,d4	;n=n+2
   bsr      divsum	;sum = temp/n
   bsr      test
   tst.l    d7          ;wenn 0
   beq      arcend	;fertig
   tst.w    d1
   beq      plus 
   bsr      sub		;pi = pi - sum
   moveq    #0,d1
   bra      tanloop
plus:
   bsr      add		;pi = pi + sum
   moveq    #1,d1
   bra      tanloop
arcend:
   rts
test:
   subq.l   #1,d7
   blt      testend
   addq.l   #2,a5 	;aktueller Stand sum
   tst.w    (a4)+	;aktueller Stand temp
   beq      test
   subq.l   #2,a4
   subq.l   #2,a5
testend:
   addq.l   #1,d7
   rts   
divtemp:		;temp = temp/d3
   move.l   a4,a1
   move.l   d7,d0
   subq.l   #1,d0
   moveq    #0,d6
temploop:
   move.w   (a1),d6
   divu     d3,d6
   move.w   d6,(a1)+
   dbra     d0,temploop
   rts
divsum:			;sum = temp/d4
   move.l  a4,a1
   move.l  a5,a2 
   move.l  d7,d0
   subq.l  #1,d0	;Schleifenzaehler
   moveq   #0,d6
sumloop:
   move.w   (a1)+,d6
   divu     d4,d6
   move.w   d6,(a2)+
   dbra     d0,sumloop
   rts
add:
   move.l   sum(pc),a2
   move.l   pi(pc),a3
   lea      flen(pc),a6
   adda.l   (a6),a2	;Add. von rechts
   adda.l   (a6),a3	;nach links 
   move.l   llen(pc),d0 ;Langworte 
   subq.l   #1,d0	;Schleifenzaehler  
addloop:
   addx.l   -(a2),-(a3)
   dbra     d0,addloop
   rts
sub:
   move.l   sum(pc),a2
   move.l   pi(pc),a3
   lea      flen(pc),a6
   adda.l   (a6),a2	;Sub. von rechts
   adda.l   (a6),a3	;nach links
   move.l   llen(pc),d0 ;Langworte 
   subq.l   #1,d0	;Schleifenzaehler
subloop:
   subx.l   -(a2),-(a3)
   dbra     d0,subloop
   rts
pi:         dc.l    0
temp:       dc.l    0
sum:        dc.l    0
llen:       dc.l    0
wlen:       dc.l    0
flen:       dc.l    0
   END