MathgeomGLS

1
{**********************************************************************}
2
{                                                                      }
3
{    "The contents of this file are subject to the Mozilla Public      }
4
{    License Version 1.1 (the "License"); you may not use this         }
5
{    file except in compliance with the License. You may obtain        }
6
{    a copy of the License at http://www.mozilla.org/MPL/              }
7
{                                                                      }
8
{    Software distributed under the License is distributed on an       }
9
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
10
{    or implied. See the License for the specific language             }
11
{    governing rights and limitations under the License.               }
12
{                                                                      }
13
{    Copyright Creative IT.                                            }
14
{    Current maintainer: Eric Grange                                   }
15
{                                                                      }
16
{**********************************************************************}
17
{
18
    This unit exposes MPIR dll (http://www.mpir.org)
19

20
    Targets MPIR 2.7.2 or above.
21

22
    Based on gmp_lib by wqyfavor
23
}
24
unit dwsMPIR;
25

26
{$WARN SYMBOL_PLATFORM OFF}
27

28
interface
29

30
uses Winapi.Windows, System.SysUtils, dwsXPlatform;
31

32
const
33
   MaxVarSize = MaxInt div 4;
34

35
type
36
   mp_limb_t = Cardinal;
37
   mp_limb_signed_t = Integer;
38
   mp_bitcnt_t = Cardinal;
39

40
   mp_ptr = ^mp_limb_t;
41

42
   mp_size_t_p = ^mp_size_t;
43
   mp_size_t = Integer;
44
   mp_exp_t = Integer;
45

46
   // Prototype of arbitrary precision integer number
47
   pmpz_t = ^mpz_t;
48
   mpz_t = record
49
      mp_alloc: Integer;
50
      mp_size: Integer;
51
      mp_d: mp_ptr;
52
   end;
53

54
   mpz_array_ptr = ^mpz_array;
55
   mpz_array = array[0..MaxVarSize div SizeOf(mpz_t) - 1] of mpz_t;
56

57
   // Prototype of arbitrary precision rational number
58
   pmpq_t = ^mpq_t;
59
   mpq_t = record
60
      mp_num: mpz_t;
61
      mp_den: mpz_t;
62
   end;
63

64
   // Prototype of arbitrary precision float number
65
   pmpf_t = ^mpf_t;
66
   mpf_t = record
67
      mp_prec: Integer;
68
      mp_size: Integer;
69
      mp_exp: mp_exp_t;
70
      mp_d: mp_ptr;
71
   end;
72

73
   // Available random number generation algorithms.
74
   gmp_randalg_t = (GMPRandAlgLC {Linear congruential}, GMPRandAlgMT{Mersenne Twister});
75

76
   // Linear congruential data struct.
77
   gmp_randata_lc = record
78
      a: mpz_t; { Multiplier. }
79
      c: Cardinal; { Adder. }
80
      m: mpz_t; { Modulus (valid only if M2Exp = 0). }
81
      M2Exp: Cardinal; { If <> 0, modulus is 2 ^ M2Exp. }
82
   end;
83

84
   gmp_randstate_t = record
85
      Seed: mpz_t; { Current seed. }
86
      Alg: gmp_randalg_t; { Algorithm used. }
87
      AlgData: record { Algorithm specific data. }
88
         case gmp_randalg_t of
89
            GMPRandAlgLC: (lc: ^gmp_randata_lc) { Linear congruential. }
90
      end
91
   end;
92

93
var
94
   { Integer (i.e. Z) routines }
95
   mpz_init : procedure (var dest: mpz_t); cdecl;
96
   mpz_inits : procedure (p: pmpz_t {; ...}); cdecl varargs;
97
   mpz_init2 : procedure (var dest: mpz_t; N: mp_bitcnt_t); cdecl varargs;
98
   mpz_clear : procedure (var dest: mpz_t); cdecl;
99
   mpz_clears : procedure (p: pmpz_t {; ...}); cdecl varargs;
100
   mpz_realloc : function (var dest: mpz_t; Limbs: mp_size_t): Pointer; cdecl;
101
   mpz_realloc2 : procedure (var dest: mpz_t; Bits: mp_size_t); cdecl;
102
   mpz_array_init : procedure (dest: mpz_array_ptr; ArraySize, FixedNumBits: mp_size_t); cdecl;
103

104
   mpz_swap : procedure (var v1, v2: mpz_t); cdecl;
105
   mpz_set : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
106
   mpz_set_ui : procedure (var dest: mpz_t; src: Cardinal); cdecl;
107
   mpz_set_si : procedure (var dest: mpz_t; src: Integer); cdecl;
108
   mpz_set_d : procedure (var dest: mpz_t; src: Double); cdecl;
109
   mpz_set_q : procedure (var dest: mpz_t; src: mpq_t); cdecl;
110
   mpz_set_f : procedure (var dest: mpz_t; src: mpf_t); cdecl;
111
   mpz_set_str : function (var dest: mpz_t; src: PAnsiChar; Base: Integer): Integer; cdecl;
112

113
   mpz_init_set : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
114
   mpz_init_set_ui : procedure (var dest: mpz_t; src: Cardinal); cdecl;
115
   mpz_init_set_si : procedure (var dest: mpz_t; src: Integer); cdecl;
116
   mpz_init_set_d : procedure (var dest: mpz_t; src: Double); cdecl;
117
   mpz_init_set_str : function (var dest: mpz_t; src: PAnsiChar; Base: Integer): Integer; cdecl;
118

119
   mpz_import : procedure (var dest: mpz_t; Count: mp_size_t; Order: Integer; Size: mp_size_t; Endian: Integer; Nails: mp_size_t; op: Pointer); cdecl;
120
   mpz_export : function (Rop: Pointer; PCount: mp_size_t_p; Order: Integer; Size: mp_size_t; Endian: Integer; Nails: mp_size_t; const src: mpz_t): Pointer; cdecl;
121

122
   mpz_getlimbn : function (const src: mpz_t; n: mp_size_t): mp_limb_t; cdecl;
123
   mpz_size : function (const src: mpz_t): mp_size_t; cdecl;
124

125
   mpz_get_ui : function (const src: mpz_t): Cardinal; cdecl;
126
   mpz_get_si : function (const src: mpz_t): Integer; cdecl;
127
   mpz_get_d : function (const src: mpz_t): Double; cdecl;
128
   mpz_get_d_2exp : function (var Exp: Integer; src: mpz_t): Double; cdecl;
129
   mpz_fits_sint_p : function (const src: mpz_t): Integer; cdecl;
130
   mpz_fits_slong_p : function (const src: mpz_t): Integer; cdecl;
131
   mpz_fits_sshort_p : function (const src: mpz_t): Integer; cdecl;
132
   mpz_fits_uint_p : function (const src: mpz_t): Integer; cdecl;
133
   mpz_fits_ulong_p : function (const src: mpz_t): Integer; cdecl;
134
   mpz_fits_ushort_p : function (const src: mpz_t): Integer; cdecl;
135
   { Pass nil for dest to let the function allocate memory for it }
136
   mpz_get_str : function (dest: PAnsiChar; Base: Integer; const src: mpz_t): PAnsiChar; cdecl;
137

138
   mpz_add : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
139
   mpz_add_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
140
   mpz_sub : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
141
   mpz_sub_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
142
   mpz_ui_sub : procedure (var dest: mpz_t; src1: Cardinal; const src2: mpz_t); cdecl;
143
   mpz_mul : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
144
   mpz_mul_si : procedure (var dest: mpz_t; const src1: mpz_t; src2: Integer); cdecl;
145
   mpz_mul_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
146
   mpz_mul_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
147
   mpz_addmul : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
148
   mpz_addmul_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
149
   mpz_submul : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
150
   mpz_submul_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
151
   mpz_neg : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
152
   mpz_abs : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
153

154
   mpz_cdiv_q : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
155
   mpz_cdiv_r : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
156
   mpz_cdiv_qr : procedure (var destQ, destR: mpz_t; const src1, src2: mpz_t); cdecl;
157
   mpz_cdiv_q_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
158
   mpz_cdiv_r_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
159
   mpz_cdiv_qr_ui : function (var destQ, destR: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
160
   mpz_cdiv_ui : function (const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
161
   mpz_cdiv_q_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
162
   mpz_cdiv_r_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
163

164
   mpz_fdiv_q : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
165
   mpz_fdiv_r : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
166
   mpz_fdiv_qr : procedure (var destQ, destR: mpz_t; const src1, src2: mpz_t); cdecl;
167
   mpz_fdiv_q_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
168
   mpz_fdiv_r_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
169
   mpz_fdiv_qr_ui : function (var destQ, destR: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
170
   mpz_fdiv_ui : function (const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
171
   mpz_fdiv_q_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
172
   mpz_fdiv_r_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
173

174
   mpz_tdiv_q : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
175
   mpz_tdiv_r : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
176
   mpz_tdiv_qr : procedure (var destQ, destR: mpz_t; const src1, src2: mpz_t); cdecl;
177
   mpz_tdiv_q_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
178
   mpz_tdiv_r_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
179
   mpz_tdiv_qr_ui : procedure (var destQ, destR: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
180
   mpz_tdiv_ui : function (const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
181
   mpz_tdiv_q_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
182
   mpz_tdiv_r_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
183

184
   mpz_mod : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
185
   mpz_mod_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
186
   mpz_divexact : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
187
   mpz_divexact_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
188

189
   mpz_mod_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
190
   mpz_div_2exp : procedure (var dest: mpz_t; const src1: mpz_t; src2: mp_bitcnt_t); cdecl;
191

192
   mpz_divisible_p : function (var n, d: mpz_t): Integer; cdecl;
193
   mpz_divisible_ui_p : function (var n: mpz_t; d: Cardinal): Integer; cdecl;
194
   mpz_divisible_2exp_p : function (var n: mpz_t; d: mp_bitcnt_t): Integer; cdecl;
195
   mpz_congruent_p : function (var n, c, d: mpz_t): Integer; cdecl;
196
   mpz_congruent_ui_p : function (var n: mpz_t; c, d: Cardinal): Integer; cdecl;
197
   mpz_congruent_2exp_p : function (var n, c: mpz_t; b: mp_bitcnt_t): Integer; cdecl;
198

199
   mpz_powm : procedure (var dest: mpz_t; var Base, Exponent, Modulus: mpz_t); cdecl;
200
   mpz_powm_ui : procedure (var dest: mpz_t; var Base: mpz_t; Exponent: Cardinal; var Modulus: mpz_t); cdecl;
201
   mpz_pow_ui : procedure (var dest: mpz_t; var Base: mpz_t; Exponent: Cardinal); cdecl;
202
   mpz_ui_pow_ui : procedure (var dest: mpz_t; Base, Exponent: Cardinal); cdecl;
203

204
   mpz_root : function (var dest: mpz_t; const src: mpz_t; n: Cardinal): Integer; cdecl;
205
   mpz_nthroot : procedure (var dest: mpz_t; const src: mpz_t; n: Cardinal); cdecl;
206
   mpz_rootrem : procedure (var Root: mpz_t; var Rem: mpz_t; const src: mpz_t; n: Cardinal); cdecl;
207
   mpz_sqrt : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
208
   mpz_sqrtrem : procedure (var dest, destR: mpz_t; const src: mpz_t); cdecl;
209
   mpz_perfect_square_p : function (const src: mpz_t): Integer; cdecl;
210
   mpz_perfect_power_p : function (const src: mpz_t): Integer; cdecl;
211

212
   mpz_sizeinbase : function (const src: mpz_t; Base: Integer): Integer; cdecl;
213

214
   mpz_probable_prime_p : function (const src: mpz_t; var state: gmp_randstate_t; Prob: Integer; DivTested: Cardinal): Integer; cdecl;
215
   mpz_likely_prime_p : function (const src: mpz_t; var state: gmp_randstate_t; DivTested: Cardinal): Integer; cdecl;
216
   mpz_next_prime_candidate : procedure (var dest: mpz_t; const src: mpz_t; var state: gmp_randstate_t); cdecl;
217

218
   // Number theoretic functions
219
   mpz_gcd : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
220
   mpz_gcd_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
221
   mpz_gcdext : procedure (var dest, destA, destB: mpz_t; const srcA, srcB: mpz_t); cdecl;
222
   mpz_lcm : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
223
   mpz_lcm_ui : function (var dest: mpz_t; const src1: mpz_t; src2: Cardinal): Cardinal; cdecl;
224
   mpz_invert : function (var dest: mpz_t; const src, Modulus: mpz_t): Integer; cdecl;
225
   mpz_jacobi : function (const src1, src2: mpz_t): Integer; cdecl;
226
   mpz_legendre : function (const src1, src2: mpz_t): Integer; cdecl;
227
   mpz_kronecker : function (const src1, src2: mpz_t): Integer; cdecl;
228
   mpz_kronecker_si : function (const src1: mpz_t; src2: Integer): Integer; cdecl;
229
   mpz_kronecker_ui : function (const src1: mpz_t; src2: Cardinal): Integer; cdecl;
230
   mpz_si_kronecker : function (src1: Integer; const src2: mpz_t): Integer; cdecl;
231
   mpz_ui_kronecker : function (src1: Cardinal; const src2: mpz_t): Integer; cdecl;
232
   mpz_remove : function (var dest: mpz_t; const src1, src2: mpz_t): Cardinal; cdecl;
233
   mpz_fac_ui : procedure (var dest: mpz_t; src: Cardinal); cdecl;
234
   mpz_primorial_ui : procedure (var dest: mpz_t; n: Cardinal); cdecl;
235
   mpz_fib_ui : procedure (var dest: mpz_t; src: Cardinal); cdecl;
236
   mpz_fib2_ui : procedure (var dest: mpz_t; var destSub: mpz_t; src: Cardinal); cdecl;
237
   mpz_bin_ui : procedure (var dest: mpz_t; const src1: mpz_t; src2: Cardinal); cdecl;
238
   mpz_bin_uiui : procedure (var dest: mpz_t; src1, src2: Cardinal); cdecl;
239
   mpz_lucnum_ui : procedure (var dest: mpz_t; src: Cardinal); cdecl;
240
   mpz_lucnum2_ui : procedure (var dest: mpz_t; var destSub: mpz_t; src: Cardinal); cdecl;
241

242
   mpz_cmp : function (const src1, src2: mpz_t): Integer; cdecl;
243
   mpz_cmp_d : function (const src1: mpz_t; src2: Double): Integer; cdecl;
244
   mpz_cmp_ui : function (const src1: mpz_t; src2: Cardinal): Integer; cdecl;
245
   mpz_cmp_si : function (const src1: mpz_t; src2: Integer): Integer; cdecl;
246
   mpz_cmpabs : function (const src1, src2: mpz_t): Integer; cdecl;
247
   mpz_cmpabs_d : function (const src1: mpz_t; src2: Double): Integer; cdecl;
248
   mpz_cmpabs_ui : function (const src1: mpz_t; src2: Cardinal): Integer; cdecl;
249

250
   mpz_and : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
251
   mpz_ior : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
252
   mpz_xor : procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
253
   mpz_com : procedure (var dest: mpz_t; const src: mpz_t); cdecl;
254
   mpz_popcount : function (const src: mpz_t): mp_bitcnt_t; cdecl;
255
   mpz_hamdist : function (const src1, src2: mpz_t): mp_bitcnt_t; cdecl;
256
   mpz_scan0 : function (const src: mpz_t; StartingBit: mp_bitcnt_t): mp_bitcnt_t; cdecl;
257
   mpz_scan1 : function (const src: mpz_t; StartingBit: mp_bitcnt_t): mp_bitcnt_t; cdecl;
258
   mpz_setbit : procedure (var dest: mpz_t; BitIndex: mp_bitcnt_t); cdecl;
259
   mpz_clrbit : procedure (var dest: mpz_t; BitIndex: mp_bitcnt_t); cdecl;
260
   mpz_combit : procedure (var dest: mpz_t; BitIndex: mp_bitcnt_t); cdecl;
261
   mpz_tstbit : function (var dest: mpz_t; BitIndex: mp_bitcnt_t): Integer; cdecl;
262

263
   mpz_urandomb : procedure (var ROP: mpz_t; var state: gmp_randstate_t; n: Cardinal); cdecl;
264
   mpz_urandomm : procedure (var ROP: mpz_t; var state: gmp_randstate_t; var n: mpz_t); cdecl;
265
   mpz_rrandomb : procedure (var ROP: mpz_t; var state: gmp_randstate_t; n: Cardinal); cdecl;
266

267
procedure mpz_set_uint64(var dest: mpz_t; const src: UInt64);
268
procedure mpz_set_int64(var dest: mpz_t; const src: Int64);
269

270
function mpz_odd_p(const src: mpz_t): Boolean; inline;
271
function mpz_even_p(const src: mpz_t): Boolean; inline;
272
function mpz_sgn(const src: mpz_t): Integer;
273

274
var
275
   { Rational (i.e. Q) routines }
276
   mpq_canonicalize : procedure (var dest: mpq_t); cdecl;
277

278
   mpq_init : procedure (var dest: mpq_t); cdecl;
279
   mpq_inits : procedure (p: pmpq_t {; ...}); cdecl varargs;
280
   mpq_clear : procedure (var dest: mpq_t); cdecl;
281
   mpq_clears : procedure (p: pmpq_t {; ...}); cdecl varargs;
282
   mpq_set : procedure (var dest: mpq_t; const src: mpq_t); cdecl;
283
   mpq_set_z : procedure (var dest: mpq_t; const src: mpz_t); cdecl;
284
   mpq_set_ui : procedure (var dest: mpq_t; Nom, Den: Cardinal); cdecl;
285
   mpq_set_si : procedure (var dest: mpq_t; Nom: Integer; Den: Cardinal); cdecl;
286
   mpq_set_str : function (var dest: mpq_t; src: PAnsiChar; Base: Integer): Integer; cdecl;
287
   mpq_set_d : procedure (var dest: mpq_t; src: Double); cdecl;
288
   mpq_set_f : procedure (var dest: mpq_t; const src: mpf_t); cdecl;
289
   mpq_swap : procedure (var v1, v2: mpq_t); cdecl;
290

291
   mpq_add : procedure (var dest: mpq_t; const src1, src2: mpq_t); cdecl;
292
   mpq_sub : procedure (var dest: mpq_t; const src1, src2: mpq_t); cdecl;
293
   mpq_mul : procedure (var dest: mpq_t; const src1, src2: mpq_t); cdecl;
294
   mpq_div : procedure (var dest: mpq_t; const src1, src2: mpq_t); cdecl;
295
   mpq_neg : procedure (var dest: mpq_t; const src: mpq_t); cdecl;
296
   mpq_abs : procedure (var dest: mpq_t; const src: mpq_t); cdecl;
297
   mpq_inv : procedure (var dest: mpq_t; const src: mpq_t); cdecl;
298
   mpq_mul_2exp : procedure (var dest: mpq_t; const src1: mpq_t; src2: mp_bitcnt_t); cdecl;
299
   mpq_div_2exp : procedure (var dest: mpq_t; const src1: mpq_t; src2: mp_bitcnt_t); cdecl;
300

301
   mpq_cmp : function (const src1, src2: mpq_t): Integer; cdecl;
302
   mpq_cmp_ui : function (const src1: mpq_t; Nom2, Den2: Cardinal): Integer; cdecl;
303
   mpq_cmp_si : function (const src1: mpq_t; Nom2: Integer; Den2: Cardinal): Integer; cdecl;
304
   mpq_equal : function (const src1, src2: mpq_t): Integer; cdecl;
305

306
   mpq_get_d : function (const src: mpq_t): Double; cdecl;
307
   mpq_set_num : procedure (var dest: mpq_t; const src: mpz_t); cdecl;
308
   mpq_set_den : procedure (var dest: mpq_t; const src: mpz_t); cdecl;
309
   mpq_get_num : procedure (var dest: mpz_t; const src: mpq_t); cdecl;
310
   mpq_get_den : procedure (var dest: mpz_t; const src: mpq_t); cdecl;
311

312
   mpq_get_str : function (dest: PAnsiChar; Base: Integer; const src: mpq_t): PAnsiChar; cdecl;
313

314
function mpq_sgn(const src: mpq_t): Integer; // [MACRO]
315
function mpq_numref(const src: mpq_t): pmpz_t; inline; // [MACRO]
316
function mpq_denref(const src: mpq_t): pmpz_t; inline; // [MACRO]
317

318
var
319
   { Floating point (i.e. R) routines }
320
   mpf_set_default_prec : procedure (Precision: mp_bitcnt_t); cdecl;
321
   mpf_get_default_prec: function : mp_bitcnt_t; cdecl;
322
   mpf_init : procedure (var dest: mpf_t); cdecl;
323
   mpf_init2 : procedure (var dest: mpf_t; Precision: mp_bitcnt_t); cdecl;
324
   mpf_inits : procedure (p: pmpf_t {; ...}); cdecl varargs;
325
   mpf_clear : procedure (var dest: mpf_t); cdecl;
326
   mpf_clears : procedure (p: pmpf_t {; ...}); cdecl varargs;
327
   mpf_set_prec : procedure (var dest: mpf_t; Precision: mp_bitcnt_t); cdecl;
328
   mpf_get_prec : function (const src: mpf_t): mp_bitcnt_t; cdecl;
329
   mpf_set_prec_raw : procedure (var dest: mpf_t; Precision: mp_bitcnt_t); cdecl;
330

331
   mpf_set : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
332
   mpf_set_ui : procedure (var dest: mpf_t; src: Cardinal); cdecl;
333
   mpf_set_si : procedure (var dest: mpf_t; src: Integer); cdecl;
334
   mpf_set_d : procedure (var dest: mpf_t; src: Double); cdecl;
335
   mpf_set_z : procedure (var dest: mpf_t; const src: mpz_t); cdecl;
336
   mpf_set_q : procedure (var dest: mpf_t; const src: mpq_t); cdecl;
337
   mpf_set_str : function (var dest: mpf_t; src: PAnsiChar; Base: Integer): Integer; cdecl;
338
   mpf_swap : procedure (var v1, v2: mpf_t); cdecl;
339

340
   mpf_init_set : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
341
   mpf_init_set_ui : procedure (var dest: mpf_t; src: Cardinal); cdecl;
342
   mpf_init_set_si : procedure (var dest: mpf_t; src: Integer); cdecl;
343
   mpf_init_set_d : procedure (var dest: mpf_t; src: Double); cdecl;
344
   mpf_init_set_str : function (var dest: mpf_t; src: PAnsiChar; Base: Integer): Integer; cdecl;
345

346
   mpf_get_d : function (const src: mpf_t): Double; cdecl;
347
   mpf_get_si : function (const src: mpf_t): Integer; cdecl;
348
   mpf_get_ui : function (const src: mpf_t): Cardinal; cdecl;
349
   mpf_get_d_2exp : function (var Exp: Integer; const src: mpf_t): Double; cdecl;
350
   mpf_fits_sint_p : function (const src: mpf_t): Integer; cdecl;
351
   mpf_fits_slong_p : function (const src: mpf_t): Integer; cdecl;
352
   mpf_fits_sshort_p : function (const src: mpf_t): Integer; cdecl;
353
   mpf_fits_uint_p : function (const src: mpf_t): Integer; cdecl;
354
   mpf_fits_ulong_p : function (const src: mpf_t): Integer; cdecl;
355
   mpf_fits_ushort_p : function (const src: mpf_t): Integer; cdecl;
356

357
   mpf_cmp : function (const src1, src2: mpf_t): Integer; cdecl;
358
   mpf_cmp_si : function (const src1: mpf_t; src2: Integer): Integer; cdecl;
359
   mpf_cmp_ui : function (const src1: mpf_t; src2: Cardinal): Integer; cdecl;
360
   mpf_cmp_d : function (const src1: mpf_t; src2: Double): Integer; cdecl;
361
   mpf_eq : function (const src1, src2: mpf_t; NumberOfBits: mp_bitcnt_t): Integer; cdecl;
362
   mpf_reldiff : procedure (var dest: mpf_t; const src1, src2: mpf_t); cdecl;
363

364
   mpf_get_str : function (dest: PAnsiChar; var Exponent: mp_exp_t; Base: Integer;
365
      NumberOfDigits: mp_size_t; const src: mpf_t): PAnsiChar; cdecl;
366

367
   mpf_add : procedure (var dest: mpf_t; const src1, src2: mpf_t); cdecl;
368
   mpf_add_ui : procedure (var dest: mpf_t; const src1: mpf_t; src2: Cardinal); cdecl;
369
   mpf_sub : procedure (var dest: mpf_t; const src1, src2: mpf_t); cdecl;
370
   mpf_ui_sub : procedure (var dest: mpf_t; src1: Cardinal; const src2: mpf_t); cdecl;
371
   mpf_sub_ui : procedure (var dest: mpf_t; const src1: mpf_t; src2: Cardinal); cdecl;
372
   mpf_mul : procedure (var dest: mpf_t; const src1, src2: mpf_t); cdecl;
373
   mpf_mul_ui : procedure (var dest: mpf_t; const src1: mpf_t; src2: Cardinal); cdecl;
374
   mpf_div : procedure (var dest: mpf_t; const src1, src2: mpf_t); cdecl;
375
   mpf_ui_div : procedure (var dest: mpf_t; src1: Cardinal; const src2: mpf_t); cdecl;
376
   mpf_div_ui : procedure (var dest: mpf_t; const src1: mpf_t; src2: Cardinal); cdecl;
377
   mpf_sqrt : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
378
   mpf_sqrt_ui : procedure (var dest: mpf_t; src: Cardinal); cdecl;
379
   mpf_pow_ui : procedure (var dest: mpf_t; const src1: mpf_t; src2: Cardinal); cdecl;
380
   mpf_neg : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
381
   mpf_abs : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
382
   mpf_mul_2exp : procedure (var dest: mpf_t; const src1: mpf_t; src2: mp_bitcnt_t); cdecl;
383
   mpf_div_2exp : procedure (var dest: mpf_t; const src1: mpf_t; src2: mp_bitcnt_t); cdecl;
384

385
   mpf_ceil : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
386
   mpf_floor : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
387
   mpf_trunc : procedure (var dest: mpf_t; const src: mpf_t); cdecl;
388
   mpf_integer_p : function (const src: mpf_t): Integer; cdecl;
389

390
   mpf_urandomb : procedure (var ROP: mpf_t; var state: gmp_randstate_t; nBits: mp_bitcnt_t); cdecl;
391
   mpf_rrandomb : procedure (var ROP: mpf_t; var state: gmp_randstate_t; maxSize: mp_size_t; exp: mp_exp_t); cdecl;
392

393
function mpf_sgn(const src: mpf_t): Integer;
394

395
var
396
   gmp_randinit_default : procedure (var state: gmp_randstate_t); cdecl;
397
   gmp_randinit_mt : procedure (var state: gmp_randstate_t); cdecl;
398
   gmp_randinit_lc_2exp : procedure (var state: gmp_randstate_t; var a: mpz_t; c: Cardinal; M2Exp: mp_bitcnt_t); cdecl;
399
   gmp_randinit_lc_2exp_size : procedure (var state: gmp_randstate_t; size: mp_bitcnt_t); cdecl;
400
   gmp_randinit_set : procedure (var dest: gmp_randstate_t; const src: gmp_randstate_t); cdecl;
401
   gmp_randclear : procedure (var state: gmp_randstate_t); cdecl;
402
   gmp_randseed : procedure (var state: gmp_randstate_t; Seed: mpz_t); cdecl;
403
   gmp_randseed_ui : procedure (var state: gmp_randstate_t; Seed: Cardinal); cdecl;
404
   gmp_urandomb_ui : function (var state: gmp_randstate_t; n: Cardinal): Cardinal; cdecl;
405
   gmp_urandomm_ui : function (var state: gmp_randstate_t; n: Cardinal): Cardinal; cdecl;
406

407
{ Formatted I/O functions }
408
// for "..." arguments, pointer to mpx_t and PAnsiChar should be used.
409
// e.g:
410
//    var i: mpz_t;
411
//        buf: AnsiString;
412
//    begin
413
//       mpz_init_set_ui(i, 12345);
414
//       SetLength(buf, 100); // allocate memory
415
//       gmp_printf(PAnsiChar(buf), '%s is an mpz %Zd', PAnsiChar('hear'), @i);
416
//       mpz_clear(i);
417
//    end;
418

419
// for rational numbers,
420
   gmp_printf : procedure (Buf: PAnsiChar; Fmt: PAnsiChar{; ...}); cdecl varargs;
421
   gmp_scanf : procedure (Buf: PAnsiChar; Fmt: PAnsiChar{; ...}); cdecl varargs;
422

423
{ Extensions to the GMP library, implemented in this unit }
424

425
procedure mpf_exp(var dest: mpf_t; const src: mpf_t);
426

427
(*
428

429
Disabled for now, as these are not thread-safe
430

431
procedure mpf_ln(var dest: mpf_t; const src: mpf_t);
432
procedure mpf_pow(var dest: mpf_t; const src1, src2: mpf_t);
433
procedure mpf_sin(var dest: mpf_t; const src: mpf_t);
434
procedure mpf_cos(var dest: mpf_t; const src: mpf_t);
435
procedure mpf_arctan(var dest: mpf_t; const src: mpf_t);
436
procedure mpf_pi(var dest: mpf_t);
437

438
*)
439

440
var
441
   vOnNeedMPIRDynamicDLLName : function : String;
442

443
function Bind_MPIR_DLL(const dllName : String = '') : Boolean;
444

445
// ------------------------------------------------------------------
446
// ------------------------------------------------------------------
447
// ------------------------------------------------------------------
448
implementation
449
// ------------------------------------------------------------------
450
// ------------------------------------------------------------------
451
// ------------------------------------------------------------------
452

453
var
454
   vDLLHandle : THandle;
455
   vBindMRSW : TMultiReadSingleWrite;
456

457
function PerformBind_MPIR_DLL(dllName : String) : Boolean;
458
var
459
   handle : THandle;
460

461
   function GetProcMPZ(const name : AnsiString) : Pointer;
462
   begin
463
      Result := GetProcAddress(handle, PAnsiChar('__gmpz_'+name));
464
   end;
465

466
   function GetProcMPQ(const name : AnsiString) : Pointer;
467
   begin
468
      Result := GetProcAddress(handle, PAnsiChar('__gmpq_'+name));
469
   end;
470

471
   function GetProcMPF(const name : AnsiString) : Pointer;
472
   begin
473
      Result := GetProcAddress(handle, PAnsiChar('__gmpf_'+name));
474
   end;
475

476
   function GetProcGMP(const name : AnsiString) : Pointer;
477
   begin
478
      Result := GetProcAddress(handle, PAnsiChar('__gmp_'+name));
479
   end;
480

481
begin
482
   vBindMRSW.BeginWrite;
483
   try
484
      if dllName = '' then begin
485
         if Assigned(vOnNeedMPIRDynamicDLLName) then
486
            dllName := vOnNeedMPIRDynamicDLLName();
487
         if dllName = '' then
488
            dllName := 'mpir.dll';
489
      end;
490

491
      handle := LoadLibrary(PChar(dllName));
492
      if handle = 0 then begin
493
          raise EOSError.CreateFmt('Failed to load "%s", Error %d: %s',
494
                                   [dllName, GetLastError, SysErrorMessage(GetLastError)]);
495
      end;
496

497
      mpz_init := GetProcMPZ('init');
498
      mpz_inits := GetProcMPZ('inits');
499
      mpz_init2 := GetProcMPZ('init2');
500
      mpz_clear := GetProcMPZ('clear');
501
      mpz_clears := GetProcMPZ('clears');
502
      mpz_realloc := GetProcMPZ('realloc');
503
      mpz_realloc2 := GetProcMPZ('realloc2');
504
      mpz_array_init := GetProcMPZ('array_init');
505
      mpz_swap := GetProcMPZ('swap');
506
      mpz_set := GetProcMPZ('set');
507
      mpz_set_ui := GetProcMPZ('set_ui');
508
      mpz_set_si := GetProcMPZ('set_si');
509
      mpz_set_d := GetProcMPZ('set_d');
510
      mpz_set_q := GetProcMPZ('set_q');
511
      mpz_set_f := GetProcMPZ('set_f');
512
      mpz_set_str := GetProcMPZ('set_str');
513
      mpz_init_set := GetProcMPZ('init_set');
514
      mpz_init_set_ui := GetProcMPZ('init_set_ui');
515
      mpz_init_set_si := GetProcMPZ('init_set_si');
516
      mpz_init_set_d := GetProcMPZ('init_set_d');
517
      mpz_init_set_str := GetProcMPZ('init_set_str');
518
      mpz_import := GetProcMPZ('import');
519
      mpz_export := GetProcMPZ('export');
520
      mpz_getlimbn := GetProcMPZ('getlimbn');
521
      mpz_size := GetProcMPZ('size');
522
      mpz_get_ui := GetProcMPZ('get_ui');
523
      mpz_get_si := GetProcMPZ('get_si');
524
      mpz_get_d := GetProcMPZ('get_d');
525
      mpz_get_d_2exp := GetProcMPZ('get_d_2exp');
526
      mpz_fits_sint_p := GetProcMPZ('fits_sint_p');
527
      mpz_fits_slong_p := GetProcMPZ('fits_slong_p');
528
      mpz_fits_sshort_p := GetProcMPZ('fits_sshort_p');
529
      mpz_fits_uint_p := GetProcMPZ('fits_uint_p');
530
      mpz_fits_ulong_p := GetProcMPZ('fits_ulong_p');
531
      mpz_fits_ushort_p := GetProcMPZ('fits_ushort_p');
532
      mpz_get_str := GetProcMPZ('get_str');
533
      mpz_add := GetProcMPZ('add');
534
      mpz_add_ui := GetProcMPZ('add_ui');
535
      mpz_sub := GetProcMPZ('sub');
536
      mpz_sub_ui := GetProcMPZ('sub_ui');
537
      mpz_ui_sub := GetProcMPZ('ui_sub');
538
      mpz_mul := GetProcMPZ('mul');
539
      mpz_mul_si := GetProcMPZ('mul_si');
540
      mpz_mul_ui := GetProcMPZ('mul_ui');
541
      mpz_mul_2exp := GetProcMPZ('mul_2exp');
542
      mpz_addmul := GetProcMPZ('addmul');
543
      mpz_addmul_ui := GetProcMPZ('addmul_ui');
544
      mpz_submul := GetProcMPZ('submul');
545
      mpz_submul_ui := GetProcMPZ('submul_ui');
546
      mpz_neg := GetProcMPZ('neg');
547
      mpz_abs := GetProcMPZ('abs');
548
      mpz_cdiv_q := GetProcMPZ('cdiv_q');
549
      mpz_cdiv_r := GetProcMPZ('cdiv_r');
550
      mpz_cdiv_qr := GetProcMPZ('cdiv_qr');
551
      mpz_cdiv_q_ui := GetProcMPZ('cdiv_q_ui');
552
      mpz_cdiv_r_ui := GetProcMPZ('cdiv_r_ui');
553
      mpz_cdiv_qr_ui := GetProcMPZ('cdiv_qr_ui');
554
      mpz_cdiv_ui := GetProcMPZ('cdiv_ui');
555
      mpz_cdiv_q_2exp := GetProcMPZ('cdiv_q_2exp');
556
      mpz_cdiv_r_2exp := GetProcMPZ('cdiv_r_2exp');
557
      mpz_fdiv_q := GetProcMPZ('fdiv_q');
558
      mpz_fdiv_r := GetProcMPZ('fdiv_r');
559
      mpz_fdiv_qr := GetProcMPZ('fdiv_qr');
560
      mpz_fdiv_q_ui := GetProcMPZ('fdiv_q_ui');
561
      mpz_fdiv_r_ui := GetProcMPZ('fdiv_r_ui');
562
      mpz_fdiv_qr_ui := GetProcMPZ('fdiv_qr_ui');
563
      mpz_fdiv_ui := GetProcMPZ('fdiv_ui');
564
      mpz_fdiv_q_2exp := GetProcMPZ('fdiv_q_2exp');
565
      mpz_fdiv_r_2exp := GetProcMPZ('fdiv_r_2exp');
566
      mpz_tdiv_q := GetProcMPZ('tdiv_q');
567
      mpz_tdiv_r := GetProcMPZ('tdiv_r');
568
      mpz_tdiv_qr := GetProcMPZ('tdiv_qr');
569
      mpz_tdiv_q_ui := GetProcMPZ('tdiv_q_ui');
570
      mpz_tdiv_r_ui := GetProcMPZ('tdiv_r_ui');
571
      mpz_tdiv_qr_ui := GetProcMPZ('tdiv_qr_ui');
572
      mpz_tdiv_ui := GetProcMPZ('tdiv_ui');
573
      mpz_tdiv_q_2exp := GetProcMPZ('tdiv_q_2exp');
574
      mpz_tdiv_r_2exp := GetProcMPZ('tdiv_r_2exp');
575
      mpz_mod := GetProcMPZ('mod');
576
      mpz_mod_ui := GetProcMPZ('mod_ui');
577
      mpz_divexact := GetProcMPZ('divexact');
578
      mpz_divexact_ui := GetProcMPZ('divexact_ui');
579
      mpz_mod_2exp := GetProcMPZ('mod_2exp');
580
      mpz_div_2exp := GetProcMPZ('div_2exp');
581
      mpz_divisible_p := GetProcMPZ('divisible_p');
582
      mpz_divisible_ui_p := GetProcMPZ('divisible_ui_p');
583
      mpz_divisible_2exp_p := GetProcMPZ('divisible_2exp_p');
584
      mpz_congruent_p := GetProcMPZ('congruent_p');
585
      mpz_congruent_ui_p := GetProcMPZ('congruent_ui_p');
586
      mpz_congruent_2exp_p := GetProcMPZ('congruent_2exp_p');
587
      mpz_powm := GetProcMPZ('powm');
588
      mpz_powm_ui := GetProcMPZ('powm_ui');
589
      mpz_pow_ui := GetProcMPZ('pow_ui');
590
      mpz_ui_pow_ui := GetProcMPZ('ui_pow_ui');
591
      mpz_root := GetProcMPZ('root');
592
      mpz_nthroot := GetProcMPZ('nthroot');
593
      mpz_rootrem := GetProcMPZ('rootrem');
594
      mpz_sqrt := GetProcMPZ('sqrt');
595
      mpz_sqrtrem := GetProcMPZ('sqrtrem');
596
      mpz_perfect_square_p := GetProcMPZ('perfect_square_p');
597
      mpz_perfect_power_p := GetProcMPZ('perfect_power_p');
598
      mpz_sizeinbase := GetProcMPZ('sizeinbase');
599
      mpz_probable_prime_p := GetProcMPZ('probable_prime_p');
600
      mpz_likely_prime_p := GetProcMPZ('likely_prime_p');
601
      mpz_next_prime_candidate := GetProcMPZ('next_prime_candidate');
602
      mpz_gcd := GetProcMPZ('gcd');
603
      mpz_gcd_ui := GetProcMPZ('gcd_ui');
604
      mpz_gcdext := GetProcMPZ('gcdext');
605
      mpz_lcm := GetProcMPZ('lcm');
606
      mpz_lcm_ui := GetProcMPZ('lcm_ui');
607
      mpz_invert := GetProcMPZ('invert');
608
      mpz_jacobi := GetProcMPZ('jacobi');
609
      mpz_legendre := GetProcMPZ('legendre');
610
      mpz_kronecker := GetProcMPZ('kronecker');
611
      mpz_kronecker_si := GetProcMPZ('kronecker_si');
612
      mpz_kronecker_ui := GetProcMPZ('kronecker_ui');
613
      mpz_si_kronecker := GetProcMPZ('si_kronecker');
614
      mpz_ui_kronecker := GetProcMPZ('ui_kronecker');
615
      mpz_remove := GetProcMPZ('remove');
616
      mpz_fac_ui := GetProcMPZ('fac_ui');
617
      mpz_primorial_ui := GetProcMPZ('primorial_ui');
618
      mpz_fib_ui := GetProcMPZ('fib_ui');
619
      mpz_fib2_ui := GetProcMPZ('fib2_ui');
620
      mpz_bin_ui := GetProcMPZ('bin_ui');
621
      mpz_bin_uiui := GetProcMPZ('bin_uiui');
622
      mpz_lucnum_ui := GetProcMPZ('lucnum_ui');
623
      mpz_lucnum2_ui := GetProcMPZ('lucnum2_ui');
624
      mpz_cmp := GetProcMPZ('cmp');
625
      mpz_cmp_d := GetProcMPZ('cmp_d');
626
      mpz_cmp_ui := GetProcMPZ('cmp_ui');
627
      mpz_cmp_si := GetProcMPZ('cmp_si');
628
      mpz_cmpabs := GetProcMPZ('cmpabs');
629
      mpz_cmpabs_d := GetProcMPZ('cmpabs_d');
630
      mpz_cmpabs_ui := GetProcMPZ('cmpabs_ui');
631
      mpz_and := GetProcMPZ('and');
632
      mpz_ior := GetProcMPZ('ior');
633
      mpz_xor := GetProcMPZ('xor');
634
      mpz_com := GetProcMPZ('com');
635
      mpz_popcount := GetProcMPZ('popcount');
636
      mpz_hamdist := GetProcMPZ('hamdist');
637
      mpz_scan0 := GetProcMPZ('scan0');
638
      mpz_scan1 := GetProcMPZ('scan1');
639
      mpz_setbit := GetProcMPZ('setbit');
640
      mpz_clrbit := GetProcMPZ('clrbit');
641
      mpz_combit := GetProcMPZ('combit');
642
      mpz_tstbit := GetProcMPZ('tstbit');
643
      mpz_urandomb := GetProcMPZ('urandomb');
644
      mpz_urandomm := GetProcMPZ('urandomm');
645
      mpz_rrandomb := GetProcMPZ('rrandomb');
646

647
      mpq_canonicalize := GetProcMPQ('canonicalize');
648
      mpq_init := GetProcMPQ('init');
649
      mpq_inits := GetProcMPQ('inits');
650
      mpq_clear := GetProcMPQ('clear');
651
      mpq_clears := GetProcMPQ('clears');
652
      mpq_set := GetProcMPQ('set');
653
      mpq_set_z := GetProcMPQ('set_z');
654
      mpq_set_ui := GetProcMPQ('set_ui');
655
      mpq_set_si := GetProcMPQ('set_si');
656
      mpq_set_str := GetProcMPQ('set_str');
657
      mpq_set_d := GetProcMPQ('set_d');
658
      mpq_set_f := GetProcMPQ('set_f');
659
      mpq_swap := GetProcMPQ('swap');
660
      mpq_add := GetProcMPQ('add');
661
      mpq_sub := GetProcMPQ('sub');
662
      mpq_mul := GetProcMPQ('mul');
663
      mpq_div := GetProcMPQ('div');
664
      mpq_neg := GetProcMPQ('neg');
665
      mpq_abs := GetProcMPQ('abs');
666
      mpq_inv := GetProcMPQ('inv');
667
      mpq_mul_2exp := GetProcMPQ('mul_2exp');
668
      mpq_div_2exp := GetProcMPQ('div_2exp');
669
      mpq_cmp := GetProcMPQ('cmp');
670
      mpq_cmp_ui := GetProcMPQ('cmp_ui');
671
      mpq_cmp_si := GetProcMPQ('cmp_si');
672
      mpq_equal := GetProcMPQ('equal');
673
      mpq_get_d := GetProcMPQ('get_d');
674
      mpq_set_num := GetProcMPQ('set_num');
675
      mpq_set_den := GetProcMPQ('set_den');
676
      mpq_get_num := GetProcMPQ('get_num');
677
      mpq_get_den := GetProcMPQ('get_den');
678
      mpq_get_str := GetProcMPQ('get_str');
679

680
      mpf_set_default_prec := GetProcMPF('set_default_prec');
681
      mpf_get_default_prec := GetProcMPF('get_default_prec');
682
      mpf_init := GetProcMPF('init');
683
      mpf_init2 := GetProcMPF('init2');
684
      mpf_inits := GetProcMPF('inits');
685
      mpf_clear := GetProcMPF('clear');
686
      mpf_clears := GetProcMPF('clears');
687
      mpf_set_prec := GetProcMPF('set_prec');
688
      mpf_get_prec := GetProcMPF('get_prec');
689
      mpf_set_prec_raw := GetProcMPF('set_prec_raw');
690
      mpf_set := GetProcMPF('set');
691
      mpf_set_ui := GetProcMPF('set_ui');
692
      mpf_set_si := GetProcMPF('set_si');
693
      mpf_set_d := GetProcMPF('set_d');
694
      mpf_set_z := GetProcMPF('set_z');
695
      mpf_set_q := GetProcMPF('set_q');
696
      mpf_set_str := GetProcMPF('set_str');
697
      mpf_swap := GetProcMPF('swap');
698
      mpf_init_set := GetProcMPF('init_set');
699
      mpf_init_set_ui := GetProcMPF('init_set_ui');
700
      mpf_init_set_si := GetProcMPF('init_set_si');
701
      mpf_init_set_d := GetProcMPF('init_set_d');
702
      mpf_init_set_str := GetProcMPF('init_set_str');
703
      mpf_get_d := GetProcMPF('get_d');
704
      mpf_get_si := GetProcMPF('get_si');
705
      mpf_get_ui := GetProcMPF('get_ui');
706
      mpf_get_d_2exp := GetProcMPF('get_d_2exp');
707
      mpf_fits_sint_p := GetProcMPF('fits_sint_p');
708
      mpf_fits_slong_p := GetProcMPF('fits_slong_p');
709
      mpf_fits_sshort_p := GetProcMPF('fits_sshort_p');
710
      mpf_fits_uint_p := GetProcMPF('fits_uint_p');
711
      mpf_fits_ulong_p := GetProcMPF('fits_ulong_p');
712
      mpf_fits_ushort_p := GetProcMPF('fits_ushort_p');
713
      mpf_cmp := GetProcMPF('cmp');
714
      mpf_cmp_si := GetProcMPF('cmp_si');
715
      mpf_cmp_ui := GetProcMPF('cmp_ui');
716
      mpf_cmp_d := GetProcMPF('cmp_d');
717
      mpf_eq := GetProcMPF('eq');
718
      mpf_reldiff := GetProcMPF('reldiff');
719
      mpf_get_str := GetProcMPF('get_str');
720
      mpf_add := GetProcMPF('add');
721
      mpf_add_ui := GetProcMPF('add_ui');
722
      mpf_sub := GetProcMPF('sub');
723
      mpf_ui_sub := GetProcMPF('ui_sub');
724
      mpf_sub_ui := GetProcMPF('sub_ui');
725
      mpf_mul := GetProcMPF('mul');
726
      mpf_mul_ui := GetProcMPF('mul_ui');
727
      mpf_div := GetProcMPF('div');
728
      mpf_ui_div := GetProcMPF('ui_div');
729
      mpf_div_ui := GetProcMPF('div_ui');
730
      mpf_sqrt := GetProcMPF('sqrt');
731
      mpf_sqrt_ui := GetProcMPF('sqrt_ui');
732
      mpf_pow_ui := GetProcMPF('pow_ui');
733
      mpf_neg := GetProcMPF('neg');
734
      mpf_abs := GetProcMPF('abs');
735
      mpf_mul_2exp := GetProcMPF('mul_2exp');
736
      mpf_div_2exp := GetProcMPF('div_2exp');
737
      mpf_ceil := GetProcMPF('ceil');
738
      mpf_floor := GetProcMPF('floor');
739
      mpf_trunc := GetProcMPF('trunc');
740
      mpf_integer_p := GetProcMPF('integer_p');
741
      mpf_urandomb := GetProcMPF('urandomb');
742
      mpf_rrandomb := GetProcMPF('rrandomb');
743

744
      gmp_randinit_default := GetProcGMP('randinit_default');
745
      gmp_randinit_mt := GetProcGMP('randinit_mt');
746
      gmp_randinit_lc_2exp := GetProcGMP('randinit_lc_2exp');
747
      gmp_randinit_lc_2exp_size := GetProcGMP('randinit_lc_2exp_size');
748
      gmp_randinit_set := GetProcGMP('randinit_set');
749
      gmp_randclear := GetProcGMP('randclear');
750
      gmp_randseed := GetProcGMP('randseed');
751
      gmp_randseed_ui := GetProcGMP('randseed_ui');
752
      gmp_urandomb_ui := GetProcGMP('urandomb_ui');
753
      gmp_urandomm_ui := GetProcGMP('urandomm_ui');
754
      gmp_printf := GetProcGMP('printf');
755
      gmp_scanf := GetProcGMP('scanf');
756

757
      vDLLHandle := handle;
758

759
      Result := True;
760
   finally
761
      vBindMRSW.EndWrite;
762
   end;
763
end;
764

765
function Bind_MPIR_DLL(const dllName : String = '') : Boolean;
766
begin
767
   if vDLLHandle <> 0 then Exit(True);
768
   Result := PerformBind_MPIR_DLL(dllName);
769
end;
770

771
function mpz_odd_p(const src: mpz_t): Boolean;
772
begin
773
   Result := (src.mp_size <> 0) and Odd(src.mp_d^);
774
end;
775

776
function mpz_even_p(const src: mpz_t): Boolean;
777
begin
778
   Result := (src.mp_size = 0) or not Odd(src.mp_d^);
779
end;
780

781
function mpq_numref(const src: mpq_t): pmpz_t;
782
begin
783
   Result := @src.mp_num;
784
end;
785

786
function mpq_denref(const src: mpq_t): pmpz_t;
787
begin
788
   Result := @src.mp_den;
789
end;
790

791
procedure mpz_set_uint64(var dest: mpz_t; const src: UInt64); // by delphi code
792
type
793
   _UINT64 = record
794
      m_lo: UInt32;
795
      m_hi: UInt32;
796
   end;
797
begin
798
   if _UINT64(src).m_hi = 0 then begin
799
      mpz_set_ui(dest, _UINT64(src).m_lo);
800
   end else begin
801
      mpz_set_ui(dest, _UINT64(src).m_hi);
802
      mpz_mul_2exp(dest, dest, 32);
803
      mpz_add_ui(dest, dest, _UINT64(src).m_lo);
804
   end;
805
end;
806

807
procedure mpz_set_int64(var dest: mpz_t; const src: Int64); // by delphi code
808
var
809
   u64: UInt64;
810
begin
811
   if src < 0 then begin
812
      u64 := Abs(src);
813
      mpz_set_uint64(dest, u64);
814
      dest.mp_size := -dest.mp_size;
815
   end else begin
816
      mpz_set_uint64(dest, src);
817
   end;
818
end;
819

820
function mpz_sgn(const src: mpz_t): Integer;
821
begin
822
   if src.mp_size < 0 then
823
      Result := -1
824
   else if src.mp_size > 0 then
825
      Result := 1
826
   else Result := 0;
827
end;
828

829
function mpq_sgn(const src: mpq_t): Integer;
830
begin
831
   if src.mp_num.mp_size < 0 then
832
      Result := -1
833
   else if src.mp_num.mp_size > 0 then
834
      Result := 1
835
   else Result := 0;
836
end;
837

838
function mpf_sgn(const src: mpf_t): Integer;
839
begin
840
   if src.mp_size < 0 then
841
      Result := -1
842
   else if src.mp_size > 0 then
843
      Result := 1
844
   else Result := 0;
845
end;
846

847
function GetExp(var x: mpf_t): Integer;
848
begin
849
   mpf_get_d_2exp(Result, x);
850
end;
851

852
const
853
   PREC_PRO = 25; // To keep the precision of intermediate calculation.
854

855
procedure mpf_exp(var dest: mpf_t; const src: mpf_t);
856
var
857
   y, s, c0: mpf_t;
858
   precision, n: Cardinal;
859
   exp, i: mp_exp_t;
860
   negative: Boolean;
861
begin
862
   precision := mpf_get_prec(dest) + PREC_PRO;
863
   mpf_init2(y, precision);
864
   mpf_set(y, src);
865
   mpf_set_ui(dest, 1);
866
   negative := mpf_sgn(y) < 0;
867
   if negative then
868
      mpf_neg(y, y);
869
   exp := GetExp(y);
870
   if exp > 0 then
871
      mpf_div_2exp(y, y, exp);
872
   mpf_init2(c0, precision);
873
   mpf_init2(s, precision);
874
   mpf_set_ui(s, 1);
875
   n := 1;
876
   repeat
877
      mpf_mul(s, s, y);
878
      mpf_div_ui(s, s, n);
879
      mpf_set(c0, dest);
880
      mpf_add(dest, dest, s);
881
      Inc(n)
882
   until mpf_eq(c0, dest, precision) <> 0;
883
   for i := 1 to exp do
884
      mpf_mul(dest, dest, dest);
885
   if negative then
886
      mpf_ui_div(dest, 1, dest);
887
   mpf_clear(s);
888
   mpf_clear(c0);
889
   mpf_clear(y);
890
end;
891

892
var
893
   LnHalf: mpf_t;
894
   LnHalfInited: Boolean = False;
895

896
procedure mpf_ln(var dest: mpf_t; const src: mpf_t);
897
var
898
   y, s, p, c0, half: mpf_t;
899
   n, precision: Cardinal;
900
   exp: mp_exp_t;
901
begin
902
   if mpf_sgn(src) <= 0 then
903
      raise EMathError.Create('Invalid argument for Ln');
904
   precision := mpf_get_prec(dest) + PREC_PRO;
905
   mpf_init2(y, precision);
906
   mpf_set(y, src);
907
   mpf_set_ui(dest, 0);
908
   exp := GetExp(y);
909
   if exp <> 0 then begin
910
      if not LnHalfInited or (mpf_get_prec(LnHalf) < precision) then begin
911
         if LnHalfInited then
912
            mpf_clear(LnHalf);
913
         LnHalfInited := True;
914
         mpf_init2(LnHalf, precision);
915
         mpf_init2(half, precision);
916
         mpf_set_d(half, 0.5);
917
         mpf_ln(LnHalf, half);
918
         mpf_clear(half)
919
      end;
920
      mpf_set(dest, LnHalf);
921
      mpf_mul_ui(dest, dest, Abs(exp));
922
      if exp > 0 then begin
923
         mpf_neg(dest, dest);
924
         mpf_div_2exp(y, y, exp)
925
      end else begin
926
         mpf_mul_2exp(y, y, -Exp)
927
      end;
928
   end;
929
   mpf_ui_sub(y, 1, y);
930
   mpf_init2(c0, precision);
931
   mpf_init2(s, precision);
932
   mpf_init2(p, precision);
933
   mpf_set_si(p, -1);
934
   n := 1;
935
   repeat
936
      mpf_mul(p, p, y);
937
      mpf_div_ui(s, p, n);
938
      mpf_set(c0, dest);
939
      mpf_add(dest, dest, s);
940
      Inc(n)
941
   until mpf_eq(c0, dest, precision) <> 0;
942
   mpf_clear(p);
943
   mpf_clear(s);
944
   mpf_clear(c0);
945
   mpf_clear(y);
946
end;
947

948
procedure mpf_pow(var dest: mpf_t; const src1, src2: mpf_t);
949
var
950
   temp: mpf_t;
951
begin
952
   mpf_init2(temp, mpf_get_prec(src1) + PREC_PRO);
953
   mpf_ln(temp, src1);
954
   mpf_mul(temp, temp, src2);
955
   mpf_exp(dest, temp);
956
   mpf_clear(temp);
957
end;
958
(*
959
var
960
   SqRtTwo: mpf_t;
961
   SqRtTwoInited: Boolean = False;
962

963
procedure mpf_arctan(var dest: mpf_t; const src: mpf_t);
964
var
965
   precision, n: Cardinal;
966
   xx, mx2, a, b: mpf_t;
967
begin
968
   precision := mpf_get_prec(dest) + PREC_PRO;
969
   mpf_init2(xx, precision);
970
   mpf_init2(mx2, precision);
971
   mpf_init2(a, precision);
972
   mpf_init2(b, precision);
973
   mpf_abs(xx, src);
974
   if not SqRtTwoInited or (mpf_get_prec(SqRtTwo) < precision) then begin
975
      if SqRtTwoInited then
976
         mpf_clear(SqRtTwo);
977
      SqRtTwoInited := True;
978
      mpf_init2(SqRtTwo, precision);
979
      mpf_sqrt_ui(SqRtTwo, 2)
980
   end;
981
   mpf_add_ui(a, SqRtTwo, 1);
982
   if mpf_cmp(xx, a) > 0 then begin
983
      mpf_pi(dest);
984
      mpf_div_2exp(dest, dest, 1);
985
      mpf_ui_div(xx, 1, xx);
986
      mpf_neg(xx, xx)
987
   end else begin
988
      mpf_sub_ui(b, SqRtTwo, 1);
989
      if mpf_cmp(xx, b) > 0 then begin
990
         mpf_pi(dest);
991
         mpf_div_2exp(dest, dest, 2);
992
         mpf_sub_ui(a, xx, 1);
993
         mpf_add_ui(b, xx, 1);
994
         mpf_div(xx, a, b)
995
      end else begin
996
         mpf_set_ui(dest, 0)
997
      end;
998
   end;
999
   mpf_mul(mx2, xx, xx);
1000
   mpf_neg(mx2, mx2);
1001
   mpf_add(dest, dest, xx);
1002
   n := 1;
1003
   repeat
1004
      mpf_mul(xx, xx, mx2);
1005
      mpf_div_ui(a, xx, 2 * n + 1);
1006
      mpf_set(b, dest);
1007
      mpf_add(dest, dest, a);
1008
      Inc(n)
1009
   until mpf_eq(b, dest, precision) <> 0;
1010
   if mpf_sgn(src) < 0 then
1011
      mpf_neg(dest, dest);
1012
   mpf_clear(xx);
1013
   mpf_clear(mx2);
1014
   mpf_clear(a);
1015
   mpf_clear(b);
1016
end;
1017

1018
var
1019
   _Pi: mpf_t;
1020
   PiInited: Boolean = False;
1021

1022
procedure mpf_pi(var dest: mpf_t);
1023
{ 4 arctan 1/5 - arctan 1/239 = pi/4 }
1024
var
1025
   b: mpf_t;
1026
   Precision: Cardinal;
1027
begin
1028
   Precision := mpf_get_prec(dest) + PREC_PRO;
1029
   if not PiInited or (mpf_get_prec(_Pi) < Precision) then begin
1030
      if PiInited then
1031
         mpf_clear(_Pi);
1032
      PiInited := True;
1033
      mpf_init2(_Pi, Precision);
1034
      mpf_set_ui(_Pi, 1);
1035
      mpf_div_ui(_Pi, _Pi, 5);
1036
      mpf_arctan(_Pi, _Pi);
1037
      mpf_mul_ui(_Pi, _Pi, 4);
1038
      mpf_init2(b, Precision);
1039
      mpf_set_ui(b, 1);
1040
      mpf_div_ui(b, b, 239);
1041
      mpf_arctan(b, b);
1042
      mpf_sub(_Pi, _Pi, b);
1043
      mpf_mul_ui(_Pi, _Pi, 4);
1044
      mpf_clear(b)
1045
   end;
1046
   mpf_set(dest, _Pi);
1047
end;
1048

1049
procedure mpf_sin(var dest: mpf_t; const src: mpf_t);
1050
var
1051
   precision, quadrant, n: Cardinal;
1052
   sign: Integer;
1053
   a, b, z, xx, c0: mpf_t;
1054
begin
1055
   precision := mpf_get_prec(dest) + PREC_PRO;
1056
   mpf_init2(a, precision);
1057
   mpf_init2(b, precision);
1058
   mpf_init2(z, precision);
1059
   mpf_init2(xx, precision);
1060
   mpf_init2(c0, precision);
1061
   sign := mpf_sgn(src);
1062
   mpf_abs(xx, src);
1063
   mpf_pi(z);
1064
   mpf_div_2exp(z, z, 1);
1065
   mpf_div(a, xx, z);
1066
   mpf_floor(xx, a);
1067
   if mpf_cmp_ui(xx, 4) >= 0 then begin
1068
      mpf_div_2exp(b, xx, 2);
1069
      mpf_floor(b, b);
1070
      mpf_mul_2exp(b, b, 2);
1071
      mpf_sub(b, xx, b)
1072
   end else begin
1073
      mpf_set(b, xx);
1074
   end;
1075
   quadrant := mpf_get_ui(b);
1076
   mpf_sub(b, a, xx);
1077
   mpf_mul(xx, z, b);
1078
   if quadrant > 1 then
1079
      sign := -Sign;
1080
   if Odd(quadrant) then
1081
      mpf_sub(xx, z, xx);
1082
   mpf_mul(z, xx, xx);
1083
   mpf_neg(z, z);
1084
   n := 1;
1085
   mpf_set_ui(b, 1);
1086
   mpf_set_ui(dest, 1);
1087
   repeat
1088
      Inc(n);
1089
      mpf_div_ui(b, b, n);
1090
      Inc(n);
1091
      mpf_div_ui(b, b, n);
1092
      mpf_mul(b, b, z);
1093
      mpf_set(c0, dest);
1094
      mpf_add(dest, dest, b)
1095
   until mpf_eq(c0, dest, precision) <> 0;
1096
   mpf_mul(dest, dest, xx);
1097
   if sign < 0 then
1098
      mpf_neg(dest, dest);
1099
   mpf_clear(a);
1100
   mpf_clear(b);
1101
   mpf_clear(z);
1102
   mpf_clear(xx);
1103
   mpf_clear(c0);
1104
end;
1105

1106
procedure mpf_cos(var dest: mpf_t; const src: mpf_t);
1107
var
1108
   temp: mpf_t;
1109
begin
1110
   mpf_init2(temp, mpf_get_prec(dest) + PREC_PRO);
1111
   mpf_pi(temp);
1112
   mpf_div_2exp(temp, temp, 1);
1113
   mpf_sub(temp, temp, src);
1114
   mpf_sin(dest, temp);
1115
   mpf_clear(temp);
1116
end;
1117
*)
1118
// ------------------------------------------------------------------
1119
// ------------------------------------------------------------------
1120
// ------------------------------------------------------------------
1121
initialization
1122
// ------------------------------------------------------------------
1123
// ------------------------------------------------------------------
1124
// ------------------------------------------------------------------
1125

1126
   vBindMRSW := TMultiReadSingleWrite.Create;
1127

1128
finalization
1129

1130
(*
1131
   if LnHalfInited then
1132
      mpf_clear(LnHalf);
1133

1134
   if SqRtTwoInited then
1135
      mpf_clear(SqRtTwo);
1136

1137
   if PiInited then
1138
      mpf_clear(_Pi);
1139
*)
1140

1141
   FreeAndNil(vBindMRSW);
1142

1143
end.
1144