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
unit dwsBigIntegerFunctions.GMP;
18

19
{$I dws.inc}
20

21
interface
22

23
uses
24
   Classes, System.SysUtils,
25
   dwsXPlatform, dwsUtils, dwsStrings, dwsCompilerContext,
26
   dwsFunctions, dwsSymbols, dwsExprs, dwsCoreExprs, dwsExprList, dwsUnitSymbols,
27
   dwsConstExprs, dwsMagicExprs, dwsDataContext, dwsErrors, dwsRelExprs,
28
   dwsOperators, dwsTokenTypes, dwsCryptoXPlatform, dwsScriptSource,
29
   dwsMPIR;
30

31
const
32
   SYS_BIGINTEGER = 'BigInteger';
33

34
type
35

36
   TBaseBigIntegerSymbol = class (TBaseSymbol)
37
      public
38
         constructor Create;
39

40
         function IsCompatible(typSym : TTypeSymbol) : Boolean; override;
41
         procedure InitData(const data : TData; offset : Integer); override;
42
   end;
43

44
   IdwsBigInteger = interface
45
      ['{93A7FA32-DE99-44AB-A5B4-861FD50E9AAB}']
46
      function GetValue : pmpz_t;
47
      procedure SetValue(const v : pmpz_t);
48
      property Value : pmpz_t read GetValue write SetValue;
49

50
      function BitLength : Integer;
51
      function PopCount : Integer;
52
      function Sign : Integer;
53

54
      function ToStringBase(base : Integer) : String;
55
      function ToHexString : String;
56

57
      function ToInt64 : Int64;
58

59
      function ToNeg : IdwsBigInteger;
60
   end;
61

62
   TdwsBigIntegerWrapperPool = class;
63

64
   TBigIntegerWrapper = class (TInterfacedObject, IdwsBigInteger, IGetSelf)
65
      private
66
         FNext : TBigIntegerWrapper;
67

68
      protected
69
         function _Release: Integer; stdcall;
70

71
         function GetValue : pmpz_t; inline;
72
         procedure SetValue(const v : pmpz_t); inline;
73
         function GetSelf : TObject;
74

75
         constructor CreateNewZero;
76
         procedure Reset;
77

78
      public
79
         Value : mpz_t;
80

81
         class function CreateZero : TBigIntegerWrapper; static;
82
         class function CreateInt64(const i : Int64) : TBigIntegerWrapper; static;
83
         class function CreateFloat(const f : Double) : TBigIntegerWrapper; static;
84
         class function CreateString(const s : String; base : Integer) : TBigIntegerWrapper; static;
85
         destructor Destroy; override;
86

87
         function BitLength : Integer;
88
         function PopCount : Integer;
89
         function Sign : Integer;
90

91
         function ToStringBase(base : Integer) : String;
92
         function ToHexString : String;
93
         function ToString : String; override;
94

95
         function ToInt64 : Int64;
96

97
         function ToNeg : IdwsBigInteger;
98
   end;
99

100
   TdwsBigIntegerWrapperPool = class
101
      private
102
         FLock : TMultiReadSingleWrite;
103
         FHead : TBigIntegerWrapper;
104
         FSize : Integer;
105

106
      public
107
         constructor Create;
108
         destructor Destroy; override;
109

110
         function Pop : TBigIntegerWrapper; inline;
111
         procedure Push(ref : TBigIntegerWrapper); inline;
112
         procedure Cleanup;
113
   end;
114

115
   TBigIntegerNegateExpr = class(TUnaryOpExpr)
116
      constructor Create(context : TdwsBaseSymbolsContext; const aScriptPos : TScriptPos; expr : TTypedExpr); override;
117
      procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;
118
   end;
119

120
   TMPIRBinOpFunc = procedure (var dest: mpz_t; const src1, src2: mpz_t); cdecl;
121

122
   TBigIntegerBinOpExpr = class(TBinaryOpExpr)
123
      constructor Create(context : TdwsCompilerContext; const aScriptPos : TScriptPos;
124
                         const anOp : TTokenType; aLeft, aRight : TTypedExpr); override;
125
      procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;
126
   end;
127

128
   TBigIntegerBinOpFuncExpr = class(TBigIntegerBinOpExpr)
129
      protected
130
         FOpFunc : TMPIRBinOpFunc;
131
         procedure InitOpFunc; virtual; abstract;
132

133
      public
134
         constructor Create(context : TdwsCompilerContext; const aScriptPos : TScriptPos;
135
                            const anOp : TTokenType; aLeft, aRight : TTypedExpr); override;
136

137
         procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override; final;
138
   end;
139

140
   TBigIntegerAddOpExpr = class(TBigIntegerBinOpFuncExpr)
141
      procedure InitOpFunc; override;
142
   end;
143
   TBigIntegerSubOpExpr = class(TBigIntegerBinOpFuncExpr)
144
      procedure InitOpFunc; override;
145
   end;
146
   TBigIntegerMultOpExpr = class(TBigIntegerBinOpFuncExpr)
147
      procedure InitOpFunc; override;
148
   end;
149
   TBigIntegerDivOpExpr = class(TBigIntegerBinOpFuncExpr)
150
      procedure InitOpFunc; override;
151
   end;
152
   TBigIntegerModOpExpr = class(TBigIntegerBinOpFuncExpr)
153
      procedure InitOpFunc; override;
154
   end;
155

156
   TBigIntegerAndOpExpr = class(TBigIntegerBinOpFuncExpr)
157
      procedure InitOpFunc; override;
158
   end;
159
   TBigIntegerOrOpExpr = class(TBigIntegerBinOpFuncExpr)
160
      procedure InitOpFunc; override;
161
   end;
162
   TBigIntegerXorOpExpr = class(TBigIntegerBinOpFuncExpr)
163
      procedure InitOpFunc; override;
164
   end;
165

166
   TBigIntegerShiftLeftExpr = class(TBigIntegerBinOpExpr)
167
      procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;
168
   end;
169
   TBigIntegerShiftRightExpr = class(TBigIntegerBinOpExpr)
170
      procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;
171
   end;
172

173
   TBigIntegerOpAssignExpr = class(TOpAssignExpr)
174
     procedure TypeCheckAssign(context : TdwsCompilerContext); override;
175
   end;
176

177
   TBigIntegerPlusAssignExpr = class(TBigIntegerOpAssignExpr)
178
     procedure EvalNoResult(exec : TdwsExecution); override;
179
   end;
180
   TBigIntegerPlusAssignIntExpr = class(TBigIntegerPlusAssignExpr)
181
     procedure EvalNoResult(exec : TdwsExecution); override;
182
   end;
183
   TBigIntegerMinusAssignExpr = class(TBigIntegerOpAssignExpr)
184
     procedure EvalNoResult(exec : TdwsExecution); override;
185
   end;
186
   TBigIntegerMinusAssignIntExpr = class(TBigIntegerMinusAssignExpr)
187
     procedure EvalNoResult(exec : TdwsExecution); override;
188
   end;
189
   TBigIntegerMultAssignExpr = class(TBigIntegerOpAssignExpr)
190
     procedure EvalNoResult(exec : TdwsExecution); override;
191
   end;
192

193
   TBigIntegerRelOpExpr = class(TBoolRelOpExpr)
194
      protected
195
        function InternalCompare(exec : TdwsExecution) : Integer;
196
   end;
197
   TBigIntegerRelOpExprClass = class of TBigIntegerRelOpExpr;
198

199
   TBigIntegerEqualOpExpr = class(TBigIntegerRelOpExpr)
200
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
201
   end;
202
   TBigIntegerNotEqualOpExpr = class(TBigIntegerRelOpExpr)
203
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
204
   end;
205
   TBigIntegerGreaterOpExpr = class(TBigIntegerRelOpExpr)
206
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
207
   end;
208
   TBigIntegerGreaterEqualOpExpr = class(TBigIntegerRelOpExpr)
209
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
210
   end;
211
   TBigIntegerLessOpExpr = class(TBigIntegerRelOpExpr)
212
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
213
   end;
214
   TBigIntegerLessEqualOpExpr = class(TBigIntegerRelOpExpr)
215
     function EvalAsBoolean(exec : TdwsExecution) : Boolean; override;
216
   end;
217

218
   TBigIntegerUnaryOpExpr = class (TUnaryOpExpr)
219
      public
220
         constructor Create(context : TdwsBaseSymbolsContext; const aScriptPos : TScriptPos; expr : TTypedExpr); override;
221
         procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override;
222
   end;
223

224
   TConvIntegerToBigIntegerExpr = class(TBigIntegerUnaryOpExpr)
225
      procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;
226
   end;
227
   TConvStringToBigIntegerExpr = class(TBigIntegerUnaryOpExpr)
228
      procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;
229
   end;
