home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / e / amigae / src / tools / longreal / longreal.e < prev    next >
Text File  |  1992-09-02  |  10KB  |  515 lines

  1. -> longreal module!
  2.  
  3. OPT MODULE
  4. OPT EXPORT
  5.  
  6. OBJECT longreal
  7.   PRIVATE a,b
  8. ENDOBJECT
  9.  
  10. MODULE 'mathieeedoubbas', 'mathieeedoubtrans'
  11.  
  12. EXPORT DEF mathieeedoubbascount, mathieeedoubtranscount
  13.  
  14. RAISE "DLIB" IF OpenLibrary()=NIL
  15.  
  16. PROC dInit(trans=TRUE)
  17.   IF mathieeedoubbascount=0
  18.     mathieeedoubbasbase:=OpenLibrary('mathieeedoubbas.library',0)
  19.   ENDIF
  20.   mathieeedoubbascount++
  21.   IF trans
  22.     IF mathieeedoubtranscount=0
  23.       mathieeedoubtransbase:=OpenLibrary('mathieeedoubtrans.library',0)
  24.     ENDIF
  25.     mathieeedoubtranscount++
  26.   ENDIF
  27. ENDPROC
  28.  
  29. PROC dCleanup(trans=TRUE)
  30.   IF mathieeedoubbasbase
  31.     IF mathieeedoubbascount--=0 THEN CloseLibrary(mathieeedoubbasbase)
  32.   ENDIF
  33.   IF trans
  34.     IF mathieeedoubtransbase
  35.       IF mathieeedoubtranscount--=0 THEN CloseLibrary(mathieeedoubtransbase)
  36.     ENDIF  
  37.   ENDIF
  38. ENDPROC
  39.  
  40. PROC dFloat(int,longreal:PTR TO longreal)
  41.   DEF a,b
  42.   a,b:=IeeeDPFlt(int)
  43.   longreal.a:=a
  44.   longreal.b:=b
  45. ENDPROC longreal
  46.  
  47. PROC dFix(longreal:PTR TO longreal) IS IeeeDPFix(longreal.a,longreal.b)
  48.  
  49. PROC dTst(x:PTR TO longreal) IS IeeeDPTst(x.a,x.b)
  50.  
  51. PROC dCompare(x:PTR TO longreal,y:PTR TO longreal) IS IeeeDPCmp(x.a,x.b,y.a,y.b)
  52.  
  53. PROC dAdd(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  54.   DEF a,b
  55.   a,b:=IeeeDPAdd(x.a,x.b,y.a,y.b)
  56.   IF to
  57.     to.a:=a; to.b:=b
  58.     RETURN to
  59.   ELSE
  60.     x.a:=a; x.b:=b
  61.   ENDIF
  62. ENDPROC x
  63.  
  64. PROC dSub(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  65.   DEF a,b
  66.   a,b:=IeeeDPSub(x.a,x.b,y.a,y.b)
  67.   IF to
  68.     to.a:=a; to.b:=b
  69.     RETURN to
  70.   ELSE
  71.     x.a:=a; x.b:=b
  72.   ENDIF
  73. ENDPROC x
  74.  
  75. PROC dMul(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  76.   DEF a,b
  77.   a,b:=IeeeDPMul(x.a,x.b,y.a,y.b)
  78.   IF to
  79.     to.a:=a; to.b:=b
  80.     RETURN to
  81.   ELSE
  82.     x.a:=a; x.b:=b
  83.   ENDIF
  84. ENDPROC x
  85.  
  86. PROC dDiv(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  87.   DEF a,b
  88.   a,b:=IeeeDPDiv(x.a,x.b,y.a,y.b)
  89.   IF to
  90.     to.a:=a; to.b:=b
  91.     RETURN to
  92.   ELSE
  93.     x.a:=a; x.b:=b
  94.   ENDIF
  95. ENDPROC x
  96.  
  97. PROC dRound(x:PTR TO longreal)
  98.   DEF a,b
  99.   a,b:=IeeeDPFloor(x.a,x.b)
  100.   x.a:=a; x.b:=b
  101. ENDPROC x
  102.  
  103. PROC dRoundUp(x:PTR TO longreal)
  104.   DEF a,b
  105.   a,b:=IeeeDPCeil(x.a,x.b)
  106.   x.a:=a; x.b:=b
  107. ENDPROC x
  108.  
  109. PROC dNeg(x:PTR TO longreal)
  110.   DEF a,b
  111.   a,b:=IeeeDPNeg(x.a,x.b)
  112.   x.a:=a; x.b:=b
  113. ENDPROC x
  114.  
  115. PROC dAbs(x:PTR TO longreal)
  116.   DEF a,b
  117.   a,b:=IeeeDPAbs(x.a,x.b)
  118.   x.a:=a; x.b:=b
  119. ENDPROC x
  120.  
  121. PROC dCopy(x:PTR TO longreal,y:PTR TO longreal)
  122.   x.a:=y.a
  123.   x.b:=y.b
  124. ENDPROC x
  125.  
  126. /*********************************************************************/
  127. /* Converts a longreal x to ascii in buffer s with num digits        */
  128. /* Only for fraction numbers                                         */
  129. /*                                                                   */
  130. /* PARAM IN    s   - buffer for ascii representation [STRING]        */
  131. /*             x   - longreal to be converted                        */
  132. /*             num - number of digits                                */ 
  133. /* RETURN      s   - buffer for ascii representation [STRING]        */
  134. /* COMMENT     Buffer s must be large enough to contain the string   */
  135. /*********************************************************************/
  136.  
  137. PROC dFormat(s,x,num)
  138.   DEF c:longreal, d:longreal,e, f[1]:ARRAY
  139.   DEF pos=0
  140.   StringF(s,'\d.',dFix(x))
  141.   dCopy(c,x)
  142.   FOR e:=1 TO num
  143.     dCopy(d,c)
  144.     dRound(d)
  145.     dSub(c,d)
  146.     dFloat(10,d)
  147.     dMul(c,d)
  148.     f[]:="0"+dFix(c)
  149.     StrAdd(s,f,1)
  150.   ENDFOR
  151. ENDPROC s
  152.  
  153. /*********************************************************************/
  154. /* Converts a longreal x to ascii in buffer s with num digits        */
  155. /* Also for 'large' numbers                                          */
  156. /*                                                                   */
  157. /* PARAM IN    s   - buffer for ascii representation [STRING]        */
  158. /*             x   - longreal to be converted                        */
  159. /*             num - number of digits                                */ 
  160. /* RETURN      s   - buffer for ascii representation [STRING]        */
  161. /* COMMENT     Buffer s must be large enough to contain the string   */
  162. /*********************************************************************/
  163.  
  164. PROC dLFormat(s,x:PTR TO longreal,num)
  165.   DEF power,a:longreal
  166.   DEF one:longreal,ten:longreal
  167.   DEF buffer[30]:STRING
  168.   DEF sign
  169.  
  170.   sign:=1
  171.   dDouble(10.0,ten)
  172.   dDouble(1.0,one)
  173.   dCopy(a,x)
  174.   power:=0
  175.   IF dTst(a)=0
  176.     dFormat(s,a,num)
  177.     RETURN s
  178.   ENDIF
  179.   IF (dTst(a)=-1)
  180.     sign:=-1
  181.     dNeg(a)
  182.   ENDIF
  183.   IF dCompare(a,one)=-1
  184.     WHILE dCompare(a,one)=-1
  185.       dMul(a,ten) 
  186.       power--
  187.     ENDWHILE
  188.   ELSE
  189.     WHILE dCompare(a,ten)=1
  190.       dDiv(a,ten) 
  191.       power++
  192.     ENDWHILE
  193.   ENDIF
  194.   dFormat(buffer,a,num)
  195.   IF (sign=1)
  196.     StringF(s,'\sE\d',buffer,power)
  197.   ELSE
  198.     StringF(s,'-\sE\d',buffer,power)
  199.   ENDIF    
  200. ENDPROC s
  201.  
  202. /*********************************************************************/
  203. /* Converts an ascii representation to a longreal                    */
  204. /*                                                                   */
  205. /* PARAM IN    buffer - buffer with longreal in ascii [STRING]       */
  206. /*             x      - converted longreal                           */
  207. /*********************************************************************/
  208.  
  209. PROC a2d(buffer,x:PTR TO longreal)
  210.  DEF divider:longreal
  211.  DEF fraction:longreal
  212.  DEF ten:longreal
  213.  DEF tmp:longreal
  214.  DEF longexp:longreal
  215.  
  216.  DEF i,exp,expsign,sign
  217.  
  218.  DEF tmpbuffer[256]:STRING
  219.  
  220.  dFloat(0,x)
  221.  dFloat(10,ten)
  222.  i:=0
  223.  sign:=1
  224.  IF buffer[i]="-"
  225.    sign:=-1
  226.    i++
  227.  ELSE
  228.    IF buffer[i]="+" THEN i++
  229.  ENDIF
  230.  
  231.  WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  232.   dFloat(buffer[i]-"0",tmp)
  233.   dMul(x,ten)
  234.   dAdd(x,tmp)
  235.   i++
  236.  ENDWHILE
  237.  
  238.  
  239.  IF (buffer[i]="." AND (buffer[i+1]>="0") AND (buffer[i+1]<="9"))
  240.    i++
  241.    dFloat(1,divider)
  242.    dFloat(0,fraction)
  243.    WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  244.     dMul(fraction,ten)
  245.     dFloat(buffer[i]-"0",tmp)
  246.     dAdd(fraction,tmp)
  247.     dMul(divider,ten)
  248.     i++
  249.    ENDWHILE
  250.    dDiv(fraction,divider)
  251.    dAdd(x,fraction)
  252.   ENDIF
  253.   dFloat(sign,tmp)
  254.   dMul(x,tmp)
  255.  
  256.   IF ((buffer[i]="E") OR (buffer[i]="e"))
  257.     i++
  258.     IF buffer[i]="-"
  259.       expsign:=-1
  260.       i++
  261.     ELSE
  262.       expsign:=1
  263.       IF (buffer[i]="+") THEN i++
  264.     ENDIF  
  265.     exp:=0
  266.     WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  267.       exp:=Mul(exp,10)+buffer[i]-"0"
  268.       i++
  269.     ENDWHILE
  270.     dFloat(exp*expsign,longexp)
  271.     dPow(ten,longexp)
  272.     dMul(x,ten)
  273.   ENDIF
  274. ENDPROC
  275.  
  276.  
  277. /* Converts an IEEE single to a longreal */
  278.  
  279. PROC dDouble(x,to:PTR TO longreal)
  280.   DEF a,b
  281.   a,b:=IeeeDPFieee(x)
  282.   to.a:=a
  283.   to.b:=b
  284. ENDPROC
  285.  
  286.  
  287. /* Converts a longreal to an IEEE single */
  288.  
  289. PROC dSingle(x:PTR TO longreal) IS IeeeDPTieee(x.a,x.b)
  290.   
  291.  
  292. PROC dSqrt(x:PTR TO longreal)
  293.   DEF a,b
  294.   a,b:=IeeeDPSqrt(x.a,x.b)
  295.   x.a:=a; x.b:=b
  296. ENDPROC
  297.  
  298.  
  299. /* Return longreal PI in x */
  300.  
  301. PROC dPi(x:PTR TO longreal)
  302.  x.a:=$400921FB            /* Dirty but quick 8-) */
  303.  x.b:=$54442D18
  304. ENDPROC x
  305.  
  306. /* Converts x from degrees to radians */
  307.  
  308. PROC dRad(x:PTR TO longreal,to=NIL:PTR TO longreal)
  309.   DEF s:longreal,t:longreal
  310.    
  311.   dPi(t)
  312.   dDouble(180.0,s)
  313.  
  314.   dDiv(t,s)
  315.   dMul(t,x)
  316.   IF to
  317.     to.a:=t.a
  318.     to.b:=t.b
  319.     RETURN to
  320.   ELSE
  321.     x.a:=t.a
  322.     x.b:=t.b
  323.     RETURN x
  324.   ENDIF
  325. ENDPROC
  326.  
  327. PROC dSin(x:PTR TO longreal,to=NIL:PTR TO longreal)
  328.   DEF a,b
  329.   a,b:=IeeeDPSin(x.a,x.b)
  330.   IF to
  331.     to.a:=a
  332.     to.b:=b
  333.     RETURN to
  334.   ELSE
  335.     x.a:=a
  336.     x.b:=b
  337.     RETURN x
  338.   ENDIF
  339. ENDPROC
  340.  
  341. PROC dCos(x:PTR TO longreal,to=NIL:PTR TO longreal)
  342.   DEF a,b
  343.   a,b:=IeeeDPCos(x.a,x.b)
  344.   IF to
  345.     to.a:=a
  346.     to.b:=b
  347.     RETURN to
  348.   ELSE
  349.     x.a:=a
  350.     x.b:=b
  351.     RETURN x
  352.   ENDIF
  353. ENDPROC
  354.  
  355. PROC dTan(x:PTR TO longreal,to=NIL:PTR TO longreal)
  356.   DEF a,b
  357.   a,b:=IeeeDPTan(x.a,x.b)
  358.   IF to
  359.     to.a:=a
  360.     to.b:=b
  361.     RETURN to
  362.   ELSE
  363.     x.a:=a
  364.     x.b:=b
  365.     RETURN x
  366.   ENDIF
  367. ENDPROC
  368.  
  369. PROC dASin(x:PTR TO longreal,to=NIL:PTR TO longreal)
  370.   DEF a,b
  371.   a,b:=IeeeDPAsin(x.a,x.b)
  372.   IF to
  373.     to.a:=a
  374.     to.b:=b
  375.     RETURN to
  376.   ELSE
  377.     x.a:=a
  378.     x.b:=b
  379.     RETURN x
  380.   ENDIF
  381. ENDPROC
  382.  
  383.  
  384. PROC dACos(x:PTR TO longreal,to=NIL:PTR TO longreal)
  385.   DEF a,b
  386.   a,b:=IeeeDPAcos(x.a,x.b)
  387.   IF to
  388.     to.a:=a
  389.     to.b:=b
  390.     RETURN to
  391.   ELSE
  392.     x.a:=a
  393.     x.b:=b
  394.     RETURN x
  395.   ENDIF
  396. ENDPROC
  397.  
  398.  
  399. PROC dATan(x:PTR TO longreal,to=NIL:PTR TO longreal)
  400.   DEF a,b
  401.   a,b:=IeeeDPAtan(x.a,x.b)
  402.   IF to
  403.     to.a:=a
  404.     to.b:=b
  405.     RETURN to
  406.   ELSE
  407.     x.a:=a
  408.     x.b:=b
  409.     RETURN x
  410.   ENDIF
  411. ENDPROC
  412.  
  413. PROC dSinh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  414.   DEF a,b
  415.   a,b:=IeeeDPSinh(x.a,x.b)
  416.   IF to
  417.     to.a:=a
  418.     to.b:=b
  419.     RETURN to
  420.   ELSE
  421.     x.a:=a
  422.     x.b:=b
  423.     RETURN x
  424.   ENDIF
  425. ENDPROC
  426.  
  427. PROC dCosh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  428.   DEF a,b
  429.   a,b:=IeeeDPCosh(x.a,x.b)
  430.   IF to
  431.     to.a:=a
  432.     to.b:=b
  433.     RETURN to
  434.   ELSE
  435.     x.a:=a
  436.     x.b:=b
  437.     RETURN x
  438.   ENDIF
  439. ENDPROC
  440.  
  441. PROC dTanh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  442.   DEF a,b
  443.   a,b:=IeeeDPTanh(x.a,x.b)
  444.   IF to
  445.     to.a:=a
  446.     to.b:=b
  447.     RETURN to
  448.   ELSE
  449.     x.a:=a
  450.     x.b:=b
  451.     RETURN x
  452.   ENDIF
  453. ENDPROC
  454.  
  455.  
  456. PROC dExp(x:PTR TO longreal,to=NIL:PTR TO longreal)
  457.   DEF a,b
  458.   a,b:=IeeeDPExp(x.a,x.b)
  459.   IF to
  460.     to.a:=a
  461.     to.b:=b
  462.     RETURN to
  463.   ELSE
  464.     x.a:=a
  465.     x.b:=b
  466.     RETURN x
  467.   ENDIF
  468. ENDPROC
  469.  
  470. PROC dLn(x:PTR TO longreal,to=NIL:PTR TO longreal)
  471.   DEF a,b
  472.   a,b:=IeeeDPLog(x.a,x.b)
  473.   IF to
  474.     to.a:=a
  475.     to.b:=b
  476.     RETURN to
  477.   ELSE
  478.     x.a:=a
  479.     x.b:=b
  480.     RETURN x
  481.   ENDIF
  482. ENDPROC
  483.  
  484. PROC dLog(x:PTR TO longreal,to=NIL:PTR TO longreal)
  485.   DEF a,b
  486.   a,b:=IeeeDPLog10(x.a,x.b)
  487.   IF to
  488.     to.a:=a
  489.     to.b:=b
  490.     RETURN to
  491.   ELSE
  492.     x.a:=a
  493.     x.b:=b
  494.     RETURN x
  495.   ENDIF
  496. ENDPROC
  497.  
  498. /* Calculates x^y */
  499.  
  500. PROC dPow(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  501.   DEF a,b
  502.   a,b:=IeeeDPPow(y.a,y.b,x.a,x.b)
  503.   IF to
  504.     to.a:=a
  505.     to.b:=b
  506.     RETURN to
  507.   ELSE
  508.     x.a:=a
  509.     x.b:=b
  510.     RETURN x
  511.   ENDIF
  512. ENDPROC
  513.  
  514.  
  515.