home *** CD-ROM | disk | FTP | other *** search
/ Freelog 22 / freelog 22.iso / Prog / Djgpp / GPC2952B.ZIP / lib / gcc-lib / djgpp / 2.952 / units / gmp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-02-08  |  40.4 KB  |  632 lines
  1. {
  2. Definitions for GNU multiple precision functions: arithmetic with
  3. integer, rational and real numbers of arbitrary size and precision.
  4.  
  5. Translation of the C header (gmp.h) of the GMP library. Tested with
  6. GMP 2.0.2 and 3.0.1.
  7.  
  8. To use the GMP unit, you will need the GMP library which can be
  9. found in ftp://agnes.dida.physik.uni-essen.de/gnu-pascal/libs/ .
  10.  
  11. Copyright (C) 1998-2001 Free Software Foundation, Inc.
  12.  
  13. Author: Frank Heckenbach <frank@pascal.gnu.de>
  14.  
  15. This file is part of GNU Pascal.
  16.  
  17. GNU Pascal is free software; you can redistribute it and/or modify
  18. it under the terms of the GNU General Public License as published by
  19. the Free Software Foundation; either version 2, or (at your option)
  20. any later version.
  21.  
  22. GNU Pascal is distributed in the hope that it will be useful,
  23. but WITHOUT ANY WARRANTY; without even the implied warranty of
  24. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  25. GNU General Public License for more details.
  26.  
  27. You should have received a copy of the GNU General Public License
  28. along with GNU Pascal; see the file COPYING. If not, write to the
  29. Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  30. 02111-1307, USA.
  31.  
  32. As a special exception, if you link this file with files compiled
  33. with a GNU compiler to produce an executable, this does not cause
  34. the resulting executable to be covered by the GNU General Public
  35. License. This exception does not however invalidate any other
  36. reasons why the executable file might be covered by the GNU General
  37. Public License.
  38.  
  39. Please also note the license of the GMP library.
  40. }
  41.  
  42. {$gnu-pascal,B-,I-}
  43. {$if __GPC_RELEASE__ < 20000412}
  44. {$error This unit requires GPC release 20000412 or newer.}
  45. {$endif}
  46. {$nested-comments}
  47.  
  48. { If this define is set, routines new in GMP 3.x will be made
  49.   available. The define will have no effect on the other interface
  50.   changes between GMP 2.x and 3.x, i.e. the other routines will work
  51.   correctly even if this define is set incorrectly, except on 64 bit
  52.   machines, Crays and other systems where the types are different
  53.   between the GMP versions. Otherwise, the only possible problem if
  54.   setting the define while using GMP 2.x are linking errors if you
  55.   actually use any of the new routines. }
  56. {$ifndef HAVE_GMP2}
  57. {$define HAVE_GMP3}
  58. {$endif}
  59.  
  60. unit gmp;
  61.  
  62. interface
  63.  
  64. uses GPC;
  65.  
  66. {$if defined (__mips) && defined (_ABIN32) && defined (HAVE_GMP3)}
  67. { Force the use of 64-bit limbs for all 64-bit MIPS CPUs if ABI permits. }
  68. {$define _LONG_LONG_LIMB}
  69. {$endif}
  70.  
  71. type
  72.   {$ifdef _SHORT_LIMB}
  73.   mp_limb_t        = Cardinal;
  74.   mp_limb_signed_t = Integer;
  75.   {$elif defined (_LONG_LONG_LIMB)}
  76.   mp_limb_t        = LongCard;
  77.   mp_limb_signed_t = LongInt;
  78.   {$else}
  79.   mp_limb_t        = MedCard;
  80.   mp_limb_signed_t = MedInt;
  81.   {$endif}
  82.  
  83.   mp_ptr           = ^mp_limb_t;
  84.  
  85.   {$if defined (_CRAY) && !defined (_CRAYMPP) && defined (HAVE_GMP3)}
  86.   mp_size_t        = Integer;
  87.   mp_exp_t         = Integer;
  88.   {$else}
  89.   mp_size_t        = MedInt;
  90.   mp_exp_t         = MedInt;
  91.   {$endif}
  92.  
  93.   mpz_t = record
  94.     mp_alloc,
  95.     mp_size  : {$if defined (__MP_SMALL__) && defined (HAVE_GMP3)}
  96.                ShortInt
  97.                {$else}
  98.                Integer
  99.                {$endif};
  100.     mp_d     : mp_ptr
  101.   end;
  102.  
  103.   mpz_array_ptr = ^mpz_array;
  104.   mpz_array = array [0 .. MaxVarSize div SizeOf (mpz_t)] of mpz_t;
  105.  
  106.   mpq_t = record
  107.     mp_num,
  108.     mp_den : mpz_t
  109.   end;
  110.  
  111.   mpf_t = record
  112.     mp_prec,
  113.     mp_size : Integer;
  114.     mp_exp  : mp_exp_t;
  115.     mp_d    : mp_ptr
  116.   end;
  117.  
  118.   TAllocFunction    = function (Size : SizeType) : Pointer;
  119.   TReAllocFunction  = function (var Dest : Pointer; OldSize, NewSize : SizeType) : Pointer;
  120.   TDeAllocProcedure = procedure (Src : Pointer; Size : SizeType);
  121.  
  122. procedure mp_set_memory_functions (AllocFunction : TAllocFunction;
  123.                                    ReAllocFunction : TReAllocFunction;
  124.                                    DeAllocProcedure : TDeAllocProcedure); asmname '__gmp_set_memory_functions';
  125.  
  126. function mp_bits_per_limb : Integer; asmname '_p_mp_bits_per_limb';
  127.  
  128. {**************** Integer (i.e. Z) routines.  ****************}
  129.  
  130. procedure mpz_init             (var Dest : mpz_t);                                                                                 asmname '__gmpz_init';
  131. procedure mpz_clear            (var Dest : mpz_t);                                                                                 asmname '__gmpz_clear';
  132. function  mpz_realloc          (var Dest : mpz_t; NewAlloc : mp_size_t) : Pointer;                                                 asmname '__gmpz_realloc';
  133. procedure mpz_array_init       (Dest : mpz_array_ptr; ArraySize, FixedNumBits : mp_size_t);                                        asmname '__gmpz_array_init';
  134.  
  135. procedure mpz_set              (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_set';
  136. procedure mpz_set_ui           (var Dest : mpz_t; Src : MedCard);                                                                  asmname '__gmpz_set_ui';
  137. procedure mpz_set_si           (var Dest : mpz_t; Src : MedInt);                                                                   asmname '__gmpz_set_si';
  138. procedure mpz_set_d            (var Dest : mpz_t; Src : Double);                                                                   asmname '__gmpz_set_d';
  139. procedure mpz_set_q            (var Dest : mpz_t; Src : mpq_t);                                                                    asmname '__gmpz_set_q';
  140. procedure mpz_set_f            (var Dest : mpz_t; Src : mpf_t);                                                                    asmname '__gmpz_set_f';
  141. function  mpz_set_str          (var Dest : mpz_t; Src : CString; Base : Integer) : Integer;                                        asmname '__gmpz_set_str';
  142.  
  143. procedure mpz_init_set         (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_init_set';
  144. procedure mpz_init_set_ui      (var Dest : mpz_t; Src : MedCard);                                                                  asmname '__gmpz_init_set_ui';
  145. procedure mpz_init_set_si      (var Dest : mpz_t; Src : MedInt);                                                                   asmname '__gmpz_init_set_si';
  146. procedure mpz_init_set_d       (var Dest : mpz_t; Src : Double);                                                                   asmname '__gmpz_init_set_d';
  147. function  mpz_init_set_str     (var Dest : mpz_t; Src : CString; Base : Integer) : Integer;                                        asmname '__gmpz_init_set_str';
  148.  
  149. function  mpz_get_ui           (protected var Src : mpz_t) : MedCard;                                                              asmname '__gmpz_get_ui';
  150. function  mpz_get_si           (protected var Src : mpz_t) : MedInt;                                                               asmname '__gmpz_get_si';
  151. function  mpz_get_d            (protected var Src : mpz_t) : Double;                                                               asmname '__gmpz_get_d';
  152. { Pass nil for Dest to let the function allocate memory for it }
  153. function  mpz_get_str          (Dest : CString; Base : Integer; protected var Src : mpz_t) : CString;                              asmname '__gmpz_get_str';
  154.  
  155. procedure mpz_add              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_add';
  156. procedure mpz_add_ui           (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_add_ui';
  157. procedure mpz_sub              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_sub';
  158. procedure mpz_sub_ui           (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_sub_ui';
  159. procedure mpz_mul              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_mul';
  160. procedure mpz_mul_ui           (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_mul_ui';
  161. procedure mpz_mul_2exp         (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_mul_2exp';
  162. procedure mpz_neg              (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_neg';
  163. procedure mpz_abs              (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_abs';
  164. procedure mpz_fac_ui           (var Dest : mpz_t; Src : MedCard);                                                                  asmname '__gmpz_fac_ui';
  165.  
  166. procedure mpz_tdiv_q           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_tdiv_q';
  167. procedure mpz_tdiv_q_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_tdiv_q_ui';
  168. procedure mpz_tdiv_r           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_tdiv_r';
  169. procedure mpz_tdiv_r_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_tdiv_r_ui';
  170. procedure mpz_tdiv_qr          (var DestQ, DestR : mpz_t; protected var Src1, Src2 : mpz_t);                                       asmname '__gmpz_tdiv_qr';
  171. procedure mpz_tdiv_qr_ui       (var DestQ, DestR : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                             asmname '__gmpz_tdiv_qr_ui';
  172.  
  173. procedure mpz_fdiv_q           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_fdiv_q';
  174. function  mpz_fdiv_q_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                           asmname '__gmpz_fdiv_q_ui';
  175. procedure mpz_fdiv_r           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_fdiv_r';
  176. function  mpz_fdiv_r_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                           asmname '__gmpz_fdiv_r_ui';
  177. procedure mpz_fdiv_qr          (var DestQ, DestR : mpz_t; protected var Src1, Src2 : mpz_t);                                       asmname '__gmpz_fdiv_qr';
  178. function  mpz_fdiv_qr_ui       (var DestQ, DestR : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                   asmname '__gmpz_fdiv_qr_ui';
  179. function  mpz_fdiv_ui          (protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                                             asmname '__gmpz_fdiv_ui';
  180.  
  181. procedure mpz_cdiv_q           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_cdiv_q';
  182. function  mpz_cdiv_q_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                           asmname '__gmpz_cdiv_q_ui';
  183. procedure mpz_cdiv_r           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_cdiv_r';
  184. function  mpz_cdiv_r_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                           asmname '__gmpz_cdiv_r_ui';
  185. procedure mpz_cdiv_qr          (var DestQ, DestR : mpz_t; protected var Src1,Src2 : mpz_t);                                        asmname '__gmpz_cdiv_qr';
  186. function  mpz_cdiv_qr_ui       (var DestQ, DestR : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                   asmname '__gmpz_cdiv_qr_ui';
  187. function  mpz_cdiv_ui          (protected var Src1 : mpz_t; Src2:MedCard) : MedCard;                                               asmname '__gmpz_cdiv_ui';
  188.  
  189. procedure mpz_mod              (var Dest : mpz_t; protected var Src1,Src2 : mpz_t);                                                asmname '__gmpz_mod';
  190. procedure mpz_divexact         (var Dest : mpz_t; protected var Src1,Src2 : mpz_t);                                                asmname '__gmpz_divexact';
  191.  
  192. procedure mpz_tdiv_q_2exp      (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_tdiv_q_2exp';
  193. procedure mpz_tdiv_r_2exp      (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_tdiv_r_2exp';
  194. procedure mpz_fdiv_q_2exp      (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_fdiv_q_2exp';
  195. procedure mpz_fdiv_r_2exp      (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_fdiv_r_2exp';
  196.  
  197. procedure mpz_powm             (var Dest : mpz_t; protected var Base, Exponent, Modulus : mpz_t);                                  asmname '__gmpz_powm';
  198. procedure mpz_powm_ui          (var Dest : mpz_t; protected var Base : mpz_t; Exponent : MedCard; protected var Modulus : mpz_t);  asmname '__gmpz_powm_ui';
  199. procedure mpz_pow_ui           (var Dest : mpz_t; protected var Base : mpz_t; Exponent : MedCard);                                 asmname '__gmpz_pow_ui';
  200. procedure mpz_ui_pow_ui        (var Dest : mpz_t; Base, Exponent : MedCard);                                                       asmname '__gmpz_ui_pow_ui';
  201.  
  202. procedure mpz_sqrt             (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_sqrt';
  203. procedure mpz_sqrtrem          (var Dest, DestR : mpz_t; protected var Src : mpz_t);                                               asmname '__gmpz_sqrtrem';
  204. function  mpz_perfect_square_p (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_perfect_square_p';
  205.  
  206. function  mpz_probab_prime_p   (protected var Src : mpz_t; Repetitions : Integer) : Integer;                                       asmname '__gmpz_probab_prime_p';
  207. procedure mpz_gcd              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_gcd';
  208. function  mpz_gcd_ui           (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                           asmname '__gmpz_gcd_ui';
  209. procedure mpz_gcdext           (var Dest, DestA, DestB : mpz_t; protected var SrcA, SrcB : mpz_t);                                 asmname '__gmpz_gcdext';
  210. function  mpz_invert           (var Dest : mpz_t; protected var Src, Modulus : mpz_t) : Integer;                                   asmname '__gmpz_invert';
  211. function  mpz_jacobi           (protected var Src1, Src2 : mpz_t) : Integer;                                                       asmname '__gmpz_jacobi';
  212. function  mpz_legendre         (protected var Src1, Src2 : mpz_t) : Integer;                                                       asmname '__gmpz_legendre';
  213.  
  214. function  mpz_cmp              (protected var Src1, Src2 : mpz_t) : Integer;                                                       asmname '__gmpz_cmp';
  215. function  mpz_cmp_ui           (protected var Src1 : mpz_t; Src2 : MedCard) : Integer;                                             asmname '__gmpz_cmp_ui';
  216. function  mpz_cmp_si           (protected var Src1 : mpz_t; Src2 : MedInt) : Integer;                                              asmname '__gmpz_cmp_si';
  217. function  mpz_sgn              (protected var Src : mpz_t) : Integer;
  218.  
  219. procedure mpz_and              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_and';
  220. procedure mpz_ior              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_ior';
  221. procedure mpz_com              (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_com';
  222. function  mpz_popcount         (protected var Src : mpz_t) : MedCard;                                                              asmname '__gmpz_popcount';
  223. function  mpz_hamdist          (protected var Src1, Src2 : mpz_t) : MedCard;                                                       asmname '__gmpz_hamdist';
  224. function  mpz_scan0            (protected var Src : mpz_t; StartingBit : MedCard) : MedCard;                                       asmname '__gmpz_scan0';
  225. function  mpz_scan1            (protected var Src : mpz_t; StartingBit : MedCard) : MedCard;                                       asmname '__gmpz_scan1';
  226. procedure mpz_setbit           (var Dest : mpz_t; BitIndex : MedCard);                                                             asmname '__gmpz_setbit';
  227. procedure mpz_clrbit           (var Dest : mpz_t; BitIndex : MedCard);                                                             asmname '__gmpz_clrbit';
  228.  
  229. procedure mpz_random           (var Dest : mpz_t; MaxSize : mp_size_t);                                                            asmname '__gmpz_random';
  230. procedure mpz_random2          (var Dest : mpz_t; MaxSize : mp_size_t);                                                            asmname '__gmpz_random2';
  231. function  mpz_sizeinbase       (protected var Src : mpz_t; Base : Integer) : SizeType;                                             asmname '__gmpz_sizeinbase';
  232.  
  233. {**************** Rational (i.e. Q) routines.  ****************}
  234.  
  235. procedure mpq_canonicalize     (var Dest : mpq_t);                                                                                 asmname '__gmpq_canonicalize';
  236.  
  237. procedure mpq_init             (var Dest : mpq_t);                                                                                 asmname '__gmpq_init';
  238. procedure mpq_clear            (var Dest : mpq_t);                                                                                 asmname '__gmpq_clear';
  239. procedure mpq_set              (var Dest : mpq_t; protected var Src : mpq_t);                                                      asmname '__gmpq_set';
  240. procedure mpq_set_z            (var Dest : mpq_t; protected var Src : mpz_t);                                                      asmname '__gmpq_set_z';
  241. procedure mpq_set_ui           (var Dest : mpq_t; Nom, Den : MedCard);                                                             asmname '__gmpq_set_ui';
  242. procedure mpq_set_si           (var Dest : mpq_t; Nom : MedInt; Den : MedCard);                                                    asmname '__gmpq_set_si';
  243.  
  244. procedure mpq_add              (var Dest : mpq_t; protected var Src1, Src2 : mpq_t);                                               asmname '__gmpq_add';
  245. procedure mpq_sub              (var Dest : mpq_t; protected var Src1, Src2 : mpq_t);                                               asmname '__gmpq_sub';
  246. procedure mpq_mul              (var Dest : mpq_t; protected var Src1, Src2 : mpq_t);                                               asmname '__gmpq_mul';
  247. procedure mpq_div              (var Dest : mpq_t; protected var Src1, Src2 : mpq_t);                                               asmname '__gmpq_div';
  248. procedure mpq_neg              (var Dest : mpq_t; protected var Src : mpq_t);                                                      asmname '__gmpq_neg';
  249. procedure mpq_inv              (var Dest : mpq_t; protected var Src : mpq_t);                                                      asmname '__gmpq_inv';
  250.  
  251. function  mpq_cmp              (protected var Src1, Src2 : mpq_t) : Integer;                                                       asmname '__gmpq_cmp';
  252. function  mpq_cmp_ui           (protected var Src1 : mpq_t; Nom2, Den2 : MedCard) : Integer;                                       asmname '__gmpq_cmp_ui';
  253. function  mpq_sgn              (protected var Src : mpq_t) : Integer;
  254. function  mpq_equal            (protected var Src1, Src2 : mpq_t) : Integer;                                                       asmname '__gmpq_equal';
  255.  
  256. function  mpq_get_d            (protected var Src : mpq_t) : Double;                                                               asmname '__gmpq_get_d';
  257. procedure mpq_set_num          (var Dest : mpq_t; protected var Src : mpz_t);                                                      asmname '__gmpq_set_num';
  258. procedure mpq_set_den          (var Dest : mpq_t; protected var Src : mpz_t);                                                      asmname '__gmpq_set_den';
  259. procedure mpq_get_num          (var Dest : mpz_t; protected var Src : mpq_t);                                                      asmname '__gmpq_get_num';
  260. procedure mpq_get_den          (var Dest : mpz_t; protected var Src : mpq_t);                                                      asmname '__gmpq_get_den';
  261.  
  262. {**************** Float (i.e. R) routines.  ****************}
  263.  
  264. procedure mpf_set_default_prec (Precision : MedCard);                                                                              asmname '__gmpf_set_default_prec';
  265. procedure mpf_init             (var Dest : mpf_t);                                                                                 asmname '__gmpf_init';
  266. procedure mpf_init2            (var Dest : mpf_t; Precision : MedCard);                                                            asmname '__gmpf_init2';
  267. procedure mpf_clear            (var Dest : mpf_t);                                                                                 asmname '__gmpf_clear';
  268. procedure mpf_set_prec         (var Dest : mpf_t; Precision : MedCard);                                                            asmname '__gmpf_set_prec';
  269. function  mpf_get_prec         (protected var Src : mpf_t) : MedCard;                                                              asmname '__gmpf_get_prec';
  270. procedure mpf_set_prec_raw     (var Dest : mpf_t; Precision : MedCard);                                                            asmname '__gmpf_set_prec_raw';
  271.  
  272. procedure mpf_set              (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_set';
  273. procedure mpf_set_ui           (var Dest : mpf_t; Src : MedCard);                                                                  asmname '__gmpf_set_ui';
  274. procedure mpf_set_si           (var Dest : mpf_t; Src : MedInt);                                                                   asmname '__gmpf_set_si';
  275. procedure mpf_set_d            (var Dest : mpf_t; Src : Double);                                                                   asmname '__gmpf_set_d';
  276. procedure mpf_set_z            (var Dest : mpf_t; protected var Src : mpz_t);                                                      asmname '__gmpf_set_z';
  277. procedure mpf_set_q            (var Dest : mpf_t; protected var Src : mpq_t);                                                      asmname '__gmpf_set_q';
  278. function  mpf_set_str          (var Dest : mpf_t; Src : CString; Base : Integer) : Integer;                                        asmname '__gmpf_set_str';
  279.  
  280. procedure mpf_init_set         (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_init_set';
  281. procedure mpf_init_set_ui      (var Dest : mpf_t; Src : MedCard);                                                                  asmname '__gmpf_init_set_ui';
  282. procedure mpf_init_set_si      (var Dest : mpf_t; Src : MedInt);                                                                   asmname '__gmpf_init_set_si';
  283. procedure mpf_init_set_d       (var Dest : mpf_t; Src : Double);                                                                   asmname '__gmpf_init_set_d';
  284. function  mpf_init_set_str     (var Dest : mpf_t; Src : CString; Base : Integer) : Integer;                                        asmname '__gmpf_init_set_str';
  285.  
  286. function  mpf_get_d            (protected var Src : mpf_t) : Double;                                                               asmname '__gmpf_get_d';
  287. { Pass nil for Dest to let the function allocate memory for it }
  288. function  mpf_get_str          (Dest : CString; var Exponent : mp_exp_t; Base : Integer;
  289.                                 NumberOfDigits : SizeType; protected var Src : mpf_t) : CString;                                   asmname '__gmpf_get_str';
  290.  
  291. procedure mpf_add              (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);                                               asmname '__gmpf_add';
  292. procedure mpf_add_ui           (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_add_ui';
  293. procedure mpf_sub              (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);                                               asmname '__gmpf_sub';
  294. procedure mpf_ui_sub           (var Dest : mpf_t; Src1 : MedCard; protected var Src2 : mpf_t);                                     asmname '__gmpf_ui_sub';
  295. procedure mpf_sub_ui           (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_sub_ui';
  296. procedure mpf_mul              (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);                                               asmname '__gmpf_mul';
  297. procedure mpf_mul_ui           (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_mul_ui';
  298. procedure mpf_div              (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);                                               asmname '__gmpf_div';
  299. procedure mpf_ui_div           (var Dest : mpf_t; Src1 : MedCard; protected var Src2 : mpf_t);                                     asmname '__gmpf_ui_div';
  300. procedure mpf_div_ui           (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_div_ui';
  301. procedure mpf_sqrt             (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_sqrt';
  302. procedure mpf_sqrt_ui          (var Dest : mpf_t; Src : MedCard);                                                                  asmname '__gmpf_sqrt_ui';
  303. procedure mpf_neg              (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_neg';
  304. procedure mpf_abs              (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_abs';
  305. procedure mpf_mul_2exp         (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_mul_2exp';
  306. procedure mpf_div_2exp         (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_div_2exp';
  307.  
  308. function  mpf_cmp              (protected var Src1, Src2 : mpf_t) : Integer;                                                       asmname '__gmpf_cmp';
  309. function  mpf_cmp_si           (protected var Src1 : mpf_t; Src2 : MedInt) : Integer;
  310. function  mpf_cmp_ui           (protected var Src1 : mpf_t; Src2 : MedCard) : Integer;
  311. function  mpf_eq               (protected var Src1, Src2 : mpf_t; NumberOfBits : MedCard) : Integer;                                       asmname '__gmpf_eq';
  312. procedure mpf_reldiff          (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);                                               asmname '__gmpf_reldiff';
  313. function  mpf_sgn              (protected var Src : mpf_t)  : Integer;
  314.  
  315. procedure mpf_random2          (var Dest : mpf_t; MaxSize : mp_size_t; MaxExp : mp_exp_t);                                         asmname '__gmpf_random2';
  316.  
  317. {$if 0} (*@@ commented out because they use C file pointers *)
  318. function  mpz_inp_str          (var Dest : mpz_t; Src : CFilePtr; Base : Integer) : SizeType;                                      asmname '__gmpz_inp_str';
  319. function  mpz_inp_raw          (var Dest : mpz_t; Src : CFilePtr) : SizeType ;                                                     asmname '__gmpz_inp_raw';
  320. function  mpz_out_str          (Dest : CFilePtr; Base : Integer; protected var Src : mpz_t) : SizeType;                            asmname '__gmpz_out_str';
  321. function  mpz_out_raw          (Dest : CFilePtr; protected var Src : mpz_t) : SizeType ;                                           asmname '__gmpz_out_raw';
  322. (*@@ mpf_out_str has a bug in GMP 2.0.2: it writes a spurious #0 before the exponent for negative numbers*)
  323. function  mpf_out_str          (Dest : CFilePtr; Base : Integer; NumberOfDigits : SizeType; protected var Src : mpf_t) : SizeType; asmname '__gmpf_out_str';
  324. function  mpf_inp_str          (var Dest : mpf_t; Src : CFilePtr; Base : Integer) : SizeType;                                      asmname '__gmpf_inp_str';
  325. {$endif}
  326.  
  327. { New declarations in GMP 3.x. @@ Mostly untested! }
  328. {$ifdef HAVE_GMP3}
  329.  
  330. { Available random number generation algorithms. }
  331. type
  332.   gmp_randalg_t = (GMPRandAlgLC { Linear congruential. });
  333.  
  334. const
  335.   GMPRandAlgDefault = GMPRandAlgLC;
  336.  
  337. { Linear congruential data struct. }
  338. type
  339.   gmp_randata_lc = record
  340.     a : mpz_t; { Multiplier. }
  341.     c : MedCard; { Adder. }
  342.     m : mpz_t; { Modulus (valid only if m2exp = 0). }
  343.     m2exp : MedCard; { If <> 0, modulus is 2 ^ m2exp. }
  344.   end;
  345.  
  346. type
  347.   gmp_randstate_t = record
  348.     Seed : mpz_t; { Current seed. }
  349.     Alg : gmp_randalg_t;  { Algorithm used. }
  350.     AlgData : record { Algorithm specific data. }
  351.     case gmp_randalg_t of
  352.       GMPRandAlgLC : (lc : ^gmp_randata_lc); { Linear congruential. }
  353.     end
  354.   end;
  355.  
  356. procedure gmp_randinit         (var State : gmp_randstate_t; Alg : gmp_randalg_t; ...);                                            asmname '__gmp_randinit';
  357. procedure gmp_randinit_lc      (var State : gmp_randstate_t; A : mpz_t; C : MedCard; M : mpz_t);                                   asmname '__gmp_randinit_lc';
  358. procedure gmp_randinit_lc_2exp (var State : gmp_randstate_t; A : mpz_t; C : MedCard; M2Exp : MedCard);                             asmname '__gmp_randinit_lc_2exp';
  359. procedure gmp_randseed         (var State : gmp_randstate_t; Seed : mpz_t);                                                        asmname '__gmp_randseed';
  360. procedure gmp_randseed_ui      (var State : gmp_randstate_t; Seed : MedCard);                                                      asmname '__gmp_randseed_ui';
  361. procedure gmp_randclear        (var State : gmp_randstate_t);                                                                      asmname '__gmp_randclear';
  362.  
  363. procedure mpz_addmul_ui        (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_addmul_ui';
  364. procedure mpz_bin_ui           (var Dest : mpz_t; protected var Src1 : mpz_t; Src2 : MedCard);                                     asmname '__gmpz_bin_ui';
  365. procedure mpz_bin_uiui         (var Dest : mpz_t; Src1, Src2 : MedCard);                                                           asmname '__gmpz_bin_uiui';
  366. function  mpz_cmpabs           (protected var Src1, Src2 : mpz_t) : Integer;                                                       asmname '__gmpz_cmpabs';
  367. function  mpz_cmpabs_ui        (protected var Src1 : mpz_t; Src2 : MedCard) : Integer;                                             asmname '__gmpz_cmpabs_ui';
  368. procedure mpz_dump             (protected var Src : mpz_t);                                                                        asmname '__gmpz_dump';
  369. procedure mpz_fib_ui           (var Dest : mpz_t; Src : MedCard);                                                                  asmname '__gmpz_fib_ui';
  370. function  mpz_fits_sint_p      (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_sint_p';
  371. function  mpz_fits_slong_p     (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_slong_p';
  372. function  mpz_fits_sshort_p    (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_sshort_p';
  373. function  mpz_fits_uint_p      (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_uint_p';
  374. function  mpz_fits_ulong_p     (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_ulong_p';
  375. function  mpz_fits_ushort_p    (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_fits_ushort_p';
  376. procedure mpz_lcm              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_lcm';
  377. procedure mpz_nextprime        (var Dest : mpz_t; protected var Src : mpz_t);                                                      asmname '__gmpz_nextprime';
  378. function  mpz_perfect_power_p  (protected var Src : mpz_t) : Integer;                                                              asmname '__gmpz_perfect_power_p';
  379. function  mpz_remove           (var Dest : mpz_t; protected var Src1, Src2 : mpz_t) : MedCard;                                     asmname '__gmpz_remove';
  380. function  mpz_root             (var Dest : mpz_t; protected var Src : mpz_t; N : MedCard) : Integer;                               asmname '__gmpz_root';
  381. procedure mpz_rrandomb         (var ROP : mpz_t; var State : gmp_randstate_t; N : MedCard);                                        asmname '__gmpz_rrandomb';
  382. procedure mpz_swap             (var v1, v2 : mpz_t);                                                                               asmname '__gmpz_swap';
  383. function  mpz_tdiv_ui          (protected var Src1 : mpz_t; Src2 : MedCard) : MedCard;                                             asmname '__gmpz_tdiv_ui';
  384. function  mpz_tstbit           (protected var Src1 : mpz_t; Src2 : MedCard) : Integer;                                             asmname '__gmpz_tstbit';
  385. procedure mpz_urandomb         (ROP : mpz_t; var State : gmp_randstate_t; N : MedCard);                                            asmname '__gmpz_urandomb';
  386. procedure mpz_urandomm         (ROP : mpz_t; var State : gmp_randstate_t; N : mpz_t);                                              asmname '__gmpz_urandomm';
  387. procedure mpz_xor              (var Dest : mpz_t; protected var Src1, Src2 : mpz_t);                                               asmname '__gmpz_xor';
  388.  
  389. procedure mpq_set_d            (var Dest : mpq_t; Src : Double);                                                                   asmname '__gmpq_set_d';
  390.  
  391. procedure mpf_ceil             (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_ceil';
  392. procedure mpf_floor            (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_floor';
  393. procedure mpf_pow_ui           (var Dest : mpf_t; protected var Src1 : mpf_t; Src2 : MedCard);                                     asmname '__gmpf_pow_ui';
  394. procedure mpf_trunc            (var Dest : mpf_t; protected var Src : mpf_t);                                                      asmname '__gmpf_trunc';
  395. procedure mpf_urandomb         (ROP : mpf_t; var State : gmp_randstate_t; N : MedCard);                                            asmname '__gmpf_urandomb';
  396.  
  397. const
  398.   GMPErrorNone = 0;
  399.   GMPErrorUnsupportedArgument = 1;
  400.   GMPErrorDivisionByZero = 2;
  401.   GMPErrorSqrtOfNegative = 4;
  402.   GMPErrorInvalidArgument = 8;
  403.   GMPErrorAllocate = 16;
  404.  
  405. var
  406.   gmp_errno : Integer; asmname '__gmp_errno'; external;
  407.  
  408. {$endif}
  409.  
  410. { Extensions to the GMP library, implemented in this unit }
  411.  
  412. procedure mpf_exp    (var Dest : mpf_t; protected var Src : mpf_t);
  413. procedure mpf_ln     (var Dest : mpf_t; protected var Src : mpf_t);
  414. procedure mpf_pow    (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);
  415. procedure mpf_arctan (var c : mpf_t; protected var x : mpf_t);
  416. procedure mpf_pi     (var c : mpf_t);
  417.  
  418. implementation
  419.  
  420. {$L gmpc.c, gmp}
  421.  
  422. (*@@ Should rather be inline and in the interface*)
  423.  
  424. function mpz_sgn (protected var Src : mpz_t) : Integer;
  425. begin
  426.   if Src.mp_size < 0 then
  427.     mpz_sgn := -1
  428.   else if Src.mp_size > 0 then
  429.     mpz_sgn := 1
  430.   else
  431.     mpz_sgn := 0
  432. end;
  433.  
  434. function mpq_sgn (protected var Src : mpq_t) : Integer;
  435. begin
  436.   if Src.mp_num.mp_size < 0 then
  437.     mpq_sgn := -1
  438.   else if Src.mp_num.mp_size > 0 then
  439.     mpq_sgn := 1
  440.   else
  441.     mpq_sgn := 0
  442. end;
  443.  
  444. function mpf_sgn (protected var Src : mpf_t)  : Integer;
  445. begin
  446.   if Src.mp_size < 0 then
  447.     mpf_sgn := -1
  448.   else if Src.mp_size > 0 then
  449.     mpf_sgn := 1
  450.   else
  451.     mpf_sgn := 0
  452. end;
  453.  
  454. (*@@ GMP 2.0.2 has a bug in mpf_cmp_si and mpf_cmp_ui, so work around :-( *)
  455.  
  456. function mpf_cmp_si (protected var Src1 : mpf_t; Src2 : MedInt) : Integer;
  457. var Temp : mpf_t;
  458. begin
  459.   mpf_init_set_si (Temp, Src2);
  460.   mpf_cmp_si := mpf_cmp (Src1, Temp);
  461.   mpf_clear (Temp)
  462. end;
  463.  
  464. function mpf_cmp_ui (protected var Src1 : mpf_t; Src2 : MedCard) : Integer;
  465. var Temp : mpf_t;
  466. begin
  467.   mpf_init_set_ui (Temp, Src2);
  468.   mpf_cmp_ui := mpf_cmp (Src1, Temp);
  469.   mpf_clear (Temp)
  470. end;
  471.  
  472. inline function GetExp (protected var x : mpf_t) = Exp : mp_exp_t;
  473. (*@@ This is a kludge, but how to get the exponent (of base 2) in a better way? *)
  474. begin
  475.   Dispose (mpf_get_str (nil, Exp, 2, 0, x))
  476. end;
  477.  
  478. procedure mpf_exp (var Dest : mpf_t; protected var Src : mpf_t);
  479. { $$ \exp x = \sum_{n = 0}^{\infty} \frac{x^n}{n!} $$
  480.   The series is used for $x \in [0, 1]$, other values of $x$ are scaled. }
  481. var
  482.   y, s, c0 : mpf_t;
  483.   Precision, n : MedCard;
  484.   Exp, i : mp_exp_t;
  485.   Negative : Boolean;
  486. begin
  487.   Precision := mpf_get_prec (Dest);
  488.   mpf_init2 (y, Precision);
  489.   mpf_set (y, Src);
  490.   mpf_set_ui (Dest, 1);
  491.   Negative := mpf_sgn (y) < 0;
  492.   if Negative then mpf_neg (y, y);
  493.   Exp := GetExp (y);
  494.   if Exp > 0 then mpf_div_2exp (y, y, Exp);
  495.   mpf_init2 (c0, Precision);
  496.   mpf_init2 (s, Precision);
  497.   mpf_set_ui (s, 1);
  498.   n := 1;
  499.   repeat
  500.     mpf_mul (s, s, y);
  501.     mpf_div_ui (s, s, n);
  502.     mpf_set (c0, Dest);
  503.     mpf_add (Dest, Dest, s);
  504.     Inc (n)
  505.   until mpf_eq (c0, Dest, Precision) <> 0;
  506.   for i := 1 to Exp do mpf_mul (Dest, Dest, Dest);
  507.   if Negative then mpf_ui_div (Dest, 1, Dest);
  508.   mpf_clear (s);
  509.   mpf_clear (c0);
  510.   mpf_clear (y)
  511. end;
  512.  
  513. procedure mpf_ln (var Dest : mpf_t; protected var Src : mpf_t);
  514. { $$ \ln x = \sum_{n = 1}^{\infty} - \frac{(1-x)^n}{n}, \quad x \in ]0, 2] \Rightarrow $$
  515.   $$ \ln 2^i y = -i \ln \frac{1}{2} + \sum_{n = 1}^{\infty} - \frac{(1-y)^n}{n},
  516.      \quad y \in \left[ \frac{1}{2}, 1 \right], i \in \mathbf{Z} $$ }
  517. var
  518.   y, s, p, c0, Half : mpf_t;
  519.   LnHalf : static mpf_t;
  520.   LnHalfInited : static Boolean = False;
  521.   n, Precision : MedCard;
  522.   Exp : mp_exp_t;
  523.   Dummy : Double;
  524. begin
  525.   if mpf_sgn (Src) <= 0 then
  526.     begin
  527.       Dummy := Ln (0); { Generate an error }
  528.       Exit
  529.     end;
  530.   Precision := mpf_get_prec (Dest);
  531.   mpf_init2 (y, Precision);
  532.   mpf_set (y, Src);
  533.   mpf_set_ui (Dest, 0);
  534.   Exp := GetExp (y);
  535.   if Exp <> 0 then
  536.     begin
  537.       if not LnHalfInited or (mpf_get_prec (LnHalf) < Precision) then
  538.         begin
  539.           if LnHalfInited then mpf_clear (LnHalf);
  540.           mpf_init2 (LnHalf, Precision);
  541.           mpf_init2 (Half, Precision);
  542.           mpf_set_d (Half, 0.5);
  543.           mpf_ln (LnHalf, Half);
  544.           mpf_clear (Half)
  545.         end;
  546.       mpf_set (Dest, LnHalf);
  547.       mpf_mul_ui (Dest, Dest, abs (Exp));
  548.       if Exp > 0
  549.         then
  550.           begin
  551.             mpf_neg (Dest, Dest);
  552.             mpf_div_2exp (y, y, Exp)
  553.           end
  554.         else mpf_mul_2exp (y, y, - Exp)
  555.     end;
  556.   mpf_ui_sub (y, 1, y);
  557.   mpf_init2 (c0, Precision);
  558.   mpf_init2 (s, Precision);
  559.   mpf_init2 (p, Precision);
  560.   mpf_set_si (p, -1);
  561.   n := 1;
  562.   repeat
  563.     mpf_mul (p, p, y);
  564.     mpf_div_ui (s, p, n);
  565.     mpf_set (c0, Dest);
  566.     mpf_add (Dest, Dest, s);
  567.     Inc (n)
  568.   until mpf_eq (c0, Dest, Precision) <> 0;
  569.   mpf_clear (p);
  570.   mpf_clear (s);
  571.   mpf_clear (c0);
  572.   mpf_clear (y)
  573. end;
  574.  
  575. procedure mpf_pow (var Dest : mpf_t; protected var Src1, Src2 : mpf_t);
  576. var Temp : mpf_t;
  577. begin
  578.   mpf_init2 (Temp, mpf_get_prec (Src1));
  579.   mpf_ln (Temp, Src1);
  580.   mpf_mul (Temp, Temp, Src2);
  581.   mpf_exp (Dest, Temp);
  582.   mpf_clear (Temp)
  583. end;
  584.  
  585. procedure mpf_arctan (var c : mpf_t; protected var x : mpf_t);
  586. { $$\arctan x = \sum_{n=0}^{\infty} (-1)^n \frac{x^{2n+1}}{2n+1}$$ }
  587. var
  588.   p, mx2, c0, s : mpf_t;
  589.   Precision, n : MedCard;
  590. begin
  591.   Precision := mpf_get_prec (c);
  592.   mpf_init2 (p, Precision);
  593.   mpf_set (p, x);
  594.   mpf_init2 (mx2, Precision);
  595.   mpf_mul (mx2, x, x);
  596.   mpf_neg (mx2, mx2);
  597.   mpf_init2 (c0, Precision);
  598.   mpf_init2 (s, Precision);
  599.   mpf_set (c, x);
  600.   n := 1;
  601.   repeat
  602.     mpf_mul (p, p, mx2);
  603.     mpf_div_ui (s, p, 2 * n + 1);
  604.     mpf_set (c0, c);
  605.     mpf_add (c, c, s);
  606.     Inc (n)
  607.   until mpf_eq (c0, c, Precision) <> 0;
  608.   mpf_clear (s);
  609.   mpf_clear (c0);
  610.   mpf_clear (mx2);
  611.   mpf_clear (p)
  612. end;
  613.  
  614. procedure mpf_pi (var c : mpf_t);
  615. { 4 arctan 1/5 - arctan 1/239 = pi/4 }
  616. var b : mpf_t;
  617. begin
  618.   mpf_set_ui (c, 1);
  619.   mpf_div_ui (c, c, 5);
  620.   mpf_arctan (c, c);
  621.   mpf_mul_ui (c, c, 4);
  622.   mpf_init2 (b, mpf_get_prec (c));
  623.   mpf_set_ui (b, 1);
  624.   mpf_div_ui (b, b, 239);
  625.   mpf_arctan (b, b);
  626.   mpf_sub (c, c, b);
  627.   mpf_mul_ui (c, c, 4);
  628.   mpf_clear (b)
  629. end;
  630.  
  631. end.
  632.