230
   TConvFloatToBigIntegerExpr = class(TBigIntegerUnaryOpExpr)
231
      procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override;
232
   end;
233
   TConvBigIntegerToIntegerExpr = class(TUnaryOpIntExpr)
234
      function  EvalAsInteger(exec : TdwsExecution) : Int64; override;
235
   end;
236
   TConvBigIntegerToFloatExpr = class(TUnaryOpFloatExpr)
237
      function  EvalAsFloat(exec : TdwsExecution) : Double; override;
238
   end;
239

240
   TBigIntegerToStringFunc = class(TInternalMagicStringFunction)
241
      procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
242
   end;
243
   TStringToBigIntegerFunc = class(TInternalMagicVariantFunction)
244
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
245
   end;
246
   TBigIntegerToHexFunc = class(TInternalMagicStringFunction)
247
      procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
248
   end;
249
   THexToBigIntegerFunc = class(TInternalMagicVariantFunction)
250
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
251
   end;
252

253
   TBigIntegerToBlobFunc = class(TInternalMagicVariantFunction)
254
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
255
   end;
256
   TBlobToBigIntegerFunc = class(TInternalMagicInterfaceFunction)
257
      procedure DoEvalAsInterface(const args : TExprBaseListExec; var result : IUnknown); override;
258
   end;
259

260
   TBigIntegerToFloatFunc = class(TInternalMagicFloatFunction)
261
      procedure DoEvalAsFloat(const args : TExprBaseListExec; var Result : Double); override;
262
   end;
263
   TBigIntegerToIntegerFunc = class(TInternalMagicIntFunction)
264
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
265
   end;
266

267
   TBigIntegerOddFunc = class(TInternalMagicBoolFunction)
268
      function DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean; override;
269
   end;
270
   TBigIntegerEvenFunc = class(TInternalMagicBoolFunction)
271
      function DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean; override;
272
   end;
273

274
   TBigIntegerSignFunc = class(TInternalMagicIntFunction)
275
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
276
   end;
277

278
   TBigIntegerAbsFunc = class(TInternalMagicVariantFunction)
279
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
280
   end;
281

282
   TBigIntegerBitLengthFunc = class(TInternalMagicIntFunction)
283
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
284
   end;
285

286
   TBigIntegerTestBitFunc = class(TInternalMagicBoolFunction)
287
      function DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean; override;
288
   end;
289

290
   TBigIntegerSetBitFunc = class(TInternalMagicProcedure)
291
      procedure DoEvalProc(const args : TExprBaseListExec); override;
292
   end;
293

294
   TBigIntegerSetBitValFunc = class(TInternalMagicProcedure)
295
      procedure DoEvalProc(const args : TExprBaseListExec); override;
296
   end;
297

298
   TBigIntegerClearBitFunc = class(TInternalMagicProcedure)
299
      procedure DoEvalProc(const args : TExprBaseListExec); override;
300
   end;
301

302
   TBigIntegerPopCountFunc = class(TInternalMagicIntFunction)
303
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
304
   end;
305

306
   TBigIntegerGcdFunc = class(TInternalMagicVariantFunction)
307
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
308
   end;
309

310
   TBigIntegerLcmFunc = class(TInternalMagicVariantFunction)
311
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
312
   end;
313

314
   TBigIntegerIsPrimeFunc = class(TInternalMagicBoolFunction)
315
      function DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean; override;
316
   end;
317
   TBigIntegerNextPrimeFunc = class(TInternalMagicVariantFunction)
318
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
319
   end;
320

321
   TBigIntegerPowerFunc = class(TInternalMagicVariantFunction)
322
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
323
   end;
324

325
   TBigIntegerSqrFunc = class(TInternalMagicVariantFunction)
326
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
327
   end;
328

329
   TBigIntegerModPowFunc = class(TInternalMagicVariantFunction)
330
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
331
   end;
332

333
   TBigIntegerModInvFunc = class(TInternalMagicVariantFunction)
334
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
335
   end;
336

337
   TBigIntegerDivModFunc = class(TInternalMagicProcedure)
338
      procedure DoEvalProc(const args : TExprBaseListExec); override;
339
   end;
340

341
   TBigJacobiFunc = class(TInternalMagicIntFunction)
342
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
343
   end;
344
   TBigLegendreFunc = class(TInternalMagicIntFunction)
345
      function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
346
   end;
347

348
   TBigIntegerFactorialFunc = class(TInternalMagicVariantFunction)
349
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
350
   end;
351
   TBigIntegerPrimorialFunc = class(TInternalMagicVariantFunction)
352
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
353
   end;
354

355
   TBigIntegerRandomFunc = class(TInternalMagicVariantFunction)
356
      procedure DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant); override;
357
   end;
358

359
// ------------------------------------------------------------------
360
// ------------------------------------------------------------------
361
// ------------------------------------------------------------------
362
implementation
363
// ------------------------------------------------------------------
364
// ------------------------------------------------------------------
365
// ------------------------------------------------------------------
366

367
const
368
   cLimbSize = SizeOf(NativeUInt);
369
   cPoolMaxSize = 256;
370

371
type
372
   TLimbArray = array [0..1024*1024*1024 div cLimbSize] of NativeUInt;
373
   PLimbArray = ^TLimbArray;
374

375
var
376
   vPool : TdwsBigIntegerWrapperPool;
377

378
// RegisterBigIntegerType                                      
379
//
380
procedure RegisterBigIntegerType(systemTable : TSystemSymbolTable; unitSyms : TUnitMainSymbols;
381
                                 unitTable : TSymbolTable);
382
var
383
   typBigInteger : TBaseBigIntegerSymbol;
384
begin
385
   if systemTable.FindLocal(SYS_BIGINTEGER)<>nil then exit;
386

387
   typBigInteger:=TBaseBigIntegerSymbol.Create;
388

389
   systemTable.AddSymbol(typBigInteger);
390
end;
391

392
// RegisterBigIntegerOperators
393
//
394
procedure RegisterBigIntegerOperators(systemTable : TSystemSymbolTable;
395
                                  unitTable : TSymbolTable; operators : TOperators);
396
var
397
   typBigInteger : TBaseBigIntegerSymbol;
398

399
   procedure RegisterOperators(token : TTokenType; exprClass : TBinaryOpExprClass);
400
   begin
401
      operators.RegisterOperator(token, exprClass, typBigInteger, typBigInteger);
402
      operators.RegisterOperator(token, exprClass, systemTable.TypInteger, typBigInteger);
403
      operators.RegisterOperator(token, exprClass, typBigInteger, systemTable.TypInteger);
404
   end;
405

406
begin
407
   typBigInteger:=systemTable.FindTypeSymbol(SYS_BIGINTEGER, cvMagic) as TBaseBigIntegerSymbol;
408

409
   if operators.FindCaster(typBigInteger, systemTable.TypInteger) <> nil then Exit;
410

411
   operators.RegisterUnaryOperator(ttMINUS, TBigIntegerNegateExpr, typBigInteger);
412

413
   RegisterOperators(ttPLUS,     TBigIntegerAddOpExpr);
414
   RegisterOperators(ttMINUS,    TBigIntegerSubOpExpr);
415
   RegisterOperators(ttTIMES,    TBigIntegerMultOpExpr);
416
   RegisterOperators(ttDIV,      TBigIntegerDivOpExpr);
417
   RegisterOperators(ttMOD,      TBigIntegerModOpExpr);
418
   RegisterOperators(ttAND,      TBigIntegerAndOpExpr);
419
   RegisterOperators(ttOR,       TBigIntegerOrOpExpr);
420
   RegisterOperators(ttXOR,      TBigIntegerXorOpExpr);
421

422
   operators.RegisterOperator(ttSHL, TBigIntegerShiftLeftExpr,   typBigInteger, systemTable.TypInteger);
423
   operators.RegisterOperator(ttSAR, TBigIntegerShiftRightExpr,  typBigInteger, systemTable.TypInteger);
424

425
   operators.RegisterOperator(ttPLUS_ASSIGN,  TBigIntegerPlusAssignExpr, typBigInteger, typBigInteger);
426
   operators.RegisterOperator(ttPLUS_ASSIGN,  TBigIntegerPlusAssignIntExpr, typBigInteger, systemTable.TypInteger);
427
   operators.RegisterOperator(ttMINUS_ASSIGN, TBigIntegerMinusAssignExpr, typBigInteger, typBigInteger);
428
   operators.RegisterOperator(ttMINUS_ASSIGN, TBigIntegerMinusAssignIntExpr, typBigInteger, systemTable.TypInteger);
429
   operators.RegisterOperator(ttTIMES_ASSIGN, TBigIntegerMultAssignExpr, typBigInteger, typBigInteger);
