home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / LibLink / Mathe / Mathe.mod < prev    next >
Encoding:
Text File  |  1992-11-02  |  1.8 KB  |  94 lines
  1. MODULE Mathe; (* $StackChk- *)
  2.  
  3.  
  4. PROCEDURE GGT*(x{2},y{3}: LONGINT): LONGINT;  (* $SaveRegs+ *)
  5. BEGIN
  6.   REPEAT
  7.     IF x>y THEN x := x+y; y := x-y; x := x-y;  END;
  8.     y := y MOD x
  9.   UNTIL y=0;
  10.   RETURN x;
  11. END GGT;
  12.  
  13.  
  14. PROCEDURE KGV*(x{2},y{3}: LONGINT): LONGINT; (* $SaveRegs+ *)
  15.  
  16. BEGIN
  17.   RETURN x * y DIV GGT(x,y);
  18. END KGV;
  19.  
  20.  
  21. PROCEDURE Sqrt*(x{2}: LONGINT): LONGINT;  (* $SaveRegs+ *)
  22.  
  23. VAR
  24.   b: LONGINT;
  25.  
  26. BEGIN
  27.   IF    x<8H        THEN b := x DIV     4H +    1H;
  28.   ELSIF x<20H       THEN b := x DIV     8H +    2H;
  29.   ELSIF x<80H       THEN b := x DIV    10H +    4H;
  30.   ELSIF x<200H      THEN b := x DIV    20H +    8H;
  31.   ELSIF x<800H      THEN b := x DIV    40H +   10H;
  32.   ELSIF x<2000H     THEN b := x DIV    80H +   20H;
  33.   ELSIF x<8000H     THEN b := x DIV   100H +   40H;
  34.   ELSIF x<20000H    THEN b := x DIV   200H +   80H;
  35.   ELSIF x<80000H    THEN b := x DIV   400H +  100H;
  36.   ELSIF x<200000H   THEN b := x DIV   800H +  200H;
  37.   ELSIF x<800000H   THEN b := x DIV  1000H +  400H;
  38.   ELSIF x<2000000H  THEN b := x DIV  2000H +  800H;
  39.   ELSIF x<8000000H  THEN b := x DIV  4000H + 1000H;
  40.   ELSIF x<20000000H THEN b := x DIV  8000H + 2000H;
  41.                     ELSE b := x DIV 10000H + 4000H END;
  42.   RETURN (b + x DIV b) DIV 2;
  43. END Sqrt;
  44.  
  45.  
  46. PROCEDURE Fak*(x{2}: LONGINT): LONGINT;  (* $SaveRegs+ *)
  47.  
  48. VAR
  49.   b: LONGINT;
  50.  
  51. BEGIN
  52.   b := 1;
  53.   WHILE x>1 DO
  54.     b := b * x;
  55.     DEC(x);
  56.   END;
  57.   RETURN b;
  58. END Fak;
  59.  
  60.  
  61. PROCEDURE BinKoeff*(n{2},k{3}: LONGINT): LONGINT;  (* $SaveRegs+ *)
  62.  
  63. VAR
  64.   r,s: LONGINT;
  65.  
  66. BEGIN
  67.   r := 1; s := r;
  68.   WHILE k>0 DO
  69.     r := r * n;
  70.     s := s * k;
  71.     DEC(n);
  72.     DEC(k);
  73.   END;
  74.   RETURN r DIV s;
  75. END BinKoeff;
  76.  
  77.  
  78. PROCEDURE Pow*(n{2},k{3}: LONGINT): LONGINT; (* $SaveRegs+ *)
  79.  
  80. VAR
  81.   r: LONGINT;
  82.  
  83. BEGIN
  84.   r := 1;
  85.   WHILE k>0 DO
  86.     r := r * n;
  87.     DEC(k);
  88.   END;
  89.   RETURN r;
  90. END Pow;
  91.  
  92.  
  93. END Mathe.
  94.