430
   operators.RegisterOperator(ttTIMES_ASSIGN, TBigIntegerMultAssignExpr, typBigInteger, systemTable.TypInteger);
431

432
   RegisterOperators(ttEQ,       TBigIntegerEqualOpExpr);
433
   RegisterOperators(ttNOT_EQ,   TBigIntegerNotEqualOpExpr);
434
   RegisterOperators(ttGTR,      TBigIntegerGreaterOpExpr);
435
   RegisterOperators(ttGTR_EQ,   TBigIntegerGreaterEqualOpExpr);
436
   RegisterOperators(ttLESS,     TBigIntegerLessOpExpr);
437
   RegisterOperators(ttLESS_EQ,  TBigIntegerLessEqualOpExpr);
438

439
   operators.RegisterCaster(typBigInteger, systemTable.TypInteger, TConvIntegerToBigIntegerExpr);
440
   operators.RegisterCaster(typBigInteger, systemTable.TypString,  TConvStringToBigIntegerExpr);
441
   operators.RegisterCaster(typBigInteger, systemTable.TypFloat,   TConvFloatToBigIntegerExpr);
442
   operators.RegisterCaster(systemTable.TypInteger, typBigInteger, TConvBigIntegerToIntegerExpr);
443
   operators.RegisterCaster(systemTable.TypFloat, typBigInteger,   TConvBigIntegerToFloatExpr);
444
end;
445

446
type
447
   TTypedExprBigIntegerHelper = class helper for TTypedExpr
448
      function EvalAsBigInteger(exec : TdwsExecution) : IdwsBigInteger;
449
   end;
450

451
function TTypedExprBigIntegerHelper.EvalAsBigInteger(exec : TdwsExecution) : IdwsBigInteger;
452
begin
453
   if Typ.UnAliasedType.ClassType = TBaseBigIntegerSymbol then begin
454
      EvalAsInterface(exec, IUnknown(Result));
455
      if Result = nil then
456
         Result := TBigIntegerWrapper.CreateZero;
457
   end else Result := TBigIntegerWrapper.CreateInt64( EvalAsInteger(exec) );
458
end;
459

460
// ArgBigInteger
461
//
462
function ArgBigInteger(const args : TExprBaseListExec; index : Integer) : IdwsBigInteger;
463
begin
464
   Result := (args.ExprBase[index] as TTypedExpr).EvalAsBigInteger(args.Exec);
465
end;
466

467
// ArgVarBigInteger
468
//
469
function ArgVarBigInteger(const args : TExprBaseListExec; index : Integer) : IdwsBigInteger;
470

471
   procedure Allocate(varExpr : TBaseTypeVarExpr; var result : IdwsBigInteger);
472
   var
473
      v : Variant;
474
   begin
475
      Result := TBigIntegerWrapper.CreateZero;
476
      v := IUnknown(Result);
477
      varExpr.AssignValue(args.Exec, v);
478
   end;
479

480
var
481
   varExpr : TBaseTypeVarExpr;
482
begin
483
   varExpr := (args.ExprBase[index] as TBaseTypeVarExpr);
484
   varExpr.EvalAsInterface(args.Exec, IUnknown(Result));
485
   if Result = nil then
486
      Allocate(varExpr, Result);
487
end;
488

489
// ------------------
490
// ------------------ TBaseBigIntegerSymbol ------------------
491
// ------------------
492

493
// Create
494
//
495
constructor TBaseBigIntegerSymbol.Create;
496
begin
497
   inherited Create(SYS_BIGINTEGER);
498
end;
499

500
// IsCompatible
501
//
502
function TBaseBigIntegerSymbol.IsCompatible(typSym : TTypeSymbol) : Boolean;
503
begin
504
   Result:=(typSym<>nil) and (typSym.UnAliasedType.ClassType=TBaseBigIntegerSymbol);
505
end;
506

507
// InitData
508
//
509
procedure TBaseBigIntegerSymbol.InitData(const data : TData; offset : Integer);
510
begin
511
   VarCopySafe(data[offset], IUnknown(nil));
512
end;
513

514
// ------------------
515
// ------------------ TBigIntegerWrapper ------------------
516
// ------------------
517

518
// CreateNewZero
519
//
520
constructor TBigIntegerWrapper.CreateNewZero;
521
begin
522
   Create;
523
   if not Bind_MPIR_DLL then
524
      raise Exception.Create('mpir.dll is required for BigInteger');
525

526
   mpz_init(Value);
527
end;
528

529
// Reset
530
//
531
procedure TBigIntegerWrapper.Reset;
532
begin
533
   mpz_set_ui(Value, 0);
534
end;
535

536
// _Release
537
//
538
function TBigIntegerWrapper._Release: Integer;
539
begin
540
   Result := InterlockedDecrement(FRefCount);
541
   if Result = 0 then
542
      vPool.Push(Self);
543
end;
544

545
// CreateZero
546
//
547
class function TBigIntegerWrapper.CreateZero : TBigIntegerWrapper;
548
begin
549
   Result := vPool.Pop;
550
end;
551

552
// CreateInt64
553
//
554
class function TBigIntegerWrapper.CreateInt64(const i : Int64) : TBigIntegerWrapper;
555
begin
556
   Result := vPool.Pop;
557
   mpz_set_int64(Result.Value, i);
558
end;
559

560
// CreateFloat
561
//
562
class function TBigIntegerWrapper.CreateFloat(const f : Double) : TBigIntegerWrapper;
563
begin
564
   Result := vPool.Pop;
565
   mpz_set_d(Result.Value, f);
566
end;
567

568
// CreateString
569
//
570
class function TBigIntegerWrapper.CreateString(const s : String; base : Integer) : TBigIntegerWrapper;
571
var
572
   buf : RawByteString;
573
   p : PAnsiChar;
574
begin
575
   Result := vPool.Pop;
576
   if s <> '' then begin
577
      ScriptStringToRawByteString(s, buf);
578
      p := Pointer(buf);
579
      if p^ = '+' then
580
         Inc(p);
581
      mpz_set_str(Result.Value, p, base);
582
   end;
583
end;
584

585
// Destroy
586
//
587
destructor TBigIntegerWrapper.Destroy;
588
begin
589
   if Value.mp_alloc <> 0 then
590
      mpz_clear(Value);
591
   inherited;
592
end;
593

594
// GetValue
595
//
596
function TBigIntegerWrapper.GetValue : pmpz_t;
597
begin
598
   Result := @Value;
599
end;
600

601
// SetValue
602
//
603
procedure TBigIntegerWrapper.SetValue(const v : pmpz_t);
604
begin
605
   mpz_set(Value, v^);
606
end;
607

608
// GetSelf
609
//
610
function TBigIntegerWrapper.GetSelf : TObject;
611
begin
612
   Result := Self;
613
end;
614

615
// BitLength
616
//
617
function TBigIntegerWrapper.BitLength : Integer;
618
begin
619
   if Value.mp_size = 0 then
620
      Result := 0
621
   else Result := mpz_sizeinbase(Value, 2);
622
end;
623

624
// PopCount
625
//
626
function TBigIntegerWrapper.PopCount : Integer;
627
begin
628
   if Value.mp_size = 0 then
629
      Result := 0
630
   else Result := mpz_popcount(Value);
631
end;
632

633
// Sign
634
//
635
function TBigIntegerWrapper.Sign : Integer;
636
begin
637
   Result := mpz_sgn(Value);
638
end;
639

640
// ToStringBase
641
//
642
function TBigIntegerWrapper.ToStringBase(base : Integer) : String;
643
var
644
   size : Integer;
645
   buf : RawByteString;
646
begin
647
   Assert(base in [2..62]);
648

649
   if Value.mp_size = 0 then Exit('0');
650

651
   size := mpz_sizeinbase(Value, base);
652
   Assert(size > 0);
653
   if Value.mp_size < 0 then
654
      Inc(size);
655
   SetLength(buf, size);
656
   mpz_get_str(Pointer(buf), base, Value);
657
   if (size > 1) and (buf[size] = #0) then
658
      SetLength(buf, size-1); // clear occasional trailing #0
659
   Result := RawByteStringToScriptString(buf);
660
end;
661

662
// ToHexString
663
//
664
function TBigIntegerWrapper.ToHexString : String;
665
begin
666
   Result := ToStringBase(16);
667
end;
668

669
// ToString
670
//
671
function TBigIntegerWrapper.ToString : String;
672
begin
673
   Result := ToStringBase(10);
674
end;
675

676
// ToInt64
677
//
678
function TBigIntegerWrapper.ToInt64 : Int64;
679
var
680
   n : Integer;
681
begin
682
   Result := 0;
683

684
   n := Abs(Value.mp_size);
685
   if n > 2 then n := 3;
686
   System.Move(Value.mp_d^, Result, n*4);
687

688
   if Value.mp_size < 0 then begin
689
      Result := -Result;
690
   end;
691
end;
692

693
// ToNeg
694
//
695
function TBigIntegerWrapper.ToNeg : IdwsBigInteger;
696
var
697
   biw : TBigIntegerWrapper;
698
begin
699
   biw := TBigIntegerWrapper.CreateZero;
700
   mpz_neg(biw.Value, Value);
701
   Result := biw;
702
end;
703

704
// ------------------
705
// ------------------ TdwsBigIntegerWrapperPool ------------------
706
// ------------------
707

708
// Create
709
//
710
constructor TdwsBigIntegerWrapperPool.Create;
711
begin
712
   inherited;
713
   FLock := TMultiReadSingleWrite.Create;
714
end;
715

716
// Destroy
717
//
718
destructor TdwsBigIntegerWrapperPool.Destroy;
719
begin
720
   inherited;
721
   Cleanup;
722
   FLock.Free;
723
end;
724

725
// Pop
726
//
727
function TdwsBigIntegerWrapperPool.Pop : TBigIntegerWrapper;
728
begin
729
   Result := nil;
730
   if Self <> nil then begin
731
      FLock.BeginWrite;
732
      try
733
         if FHead <> nil then begin
734
            Result := FHead;
735
            FHead := FHead.FNext;
736
            Result.FNext := nil;
737
            Dec(FSize);
738
         end;
739
      finally
740
         FLock.EndWrite;
741
      end;
742
   end;
743
   if Result = nil then
744
      Result := TBigIntegerWrapper.CreateNewZero
745
end;
746

747
// Push
748
//
749
procedure TdwsBigIntegerWrapperPool.Push(ref : TBigIntegerWrapper);
750
begin
751
   if (Self = nil) or (FSize >= cPoolMaxSize) then
752
      ref.Free
753
   else begin
754
      FLock.BeginWrite;
755
      try
756
         ref.FNext := FHead;
757
         FHead := ref;
758
         ref.Reset;
759
         Inc(FSize);
760
      finally
761
         FLock.EndWrite;
762
      end;
763
   end;
764
end;
765

766
// Cleanup
767
//
768
procedure TdwsBigIntegerWrapperPool.Cleanup;
769
var
770
   iter, next : TBigIntegerWrapper;
771
begin
772
   FLock.BeginWrite;
773
   try
774
      iter := FHead;
775
      while iter <> nil do begin
776
         next := iter.FNext;
777
         iter.Free;
778
         iter := next;
779
      end;
780
      FHead := nil;
781
      FSize := 0;
782
   finally
783
      FLock.EndWrite;
784
   end;
785
end;
786

787
// ------------------
788
// ------------------ TBigIntegerNegateExpr ------------------
789
// ------------------
790

791
// Create
792
//
793
constructor TBigIntegerNegateExpr.Create(context : TdwsBaseSymbolsContext; const aScriptPos : TScriptPos; expr : TTypedExpr);
794
begin
795
   inherited;
796
   Typ := expr.Typ;
797
end;
798

799
// EvalAsVariant
800
//
801
procedure TBigIntegerNegateExpr.EvalAsVariant(exec : TdwsExecution; var result : Variant);
802
begin
803
   result := Expr.EvalAsBigInteger(exec).ToNeg;
804
end;
805

806
// ------------------
807
// ------------------ TBigIntegerBinOpExpr ------------------
808
// ------------------
809

810
// Create
811
//
812
constructor TBigIntegerBinOpExpr.Create(context : TdwsCompilerContext; const aScriptPos : TScriptPos;
813
                                        const anOp : TTokenType; aLeft, aRight : TTypedExpr);
814
begin
815
   inherited Create(context, aScriptPos, anOp, aLeft, aRight);
816
   if aLeft.Typ.UnAliasedTypeIs(TBaseIntegerSymbol) then
817
      Typ := aRight.Typ
818
   else Typ := aLeft.Typ;
819
end;
820

821

822
// EvalAsVariant
823
//
824
procedure TBigIntegerBinOpExpr.EvalAsVariant(exec : TdwsExecution; var result : Variant);
825
var
826
   intf : IUnknown;
827
begin
828
   EvalAsInterface(exec, intf);
829
   result := intf;
830
end;
831

832
// ------------------
833
// ------------------ TBigIntegerBinOpFuncExpr ------------------
834
// ------------------
835

836
// Create
837
//
838
constructor TBigIntegerBinOpFuncExpr.Create(context : TdwsCompilerContext; const aScriptPos : TScriptPos;
839
                                            const anOp : TTokenType; aLeft, aRight : TTypedExpr);
840
begin
841
   inherited Create(context, aScriptPos, anOp, aLeft, aRight);
842
   InitOpFunc;
843
end;
844

845
// EvalAsInterface
846
//
847
procedure TBigIntegerBinOpFuncExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
848
var
849
   bi : TBigIntegerWrapper;
850
   biLeft, biRight : IdwsBigInteger;
851
begin
852
   biLeft := Left.EvalAsBigInteger(exec);
853
   biRight := Right.EvalAsBigInteger(exec);
854
   bi := TBigIntegerWrapper.CreateZero;
855
   FOpFunc(bi.Value, biLeft.Value^, biRight.Value^);
856
   result := bi as IdwsBigInteger;
857
end;
858

859
// ------------------
860
// ------------------ TBigIntegerAddOpExpr ------------------
861
// ------------------
862

863
procedure TBigIntegerAddOpExpr.InitOpFunc;
864
begin
865
   FOpFunc := mpz_add;
866
end;
867

868
// ------------------
869
// ------------------ TBigIntegerSubOpExpr ------------------
870
// ------------------
871

872
procedure TBigIntegerSubOpExpr.InitOpFunc;
873
begin
874
   FOpFunc := mpz_sub;
875
end;
876

877
// ------------------
878
// ------------------ TBigIntegerMultOpExpr ------------------
879
// ------------------
880

881
procedure TBigIntegerMultOpExpr.InitOpFunc;
882
begin
883
   FOpFunc := mpz_mul;
884
end;
885

886
// ------------------
887
// ------------------ TBigIntegerDivOpExpr ------------------
888
// ------------------
889

890
procedure TBigIntegerDivOpExpr.InitOpFunc;
891
begin
892
   FOpFunc := mpz_tdiv_q
893
end;
894

895
// ------------------
896
// ------------------ TBigIntegerModOpExpr ------------------
897
// ------------------
898

899
procedure TBigIntegerModOpExpr.InitOpFunc;
900
begin
901
   FOpFunc := mpz_mod;
902
end;
903

904
// ------------------
905
// ------------------ TBigIntegerAndOpExpr ------------------
906
// ------------------
907

908
procedure TBigIntegerAndOpExpr.InitOpFunc;
909
begin
910
   FOpFunc := mpz_and;
911
end;
912

913
// ------------------
914
// ------------------ TBigIntegerOrOpExpr ------------------
915
// ------------------
916

917
procedure TBigIntegerOrOpExpr.InitOpFunc;
918
begin
919
   FOpFunc := mpz_ior;
920
end;
921

922
// ------------------
923
// ------------------ TBigIntegerXorOpExpr ------------------
924
// ------------------
925

926
procedure TBigIntegerXorOpExpr.InitOpFunc;
927
begin
928
   FOpFunc := mpz_xor;
929
end;
930

931
// ------------------
932
// ------------------ TBigIntegerRelOpExpr ------------------
933
// ------------------
934

935
function TBigIntegerRelOpExpr.InternalCompare(exec : TdwsExecution) : Integer;
936
begin
937
   Result := mpz_cmp(Left.EvalAsBigInteger(exec).Value^, Right.EvalAsBigInteger(exec).Value^);
938
end;
939

940
// ------------------
941
// ------------------ TBigIntegerEqualOpExpr ------------------
942
// ------------------
943

944
function TBigIntegerEqualOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
945
begin
946
   Result := InternalCompare(exec) = 0;
947
end;
948

949
// ------------------
950
// ------------------ TBigIntegerNotEqualOpExpr ------------------
951
// ------------------
952

953
function TBigIntegerNotEqualOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
954
begin
955
   Result := InternalCompare(exec) <> 0;
956
end;
957

958
// ------------------
959
// ------------------ TBigIntegerGreaterOpExpr ------------------
960
// ------------------
961

962
function TBigIntegerGreaterOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
963
begin
964
   Result := InternalCompare(exec) > 0;
965
end;
966

967
// ------------------
968
// ------------------ TBigIntegerGreaterEqualOpExpr ------------------
969
// ------------------
970

971
function TBigIntegerGreaterEqualOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
972
begin
973
   Result := InternalCompare(exec) >= 0;
974
end;
975

976
// ------------------
977
// ------------------ TBigIntegerLessOpExpr ------------------
978
// ------------------
979

980
function TBigIntegerLessOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
981
begin
982
   Result := InternalCompare(exec) < 0;
983
end;
984

985
// ------------------
986
// ------------------ TBigIntegerLessEqualOpExpr ------------------
987
// ------------------
988

989
function TBigIntegerLessEqualOpExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean;
990
begin
991
   Result := InternalCompare(exec) <= 0;
992
end;
993

994
// ------------------
995
// ------------------ TBigIntegerUnaryOpExpr ------------------
996
// ------------------
997

998
constructor TBigIntegerUnaryOpExpr.Create(context : TdwsBaseSymbolsContext; const aScriptPos : TScriptPos; expr : TTypedExpr);
999
begin
1000
   inherited Create(context, aScriptPos, expr);
1001
   Typ := context.FindType(SYS_BIGINTEGER);
1002
end;
1003

1004
procedure TBigIntegerUnaryOpExpr.EvalAsVariant(exec : TdwsExecution; var result : Variant);
1005
var
1006
   intf : IUnknown;
1007
begin
1008
   EvalAsInterface(exec, intf);
1009
   result := intf;
1010
end;
1011

1012
// ------------------
1013
// ------------------ TConvIntegerToBigIntegerExpr ------------------
1014
// ------------------
1015

1016
procedure TConvIntegerToBigIntegerExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
1017
begin
1018
   result := TBigIntegerWrapper.CreateInt64( Expr.EvalAsInteger(exec) ) as IdwsBigInteger;
1019
end;
1020
// ------------------
1021
// ------------------ TConvStringToBigIntegerExpr ------------------
1022
// ------------------
1023

1024
procedure TConvStringToBigIntegerExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
1025
var
1026
   s : String;
1027
begin
1028
   Expr.EvalAsString(exec, s);
1029
   result := TBigIntegerWrapper.CreateString( s, 10 ) as IdwsBigInteger;
1030
end;
1031

1032
// ------------------
1033
// ------------------ TConvFloatToBigIntegerExpr ------------------
1034
// ------------------
1035

1036
// EvalAsInterface
1037
//
1038
procedure TConvFloatToBigIntegerExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
1039
begin
1040
   Result := TBigIntegerWrapper.CreateFloat(Expr.EvalAsFloat(exec)) as IdwsBigInteger;
1041
end;
1042

1043
// ------------------
1044
// ------------------ TConvBigIntegerToIntegerExpr ------------------
1045
// ------------------
1046

1047
function TConvBigIntegerToIntegerExpr.EvalAsInteger(exec : TdwsExecution) : Int64;
1048
begin
1049
   Result := Expr.EvalAsBigInteger(exec).ToInt64;
1050
end;
1051

1052
// ------------------
1053
// ------------------ TConvBigIntegerToFloatExpr ------------------
1054
// ------------------
1055

1056
function TConvBigIntegerToFloatExpr.EvalAsFloat(exec : TdwsExecution) : Double;
1057
begin
1058
   Result := mpz_get_d(Expr.EvalAsBigInteger(exec).Value^);
1059
end;
1060

1061
// ------------------
1062
// ------------------ TBigIntegerToStringFunc ------------------
1063
// ------------------
1064

1065
// DoEvalAsString
1066
//
1067
procedure TBigIntegerToStringFunc.DoEvalAsString(const args : TExprBaseListExec; var Result : String);
1068
begin
1069
   Result := ArgBigInteger(args, 0).ToStringBase(args.AsInteger[1]);
1070
end;
1071

1072
// ------------------
1073
// ------------------ TStringToBigIntegerFunc ------------------
1074
// ------------------
1075

1076
// DoEvalAsVariant
1077
//
1078
procedure TStringToBigIntegerFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1079
begin
1080
   result := TBigIntegerWrapper.CreateString( args.AsString[0], args.AsInteger[1] ) as IdwsBigInteger;
1081
end;
1082

1083
// ------------------
1084
// ------------------ TBigIntegerToHexFunc ------------------
1085
// ------------------
1086

1087
// DoEvalAsString
1088
//
1089
procedure TBigIntegerToHexFunc.DoEvalAsString(const args : TExprBaseListExec; var Result : String);
1090
begin
1091
   Result := ArgBigInteger(args, 0).ToStringBase(16);
1092
end;
1093

1094
// ------------------
1095
// ------------------ THexToBigIntegerFunc ------------------
1096
// ------------------
1097

1098
// DoEvalAsVariant
1099
//
1100
procedure THexToBigIntegerFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1101
begin
1102
   result := TBigIntegerWrapper.CreateString( args.AsString[0], 16 ) as IdwsBigInteger;
1103
end;
1104

1105
// ------------------
1106
// ------------------ TBigIntegerToFloatFunc ------------------
1107
// ------------------
1108

1109
procedure TBigIntegerToFloatFunc.DoEvalAsFloat(const args : TExprBaseListExec; var result : Double);
1110
begin
1111
   result := mpz_get_d(ArgBigInteger(args, 0).Value^);
1112
end;
1113

1114
// ------------------
1115
// ------------------ TBigIntegerToIntegerFunc ------------------
1116
// ------------------
1117

1118
function TBigIntegerToIntegerFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1119
begin
1120
   Result := ArgBigInteger(args, 0).ToInt64;
1121
end;
1122

1123
// ------------------
1124
// ------------------ TBigIntegerOddFunc ------------------
1125
// ------------------
1126

1127
function TBigIntegerOddFunc.DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean;
1128
begin
1129
   Result := mpz_odd_p(ArgBigInteger(args, 0).Value^);
1130
end;
1131

1132
// ------------------
1133
// ------------------ TBigIntegerEvenFunc ------------------
1134
// ------------------
1135

1136
function TBigIntegerEvenFunc.DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean;
1137
begin
1138
   Result := mpz_even_p(ArgBigInteger(args, 0).Value^);
1139
end;
1140

1141
// ------------------
1142
// ------------------ TBigIntegerSignFunc ------------------
1143
// ------------------
1144

1145
function TBigIntegerSignFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1146
begin
1147
   Result := ArgBigInteger(args, 0).Sign;
1148
end;
1149

1150
// ------------------
1151
// ------------------ TBigIntegerAbsFunc ------------------
1152
// ------------------
1153

1154
procedure TBigIntegerAbsFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1155
var
1156
   bi : TBigIntegerWrapper;
1157
begin
1158
   bi := TBigIntegerWrapper.CreateZero;
1159
   bi.SetValue(ArgBigInteger(args, 0).Value);
1160
   bi.Value.mp_size := Abs(bi.Value.mp_size);
1161
   result := bi as IdwsBigInteger;
1162
end;
1163

1164
// ------------------
1165
// ------------------ TBigIntegerGcdFunc ------------------
1166
// ------------------
1167

1168
procedure TBigIntegerGcdFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1169
var
1170
   bi : TBigIntegerWrapper;
1171
begin
1172
   bi := TBigIntegerWrapper.CreateZero;
1173
   mpz_gcd(bi.Value, ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1174
   result := bi as IdwsBigInteger;
1175
end;
1176

1177
// ------------------
1178
// ------------------ TBigIntegerLcmFunc ------------------
1179
// ------------------
1180

1181
procedure TBigIntegerLcmFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1182
var
1183
   bi : TBigIntegerWrapper;
1184
begin
1185
   bi := TBigIntegerWrapper.CreateZero;
1186
   mpz_lcm(bi.Value, ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1187
   result := bi as IdwsBigInteger;
1188
end;
1189

1190
// ------------------
1191
// ------------------ TBigIntegerIsPrimeFunc ------------------
1192
// ------------------
1193

1194
function TBigIntegerIsPrimeFunc.DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean;
1195
var
1196
   state : gmp_randstate_t;
1197
begin
1198
   gmp_randinit_mt(state);
1199
   try
1200
      Result := mpz_probable_prime_p(ArgBigInteger(args, 0).Value^, state, args.AsInteger[1], 0) > 0;
1201
   finally
1202
      gmp_randclear(state);
1203
   end;
1204
end;
1205

1206
// ------------------
1207
// ------------------ TBigIntegerNextPrimeFunc ------------------
1208
// ------------------
1209

1210
procedure TBigIntegerNextPrimeFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1211
var
1212
   base : IdwsBigInteger;
1213
   bi : TBigIntegerWrapper;
1214
   state : gmp_randstate_t;
1215
   reps : Integer;
1216
begin
1217
   base := ArgBigInteger(args, 0);
1218
   reps := args.AsInteger[1];
1219

1220
   bi := TBigIntegerWrapper.CreateZero;
1221
   result := bi as IdwsBigInteger;
1222

1223
   if base.Value.mp_size <= 0 then begin
1224
      mpz_set_ui(bi.Value, 1);
1225
      Exit;
1226
   end;
1227

1228
   if mpz_even_p(base.Value^) then
1229
      mpz_add_ui(bi.Value, base.Value^, 1)
1230
   else mpz_add_ui(bi.Value, base.Value^, 2);
1231

1232
   gmp_randinit_mt(state);
1233
   try
1234
      while mpz_probable_prime_p(bi.Value, state, reps, 0) <= 0 do begin
1235
         if args.Exec.ProgramState = psRunningStopped then
1236
            raise Exception.Create('NextPrime aborted');
1237
         mpz_add_ui(bi.Value, bi.Value, 2);
1238
      end;
1239
   finally
1240
      gmp_randclear(state);
1241
   end;
1242
end;
1243

1244
// ------------------
1245
// ------------------ TBigIntegerPowerFunc ------------------
1246
// ------------------
1247

1248
procedure TBigIntegerPowerFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1249
var
1250
   bi : TBigIntegerWrapper;
1251
begin
1252
   bi := TBigIntegerWrapper.CreateZero;
1253
   mpz_pow_ui(bi.Value, ArgBigInteger(args, 0).Value^, args.AsInteger[1]);
1254
   result := bi as IdwsBigInteger;
1255
end;
1256

1257
// ------------------
1258
// ------------------ TBigIntegerSqrFunc ------------------
1259
// ------------------
1260

1261
procedure TBigIntegerSqrFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1262
var
1263
   bi : TBigIntegerWrapper;
1264
begin
1265
   bi := TBigIntegerWrapper.CreateZero;
1266
   mpz_pow_ui(bi.Value, ArgBigInteger(args, 0).Value^, 2);
1267
   result := bi as IdwsBigInteger;
1268
end;
1269

1270
// ------------------
1271
// ------------------ TBigIntegerDivModFunc ------------------
1272
// ------------------
1273

1274
procedure TBigIntegerDivModFunc.DoEvalProc(const args : TExprBaseListExec);
1275
var
1276
   biQ, biR : TBigIntegerWrapper;
1277
begin
1278
   biQ := TBigIntegerWrapper.CreateZero;
1279
   biR := TBigIntegerWrapper.CreateZero;
1280

1281
   mpz_tdiv_qr(biQ.Value, biR.Value, ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1282

1283
   args.ExprBase[2].AssignValue(args.Exec, biQ as IdwsBigInteger);
1284
   args.ExprBase[3].AssignValue(args.Exec, biR as IdwsBigInteger);
1285
end;
1286

1287
// ------------------
1288
// ------------------ TBigIntegerToBlobFunc ------------------
1289
// ------------------
1290

1291
procedure TBigIntegerToBlobFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1292
var
1293
   bufString : RawByteString;
1294
   pDest, pSrc : PByte;
1295
   n : Integer;
1296
   gmp : pmpz_t;
1297
begin
1298
   gmp := ArgBigInteger(args, 0).Value;
1299
   n := Abs(gmp.mp_size);
1300
   if n = 0 then
1301
      bufString := ''
1302
   else begin
1303
      SetLength(bufString, n*cLimbSize+1);
1304
      pDest := Pointer(bufString);
1305
      if gmp.mp_size < 0 then begin
1306
         pDest^ := $ff;
1307
         Inc(pDest);
1308
      end;
1309
      pSrc := @PLimbArray(gmp.mp_d)^[n-1];
1310
      Inc(pSrc, cLimbSize-1);
1311
      // skip zeroes
1312
      while pSrc^ = 0 do begin
1313
         Dec(pSrc);
1314
         if pSrc = PByte(gmp.mp_d) then break;
1315
      end;
1316
      if (pSrc^ = $ff) and (gmp.mp_size > 0) then begin
1317
         pDest^ := $00;
1318
         Inc(pDest);
1319
      end;
1320
      repeat
1321
         pDest^ := pSrc^;
1322
         Dec(pSrc);
1323
         Inc(pDest);
1324
      until NativeUInt(pSrc) < NativeUInt(gmp.mp_d);
1325
      SetLength(bufString, NativeUInt(pDest)-NativeUInt(Pointer(bufString)));
1326
   end;
1327
   Result := bufString;
1328
end;
1329

1330
// ------------------
1331
// ------------------ TBlobToBigIntegerFunc ------------------
1332
// ------------------
1333

1334
// DoEvalAsInterface
1335
//
1336
procedure TBlobToBigIntegerFunc.DoEvalAsInterface(const args : TExprBaseListExec; var result : IUnknown);
1337
var
1338
   bi : TBigIntegerWrapper;
1339
   bufString : RawByteString;
1340
   nbBytes, nbLimbs : Integer;
1341
   pSrc, pDest : PByte;
1342
   i : Integer;
1343
begin
1344
   bi := TBigIntegerWrapper.CreateZero;
1345

1346
   bufString := args.AsDataString[0];
1347
   if bufString <> '' then begin
1348

1349
      nbBytes := Length(bufString);
1350
      pSrc := Pointer(bufString);
1351
      case Ord(bufString[1]) of
1352
         $00, $ff : begin
1353
            Inc(pSrc);
1354
            Dec(nbBytes);
1355
         end
1356
      end;
1357

1358
      nbLimbs := (nbBytes+cLimbSize-1) div cLimbSize;
1359
      mpz_realloc(bi.Value, nbLimbs);
1360
      if Ord(bufString[1]) = $ff then
1361
         bi.Value.mp_size := -nbLimbs
1362
      else bi.Value.mp_size := nbLimbs;
1363

1364
      PLimbArray(bi.Value.mp_d)[nbLimbs-1] := 0;
1365
      pDest := @PByteArray(bi.Value.mp_d)[nbBytes-1];
1366
      for i := 1 to nbBytes do begin
1367
         pDest^ := pSrc^;
1368
         Dec(pDest);
1369
         Inc(pSrc);
1370
      end;
1371

1372
   end;
1373

1374
   Result := bi as IdwsBigInteger;
1375
end;
1376

1377
// ------------------
1378
// ------------------ TBigIntegerShiftLeftExpr ------------------
1379
// ------------------
1380

1381
procedure TBigIntegerShiftLeftExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
1382
var
1383
   bi : TBigIntegerWrapper;
1384
begin
1385
   bi := TBigIntegerWrapper.CreateZero;
1386
   mpz_mul_2exp(bi.Value, Left.EvalAsBigInteger(exec).Value^, Right.EvalAsInteger(exec));
1387
   result := bi as IdwsBigInteger;
1388
end;
1389

1390
// ------------------
1391
// ------------------ TBigIntegerShiftRightExpr ------------------
1392
// ------------------
1393

1394
procedure TBigIntegerShiftRightExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown);
1395
var
1396
   bi : TBigIntegerWrapper;
1397
begin
1398
   bi := TBigIntegerWrapper.CreateZero;
1399
   mpz_tdiv_q_2exp(bi.Value, Left.EvalAsBigInteger(exec).Value^, Right.EvalAsInteger(exec));
1400
   result := bi as IdwsBigInteger;
1401
end;
1402

1403
// ------------------
1404
// ------------------ TBigIntegerOpAssignExpr ------------------
1405
// ------------------
1406

1407
procedure TBigIntegerOpAssignExpr.TypeCheckAssign(context : TdwsCompilerContext);
1408
begin
1409
   // nothing here
1410
end;
1411

1412
// ------------------
1413
// ------------------ TBigIntegerPlusAssignExpr ------------------
1414
// ------------------
1415

1416
procedure TBigIntegerPlusAssignExpr.EvalNoResult(exec : TdwsExecution);
1417
var
1418
   bi : TBigIntegerWrapper;
1419
begin
1420
   bi := TBigIntegerWrapper.CreateZero;
1421
   mpz_add(bi.Value, Left.EvalAsBigInteger(exec).Value^, Right.EvalAsBigInteger(exec).Value^);
1422
   FLeft.AssignValue(exec, bi as IdwsBigInteger);
1423
end;
1424

1425
// ------------------
1426
// ------------------ TBigIntegerPlusAssignIntExpr ------------------
1427
// ------------------
1428

1429
procedure TBigIntegerPlusAssignIntExpr.EvalNoResult(exec : TdwsExecution);
1430
var
1431
   bi : TBigIntegerWrapper;
1432
begin
1433
   bi := TBigIntegerWrapper.CreateInt64(Right.EvalAsInteger(exec));
1434
   mpz_add(bi.Value, bi.Value, Left.EvalAsBigInteger(exec).Value^);
1435
   FLeft.AssignValue(exec, bi as IdwsBigInteger);
1436
end;
1437

1438
// ------------------
1439
// ------------------ TBigIntegerMinusAssignExpr ------------------
1440
// ------------------
1441

1442
procedure TBigIntegerMinusAssignExpr.EvalNoResult(exec : TdwsExecution);
1443
var
1444
   bi : TBigIntegerWrapper;
1445
begin
1446
   bi := TBigIntegerWrapper.CreateZero;
1447
   mpz_sub(bi.Value, Left.EvalAsBigInteger(exec).Value^, Right.EvalAsBigInteger(exec).Value^);
1448
   FLeft.AssignValue(exec, bi as IdwsBigInteger);
1449
end;
1450

1451
// ------------------
1452
// ------------------ TBigIntegerMinusAssignIntExpr ------------------
1453
// ------------------
1454

1455
procedure TBigIntegerMinusAssignIntExpr.EvalNoResult(exec : TdwsExecution);
1456
var
1457
   bi : TBigIntegerWrapper;
1458
begin
1459
   bi := TBigIntegerWrapper.CreateInt64(Right.EvalAsInteger(exec));
1460
   mpz_sub(bi.Value, Left.EvalAsBigInteger(exec).Value^, bi.Value);
1461
   FLeft.AssignValue(exec, bi as IdwsBigInteger);
1462
end;
1463

1464
// ------------------
1465
// ------------------ TBigIntegerMultAssignExpr ------------------
1466
// ------------------
1467

1468
procedure TBigIntegerMultAssignExpr.EvalNoResult(exec : TdwsExecution);
1469
var
1470
   bi : TBigIntegerWrapper;
1471
begin
1472
   bi := TBigIntegerWrapper.CreateZero;
1473
   mpz_mul(bi.Value, Left.EvalAsBigInteger(exec).Value^, Right.EvalAsBigInteger(exec).Value^);
1474
   FLeft.AssignValue(exec, bi as IdwsBigInteger);
1475
end;
1476

1477
// ------------------
1478
// ------------------ TBigIntegerRandomFunc ------------------
1479
// ------------------
1480

1481
// DoEvalAsVariant
1482
//
1483
procedure TBigIntegerRandomFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1484

1485
   function RandomBigIntegerOfBitLength(nb : Integer) : IdwsBigInteger;
1486
   var
1487
      mask : Integer;
1488
      bytes : TBytes;
1489
      bi : TBigIntegerWrapper;
1490
   begin
1491
      Assert(nb > 0);
1492

1493
      // adapted from BigInteger.Create(NumBits: Integer; const Random: IRandom)
1494
      // uses cryptographic random
1495
      bytes := RawByteStringToBytes(CryptographicRandom( (nb + 7) div 8 + 1 ));
1496

1497
      // One byte too many was allocated, to get a top byte of 0, i.e. always positive.
1498
      bytes[High(bytes)] := 0;
1499

1500
      // Set bits above required bit length to 0.
1501
      mask := $7F shr (7 - (nb and 7));
1502
      bytes[High(bytes)-1] := bytes[High(bytes)-1] and mask;
1503

1504
      bi := TBigIntegerWrapper.CreateZero;
1505
      mpz_realloc(bi.Value, (nb div (8*cLimbSize))+1);
1506
      FillChar(bi.Value.mp_d^, bi.Value.mp_alloc*cLimbSize, 0);
1507
      bi.Value.mp_size := bi.Value.mp_alloc;
1508
      System.Move(bytes[0], bi.Value.mp_d^, Length(bytes));
1509

1510
      Result := bi as IdwsBigInteger;
1511
   end;
1512

1513
var
1514
   bi, limit : IdwsBigInteger;
1515
   bits : Integer;
1516
begin
1517
   limit := ArgBigInteger(args, 0);
1518
   if mpz_cmp_ui(limit.Value^, 1) <= 0 then begin
1519
      result := TBigIntegerWrapper.CreateZero as IdwsBigInteger;
1520
   end else begin
1521
      bits := limit.BitLength;
1522
      repeat
1523
         bi := RandomBigIntegerOfBitLength(bits);
1524
      until mpz_cmp(bi.Value^, limit.Value^) < 0;
1525
   end;
1526
   result := bi;
1527
end;
1528

1529
// ------------------
1530
// ------------------ TBigIntegerBitLengthFunc ------------------
1531
// ------------------
1532

1533
function TBigIntegerBitLengthFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1534
begin
1535
   Result := ArgBigInteger(args, 0).BitLength;
1536
end;
1537

1538
// ------------------
1539
// ------------------ TBigIntegerTestBitFunc ------------------
1540
// ------------------
1541

1542
// DoEvalAsBoolean
1543
//
1544
function TBigIntegerTestBitFunc.DoEvalAsBoolean(const args : TExprBaseListExec) : Boolean;
1545
begin
1546
   Result := mpz_tstbit(ArgBigInteger(args, 0).Value^, Cardinal(args.AsInteger[1])) <> 0;
1547
end;
1548

1549
// ------------------
1550
// ------------------ TBigIntegerSetBitFunc ------------------
1551
// ------------------
1552

1553
// DoEvalProc
1554
//
1555
procedure TBigIntegerSetBitFunc.DoEvalProc(const args : TExprBaseListExec);
1556
begin
1557
   mpz_setbit(ArgVarBigInteger(args, 0).Value^, Cardinal(args.AsInteger[1]));
1558
end;
1559

1560
// ------------------
1561
// ------------------ TBigIntegerSetBitValFunc ------------------
1562
// ------------------
1563

1564
// DoEvalProc
1565
//
1566
procedure TBigIntegerSetBitValFunc.DoEvalProc(const args : TExprBaseListExec);
1567
var
1568
   bi : IdwsBigInteger;
1569
   bit : Integer;
1570
begin
1571
   bi := ArgVarBigInteger(args, 0);
1572
   bit := args.AsInteger[1];
1573
   if args.AsBoolean[2] then
1574
      mpz_setbit(bi.Value^, bit)
1575
   else mpz_clrbit(bi.Value^, bit)
1576
end;
1577

1578
// ------------------
1579
// ------------------ TBigIntegerClearBitFunc ------------------
1580
// ------------------
1581

1582
// DoEvalProc
1583
//
1584
procedure TBigIntegerClearBitFunc.DoEvalProc(const args : TExprBaseListExec);
1585
begin
1586
   mpz_clrbit(ArgVarBigInteger(args, 0).Value^, args.AsInteger[1]);
1587
end;
1588

1589
// ------------------
1590
// ------------------ TBigIntegerPopCountFunc ------------------
1591
// ------------------
1592

1593
function TBigIntegerPopCountFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1594
begin
1595
   Result := ArgBigInteger(args, 0).PopCount;
1596
end;
1597

1598
// ------------------
1599
// ------------------ TBigIntegerModPowFunc ------------------
1600
// ------------------
1601

1602
procedure TBigIntegerModPowFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1603
var
1604
   bi : TBigIntegerWrapper;
1605
begin
1606
   bi := TBigIntegerWrapper.CreateZero;
1607
   Result := bi as IdwsBigInteger;
1608
   mpz_powm(bi.Value,
1609
            ArgBigInteger(args, 0).Value^,
1610
            ArgBigInteger(args, 1).Value^,
1611
            ArgBigInteger(args, 2).Value^);
1612
end;
1613

1614
// ------------------
1615
// ------------------ TBigIntegerModInvFunc ------------------
1616
// ------------------
1617

1618
// DoEvalAsVariant
1619
//
1620
procedure TBigIntegerModInvFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1621
var
1622
   bi : TBigIntegerWrapper;
1623
begin
1624
   bi := TBigIntegerWrapper.CreateZero;
1625
   Result := bi as IdwsBigInteger;
1626
   mpz_invert(bi.Value, ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1627
end;
1628

1629
// ------------------
1630
// ------------------ TBigIntegerFactorialFunc ------------------
1631
// ------------------
1632

1633
procedure TBigIntegerFactorialFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1634
var
1635
   bi : TBigIntegerWrapper;
1636
   i : Int64;
1637
begin
1638
   i := args.AsInteger[0];
1639
   bi := TBigIntegerWrapper.CreateZero;
1640
   if i <= 1 then
1641
      mpz_set_uint64(bi.Value, 1)
1642
   else mpz_fac_ui(bi.Value, i);
1643
   Result := bi as IdwsBigInteger;
1644
end;
1645

1646
// ------------------
1647
// ------------------ TBigIntegerPrimorialFunc ------------------
1648
// ------------------
1649

1650
procedure TBigIntegerPrimorialFunc.DoEvalAsVariant(const args : TExprBaseListExec; var result : Variant);
1651
var
1652
   bi : TBigIntegerWrapper;
1653
   i : Int64;
1654
begin
1655
   i := args.AsInteger[0];
1656
   bi := TBigIntegerWrapper.CreateZero;
1657
   if i < 1 then
1658
      mpz_set_uint64(bi.Value, 1)
1659
   else mpz_primorial_ui(bi.Value, i);
1660
   Result := bi as IdwsBigInteger;
1661
end;
1662

1663
// ------------------
1664
// ------------------ TBigJacobiFunc ------------------
1665
// ------------------
1666

1667
function TBigJacobiFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1668
begin
1669
   Result := mpz_jacobi(ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1670
end;
1671

1672
// ------------------
1673
// ------------------ TBigLegendreFunc ------------------
1674
// ------------------
1675

1676
function TBigLegendreFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
1677
begin
1678
   Result := mpz_legendre(ArgBigInteger(args, 0).Value^, ArgBigInteger(args, 1).Value^);
1679
end;
1680

1681
// ------------------------------------------------------------------
1682
// ------------------------------------------------------------------
1683
// ------------------------------------------------------------------
1684
initialization
1685
// ------------------------------------------------------------------
1686
// ------------------------------------------------------------------
1687
// ------------------------------------------------------------------
1688

1689
   vPool := TdwsBigIntegerWrapperPool.Create;
1690

1691
   dwsInternalUnit.AddSymbolsRegistrationProc(RegisterBigIntegerType);
1692
   dwsInternalUnit.AddOperatorsRegistrationProc(RegisterBigIntegerOperators);
1693

1694
   RegisterInternalStringFunction(TBigIntegerToStringFunc,  'BigIntegerToString', ['v', SYS_BIGINTEGER, 'base=10', SYS_INTEGER], [iffStateLess], 'ToString');
1695
   RegisterInternalFunction(TStringToBigIntegerFunc,        'StringToBigInteger', ['s', SYS_STRING, 'base=10', SYS_INTEGER], SYS_BIGINTEGER, [iffStateLess], 'ToBigInteger');
1696
   RegisterInternalStringFunction(TBigIntegerToHexFunc,     'BigIntegerToHex', ['v', SYS_BIGINTEGER], [iffStateLess], 'ToHex');
1697
   RegisterInternalFunction(THexToBigIntegerFunc,           'HexToBigInteger', ['h', SYS_STRING], SYS_BIGINTEGER, [iffStateLess], 'HexToBigInteger');
1698

1699
   RegisterInternalFunction(TBigIntegerToBlobFunc,          'BigIntegerToBlobParameter', ['v', SYS_BIGINTEGER], SYS_VARIANT, [iffStateLess], 'ToBlobParameter');
1700
   RegisterInternalInterfaceFunction(TBlobToBigIntegerFunc, 'BlobFieldToBigInteger', ['b', SYS_STRING], SYS_BIGINTEGER, [iffStateLess]);
1701

1702
   RegisterInternalFloatFunction(TBigIntegerToFloatFunc,    '',   ['v', SYS_BIGINTEGER], [iffStateLess], 'ToFloat');
1703
   RegisterInternalIntFunction(TBigIntegerToIntegerFunc,    '',   ['v', SYS_BIGINTEGER], [iffStateLess], 'ToInteger');
1704

1705

1706
   RegisterInternalBoolFunction(TBigIntegerOddFunc,   'Odd',      ['i', SYS_BIGINTEGER], [iffStateLess, iffOverloaded], 'IsOdd');
1707
   RegisterInternalBoolFunction(TBigIntegerEvenFunc,  'Even',     ['i', SYS_BIGINTEGER], [iffStateLess, iffOverloaded], 'IsEven');
1708
   RegisterInternalIntFunction(TBigIntegerSignFunc,   'Sign',     ['v', SYS_BIGINTEGER], [iffStateLess, iffOverloaded], 'Sign');
1709
   RegisterInternalFunction(TBigIntegerAbsFunc,       'Abs',      ['v', SYS_BIGINTEGER], SYS_BIGINTEGER, [iffStateLess, iffOverloaded], 'Abs');
1710

1711
   RegisterInternalIntFunction(TBigIntegerBitLengthFunc,  '',     ['v', SYS_BIGINTEGER], [iffStateLess], 'BitLength');
1712
   RegisterInternalBoolFunction(TBigIntegerTestBitFunc,   '',     ['i', SYS_BIGINTEGER, 'bit', SYS_INTEGER], [iffStateLess], 'TestBit');
1713
   RegisterInternalProcedure(TBigIntegerSetBitFunc,       '',     ['@i', SYS_BIGINTEGER, 'bit', SYS_INTEGER], 'SetBit', [iffOverloaded]);
1714
   RegisterInternalProcedure(TBigIntegerSetBitValFunc,    '',     ['@i', SYS_BIGINTEGER, 'bit', SYS_INTEGER, 'v', SYS_BOOLEAN], 'SetBit', [iffOverloaded]);
1715
   RegisterInternalProcedure(TBigIntegerClearBitFunc,     '',     ['@i', SYS_BIGINTEGER, 'bit', SYS_INTEGER], 'ClearBit', []);
1716
   RegisterInternalIntFunction(TBigIntegerPopCountFunc,   '',     ['i', SYS_BIGINTEGER], [iffStateLess], 'PopCount');
1717

1718
   RegisterInternalFunction(TBigIntegerGcdFunc,        'Gcd',     ['a', SYS_BIGINTEGER, 'b', SYS_BIGINTEGER], SYS_BIGINTEGER, [iffStateLess, iffOverloaded]);
1719
   RegisterInternalFunction(TBigIntegerLcmFunc,        'Lcm',     ['a', SYS_BIGINTEGER, 'b', SYS_BIGINTEGER], SYS_BIGINTEGER, [iffStateLess, iffOverloaded]);
1720
   RegisterInternalBoolFunction(TBigIntegerIsPrimeFunc, 'IsPrime',['n', SYS_BIGINTEGER, 'prob=25', SYS_INTEGER], [iffStateLess, iffOverloaded], 'IsPrime');
1721
   RegisterInternalFunction(TBigIntegerNextPrimeFunc,     '',     ['n', SYS_BIGINTEGER, 'prob=25', SYS_INTEGER], SYS_BIGINTEGER, [iffStateLess], 'NextPrime');
1722

1723
   RegisterInternalFunction(TBigIntegerPowerFunc,     'IntPower', ['base', SYS_BIGINTEGER, 'exponent', SYS_INTEGER], SYS_BIGINTEGER, [iffStateLess, iffOverloaded], 'Power');
1724
   RegisterInternalFunction(TBigIntegerSqrFunc,       'Sqr',      ['v', SYS_BIGINTEGER], SYS_BIGINTEGER, [iffStateLess, iffOverloaded], 'Sqr');
1725
   RegisterInternalProcedure(TBigIntegerDivModFunc,   'DivMod',
1726
                             ['dividend', SYS_BIGINTEGER, 'divisor', SYS_BIGINTEGER,
1727
                              '@result', SYS_BIGINTEGER, '@remainder', SYS_BIGINTEGER], '', [iffOverloaded]);
1728
   RegisterInternalFunction(TBigIntegerModPowFunc,    'ModPow',   ['base', SYS_BIGINTEGER, 'exponent', SYS_BIGINTEGER, 'modulus', SYS_BIGINTEGER],
1729
                                                                  SYS_BIGINTEGER, [iffStateLess, iffOverloaded], 'ModPow');
1730
   RegisterInternalFunction(TBigIntegerModPowFunc,    'ModPow',   ['base', SYS_BIGINTEGER, 'exponent', SYS_INTEGER, 'modulus', SYS_BIGINTEGER],
1731
                                                                  SYS_BIGINTEGER, [iffStateLess, iffOverloaded], 'ModPow');
1732
   RegisterInternalFunction(TBigIntegerModInvFunc,    'ModInv',   ['base', SYS_BIGINTEGER, 'modulus', SYS_BIGINTEGER],
1733
                                                                  SYS_BIGINTEGER, [iffStateLess], 'ModInv');
1734
   RegisterInternalFunction(TBigIntegerFactorialFunc, 'BigFactorial', ['n', SYS_INTEGER], SYS_BIGINTEGER, [iffStateLess]);
1735
   RegisterInternalFunction(TBigIntegerPrimorialFunc, 'BigPrimorial', ['n', SYS_INTEGER], SYS_BIGINTEGER, [iffStateLess]);
1736

1737
   RegisterInternalIntFunction(TBigJacobiFunc,        'BigJacobi', ['a', SYS_BIGINTEGER, 'b', SYS_BIGINTEGER], [iffStateLess], 'Jacobi');
1738
   RegisterInternalIntFunction(TBigLegendreFunc,      'BigLegendre', ['a', SYS_BIGINTEGER, 'b', SYS_BIGINTEGER], [iffStateLess], 'Legendre');
1739

1740
   RegisterInternalFunction(TBigIntegerRandomFunc,    'RandomBigInteger', ['limitPlusOne', SYS_BIGINTEGER], SYS_BIGINTEGER);
1741

1742
finalization
1743

1744
   vPool.Cleanup;
1745
   FreeAndNil(vPool);
1746

1747
end.
1748

1749