MathgeomGLS

1
{----------------------------------------------------------------------------}
2
{                                                                            }
3
{ File:       Velthuis.BigIntegers.pas                                       }
4
{ Function:   A big integer implementation, with critical parts written in   }
5
{             Win32 or Win64 assembler, or "Pure Pascal" for other           }
6
{             platforms, or if explicitly specified.                         }
7
{ Language:   Delphi version XE2 or later                                    }
8
{ Author:     Rudy Velthuis                                                  }
9
{ Copyright:  (c) 2015,2016,2017 Rudy Velthuis                               }
10
{                                                                            }
11
{             For tests, see BigIntegerDevelopmentTests.dproj. The data      }
12
{             for these tests are generated by a C# program, in the          }
13
{             DataGenerators\BigIntegers\BigIntegerTestGenerator             }
14
{             subdirectory, or by a Java program, in the                     }
15
{             DataGenerators\BigIntegers\Java\BigIntegerTestDataGenerator    }
16
{             subdirectory.                                                  }
17
{                                                                            }
18
{ Credits:    Thanks to Peter Cordes, Nils Pipenbrinck and Johan Bontes for  }
19
{             their help on StackOverflow:                                   }
20
{             - http://stackoverflow.com/a/32298732/95954                    }
21
{             - http://stackoverflow.com/a/32087095/95954                    }
22
{             - http://stackoverflow.com/a/32084357/95954                    }
23
{                                                                            }
24
{             Thanks to Agner Fog for his excellent optimization guides.     }
25
{                                                                            }
26
{ Literature: 1. Donald Knuth, "The Art Of Computer Programming", 2nd ed.    }
27
{                Vol I-III.                                                  }
28
{             2. Karl Hasselström,                                           }
29
{                "Fast Division of Large Integers - A Comparison of          }
30
{                 Algorithms"                                                }
31
{                 bioinfo.ict.ac.cn/~dbu/AlgorithmCourses/                   }
32
{                 Lectures/Hasselstrom2003.pdf                               }
33
{             3. Richard P. Brent and Paul Zimmermann,                       }
34
{                "Modern Computer Arithmetic"                                }
35
{                http://arxiv.org/pdf/1004.4710v1.pdf                        }
36
{                https://members.loria.fr/PZimmermann/mca/mca-cup-0.5.9.pdf  }
37
{             4. Christoph Burnikel, Joachim Ziegler                         }
38
{                "Fast Recursive Division"                                   }
39
{                cr.yp.to/bib/1998/burnikel.ps                               }
40
{             5. Hacker's Delight, e.g.                                      }
41
{                http://www.hackersdelight.org/basics2.pdf                   }
42
{             6. Wikipedia                                                   }
43
{                https://en.wikipedia.org                                    }
44
{             7. Rosetta Code                                                }
45
{                http://rosettacode.org/wiki/Rosetta_Code                    }
46
{             8. Michael Malenkov, Christopher J. Dutra, Marco T. Morazán    }
47
{                "A New Bignum Multiplication Algorithm"                     }
48
{                http://prolangs.cs.vt.edu/rutgers/meetings/                 }
49
{                masplas06/papers/2_Malenkov.pdf                             }
50
{                                                                            }
51
{ -------------------------------------------------------------------------- }
52
{                                                                            }
53
{ License:    Redistribution and use in source and binary forms, with or     }
54
{             without modification, are permitted provided that the          }
55
{             following conditions are met:                                  }
56
{                                                                            }
57
{             * Redistributions of source code must retain the above         }
58
{               copyright notices, this list of conditions and the           }
59
{               following disclaimer.                                        }
60
{             * Redistributions in binary form must reproduce the above      }
61
{               copyright notice, this list of conditions and the following  }
62
{               disclaimer in the documentation and/or other materials       }
63
{               provided with the distribution.                              }
64
{                                                                            }
65
{ Disclaimer: THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS"     }
66
{             AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      }
67
{             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND      }
68
{             FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO         }
69
{             EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE      }
70
{             FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,      }
71
{             OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,       }
72
{             PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,      }
73
{             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED     }
74
{             AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT    }
75
{             LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)         }
76
{             ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF    }
77
{             ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.                     }
78
{                                                                            }
79
{----------------------------------------------------------------------------}
80

81
{----------------------------------------------------------------------------}
82
{ Corrections:                                                               }
83
{                                                                            }
84
{   2015-11-28: Changed calls to System.@GetMem in System.AllocMem.          }
85
{               GetMem does not clear memory. This caused occasional bad     }
86
{               results.                                                     }
87
{                                                                            }
88
{   2015-11-29: Changed all references to CPUX86 and CPUX64 to CPU32BITS     }
89
{               and CPU64BITS, respectively. The former are not defined      }
90
{               outside MS Windows.                                          }
91
{                                                                            }
92
{   2016-01-24: Changed internals of DivMod. There could be problems if the  }
93
{               dividend and the quotient were identical.                    }
94
{                                                                            }
95
{   2016-01-24: Changed ToString(Base). The old slow method simply           }
96
{               divided the entire BigInteger by base and added the          }
97
{               remainder as digit, digit by digit.                          }
98
{               This is still available as ToStringClassic, for debugging    }
99
{               purposes. ToStringClassic will be removed later on, if new   }
100
{               methods are secured.                                         }
101
{               The newer methods do either shift (base 2, 4, 16), convert   }
102
{               entire limbs or, for large values, use a divide-and-conquer  }
103
{               algorithm.                                                   }
104
{                                                                            }
105
{   2016-02-02: Changed PUREPASCAL version of InternalDivMod, removing an    }
106
{               obscure, seldom bug that was caused by an uncaught overflow. }
107
{                                                                            }
108
{   2016-02-03: Added operator Explicit(BigInteger): string, which simply    }
109
{               calls ToString to generate the result.                       }
110
{                                                                            }
111
{   2016-08-23: Changed Remainder(... UInt32) and Remainder(... UInt16).     }
112
{               InternalDivMod32 did not return True, and on False,          }
113
{               Remainder gave wrong error message.                          }
114
{                                                                            }
115
{   2016-12-27: Added ModInverse.                                            }
116
{               Optimized and renamed MakeLength to AllocNewMagnitude.       }
117
{                                                                            }
118
{   2016-12-29: Changed return type of Compare() to Integer. Using           }
119
{               TValueSign made inlining several comparison operators        }
120
{               harder, since that required System.Math.                     }
121
{                                                                            }
122
{   2016-12-30: Changed implementation of ModInverse to 20% faster version.  }
123
{                                                                            }
124
{   2017-01-08: Updated Pow to remove trailing bits before exponentiation    }
125
{               and putting them back afterward.                             }
126
{                                                                            }
127
{   2017-01-13: DivModKnuth now eliminates common trailing zero limbs        }
128
{               before attempting the division.                              }
129
{               So $123400000000000000000 div $4560000000000000000 is        }
130
{               performed as $1234 div $456. The mod result is of course     }
131
{               corrected.                                                   }
132
{                                                                            }
133
{   2017-01-15: Reworked SetBit, ClearBit and FlipBit.                       }
134
{                                                                            }
135
{   2017-07-14: Changed all manual aligns to use .ALIGN 16                   }
136
{                                                                            }
137
{   2017-08-17: Removed buffer overflow bugs in InternalMultiplyAndAdd16 and }
138
{               UncheckedDivModKnuth. Also removed bug from                  }
139
{               InternalShiftLeft. All after using FastMM4 in full debug     }
140
{               mode (which adds extra footer bytes to every allocation).    }
141
{                                                                            }
142
{   2017-08-18: Some more buffer overruns (badly dimensioned magnitudes)     }
143
{               removed.                                                     }
144
{                                                                            }
145
{   2017-08-22: Improved speed of Win32 InternalAddPurePascal by using 16    }
146
{               bit additions, removing need for costly carry emulation.     }
147
{                                                                            }
148
{----------------------------------------------------------------------------}
149
{   Newer changes can be read from the GitHub repository:                    }
150
{   https://github.com/rvelthuis/DelphiBigNumbers                            }
151
{----------------------------------------------------------------------------}
152

153
unit Velthuis.BigIntegers;
154

155
{ TODO: modular arithmetic. Modular division and multiplication. Barrett, Montgomery, etc. }
156
{ TODO: Better parsing. Recursive parsing (more or less the reverse of recursive routine for ToString) for normal
157
        bases, shifting for bases 2, 4 and 16. This means that normal bases are parsed BaseInfo.MaxDigits at a time. }
158
{ TODO: InternalMultiply (basecase) Win32: use MMX instead of plain registers? Also remove trailing loop, make 4
159
        completely separate loop+trail parts? }
160
{ TODO: InternalMultiply: consider algorithm by Malenkov et al. In short, this adds columns first, instead of rows. }
161
{ TODO: Check if old NthRoot (binary search) is perhaps better for the relatively small values tested here. It seems
162
        to have become slower. }
163

164
interface
165

166
uses
167
  CompilerAndRTLVersions, Velthuis.RandomNumbers, System.SysUtils, System.Math;
168

169
// --- User settings ---
170

171
//------------------------------------------------------------------------------------------------------------------//
172
// Setting PUREPASCAL forces the use of plain Object Pascal for all routines, i.e. no assembler is used.            //
173
//------------------------------------------------------------------------------------------------------------------//
174

175
  { $DEFINE PUREPASCAL}
176

177

178
//------------------------------------------------------------------------------------------------------------------//
179
// Setting RESETSIZE forces the Compact routine to shrink the dynamic array when that makes sense.                  //
180
// This can slow down code a little.                                                                                //
181
//------------------------------------------------------------------------------------------------------------------//
182

183
  { $DEFINE RESETSIZE}
184

185

186
//------------------------------------------------------------------------------------------------------------------//
187
// If set, none of the public methods modifies the instance it is called upon.                                      //
188
// If necessary, a new instance is returned.                                                                        //
189
//------------------------------------------------------------------------------------------------------------------//
190

191
  {$DEFINE BIGINTEGERIMMUTABLE}
192

193

194
//------------------------------------------------------------------------------------------------------------------//
195
// EXPERIMENTAL is set for code that tries something new without deleting the original code yet.                    //
196
// Undefine it to get the original code.                                                                            //
197
//------------------------------------------------------------------------------------------------------------------//
198

199
  { $DEFINE EXPERIMENTAL}
200

201

202
{$IFDEF BIGINTEGERIMMUTABLE}
203
  {$UNDEF RESETSIZE}
204
{$ENDIF}
205

206
// --- Permanent settings ---
207

208
{$OPTIMIZATION ON}
209
{$STACKFRAMES OFF}
210
{$INLINE ON}
211

212
{$IF CompilerVersion >= CompilerVersionDelphiXE3}
213
  {$LEGACYIFEND ON}
214
{$IFEND}
215

216
{$IF CompilerVersion >= CompilerVersionDelphiXE}
217
  {$CODEALIGN 16}
218
  {$ALIGN 16}
219
{$IFEND}
220

221
{$IF CompilerVersion < CompilerVersionDelphiXE8}
222
  {$IF (DEFINED(WIN32) OR DEFINED(CPUX86)) AND NOT DEFINED(CPU32BITS)}
223
    {$DEFINE CPU32BITS}
224
  {$IFEND}
225
  {$IF (DEFINED(WIN64) OR DEFINED(CPUX64)) AND NOT DEFINED(CPU64BITS)}
226
    {$DEFINE CPU64BITS}
227
  {$IFEND}
228
{$IFEND}
229

230
{$IF SizeOf(Extended) > SizeOf(Double)}
231
  {$DEFINE HasExtended}
232
{$IFEND}
233

234
{$IF NOT DECLARED(PAnsiChar)}
235
  {$DEFINE NoAnsi}
236
{$IFEND}
237

238
// Assembler is only supplied for Windows targets. For other targets, PUREPASCAL must be defined.
239
{$IF not defined(PUREPASCAL) and not defined(MSWINDOWS)}
240
  {$DEFINE PUREPASCAL}
241
{$IFEND}
242

243
const
244
{$IFDEF PUREPASCAL}
245
  PurePascal = True;
246
{$ELSE}
247
  PurePascal = False;
248
{$ENDIF}
249

250
{$IFDEF EXPERIMENTAL}
251
  ExperimentalCode = True;
252
{$ELSE}
253
  ExperimentalCode = False;
254
{$ENDIF}
255

256
  // This assumes an unroll factor of 4. Unrolling more (e.g. 8) does not improve performance anymore.
257
  // That was tested and removed again.
258
  CUnrollShift     = 2;
259
  CUnrollIncrement = 1 shl CUnrollShift;
260
  CUnrollMask      = CUnrollIncrement - 1;
261

262
type
263
  TNumberBase = 2..36;                          // Number base or radix.
264

265
{$IF not declared(TRandom32Proc)}
266
  TRandom32Proc = function: UInt32;
267
  TRandomizeProc = procedure(NewSeed: UInt64);
268
{$IFEND}
269

270
  PLimb = ^TLimb;                               // Knuth calls them "limbs".
271
  TLimb = type UInt32;                          // FWIW, I also like the recently spotted term "bigit".
272
  TMagnitude = TArray<TLimb>;                   // These BigIntegers use sign-magnitude format, hence the name.
273

274
  // BigInteger uses a sign-magnitude representation, i.e. the magnitude is always interpreted as an
275
  // unsigned big integer, while the sign bit represents the sign. Currently, the sign bit is stored as the
276
  // top bit of the FSize member.
277

278
  PBigInteger = ^BigInteger;
279
  BigInteger = record
280
  public
281
  {$REGION 'public constants, types and variables'}
282
    type
283
      /// <summary>TRoundingMode governs which rounding mode is used to convert from Double to BigInteger.</summary>
284
      /// <param name="rmTruncate">Truncates any fraction</param>
285
      /// <param name="rmSchool">Rounds any fraction >= 0.5 away from zero</param>
286
      /// <param name="rmRound">Rounds any fraction > 0.5 away from zero</param>
287
      TRoundingMode = (rmTruncate, rmSchool, rmRound);
288

289
      TNumberBaseInfo = record
290
        MaxPower: NativeUInt;
291
        MaxDigits: Integer;
292
        PowerOfTwo: Boolean;
293
        MaxFactor: UInt32;
294
      end;
295

296
    class var
297
      MinusOne: BigInteger;
298
      Zero: BigInteger;
299
      One: BigInteger;
300
      Ten: BigInteger;
301

302
    const
303
{$IFDEF BIGINTEGERIMMUTABLE}
304
      Immutable    = True;
305
{$ELSE}
306
      Immutable    = False;
307
{$ENDIF}
308

309
      CapacityMask = High(Integer) - 3; // Mask ensuring that FData lengths are a multiple of 4, e.g. $7FFFFFFC
310
      SizeMask     = High(Integer);     // Mask to extract size part of FSize member, e.g. $7FFFFFFF
311
      SignMask     = Low(Integer);      // Mask to extract sign bit of FSize member, e.g. $80000000
312

313
  {$IFDEF PUREPASCAL}
314
    {$IFDEF CPU64BITS}                                          // 64PP = 64 bit, Pure Pascal
315
      KaratsubaThreshold             =   80;    // Checked
316
      ToomCook3Threshold             =  272;    // Checked
317
      BurnikelZieglerThreshold       =   91;    // Checked
318
      BurnikelZieglerOffsetThreshold =    5;    // Unchecked
319
      KaratsubaSqrThreshold          =   48;    // Unchecked
320
    {$ELSE CPU32BITS}                                           // 32PP = 32 bit, Pure Pascal
321
      KaratsubaThreshold             =   40;    // Checked
322
      ToomCook3Threshold             =  144;    // Checked
323
      BurnikelZieglerThreshold       =   91;    // Checked
324
      BurnikelZieglerOffsetThreshold =    5;    // Unchecked
325
      KaratsubaSqrThreshold          =   48;    // Unchecked
326
    {$ENDIF CPU64BITS}
327
  {$ELSE !PUREPASCAL}
328
    {$IFDEF CPU64BITS}                                          // 64A  = 64 bit, Assembler
329
      KaratsubaThreshold             =  128;    // Checked
330
      ToomCook3Threshold             = 1024;    // Checked
331
      BurnikelZieglerThreshold       =  160;    // Checked
332
      BurnikelZieglerOffsetThreshold =   80;    // Unchecked
333
      KaratsubaSqrThreshold          =  256;    // Unchecked
334
    {$ELSE CPU32BITS}                                           // 32A  = 32 bit, Assembler
335
      KaratsubaThreshold             =   64;    // Checked
336
      ToomCook3Threshold             =  256;    // Checked
337
      BurnikelZieglerThreshold       =   80;    // Checked
338
      BurnikelZieglerOffsetThreshold =   40;    // Unchecked
339
      KaratsubaSqrThreshold          =  128;    // Unchecked
340
    {$ENDIF CPU64BITS}
341
  {$ENDIF PUREPASCAL}
342

343
      RecursiveToStringThreshold     =    4;    // Checked
344
      ToomCook3SqrThreshold          =  216;    // Unchecked
345
  {$ENDREGION}
346

347
  {$REGION 'public methods'}
348

349
    // -- Constructors --
350

351
    /// <summary>Initializes class variables before first use.</summary>
352
    class constructor Initialize;
353

354
    /// <summary>Creates a new BigInteger from the data in limbs and the sign specified in Negative.</summary>
355
    /// <param name="Limbs">data for the magnitude of the BigInteger. The data is interpreted as unsigned,
356
    ///   and comes low limb first.</param>
357
    /// <param name="Negative">Indicates if the BigInteger is negative.</param>
358
    constructor Create(const Limbs: array of TLimb; Negative: Boolean); overload;
359

360
    /// <summary>Creates a new BigInteger from the data in limbs and the sign specified in Negative.</summary>
361
    /// <param name="Magnitude">data for the magnitude of the BigInteger. The data is interpreted as unsigned,
362
    ///   and comes low limb first.</param>
363
    /// <param name="Negative">Indicates if the BigInteger is negative.</param>
364
    constructor Create(const Magnitude: TMagnitude; Negative: Boolean); overload;
365

366
    /// <summary>Creates a new BigInteger with the same value as the specified BigInteger.</summary>
367
    constructor Create(const Value: BigInteger); overload;
368

369
    /// <summary>Creates a new BigInteger with the value of the specified Integer.<summary>
370
    constructor Create(const Value: Int32); overload;
371

372
    /// <summary>Creates a new BigInteger with the value of the specified Cardinal.<summary>
373
    constructor Create(const Value: UInt32); overload;
374

375
    /// <summary>Creates a new BigInteger with the value of the specified 64 bit integer.<summary>
376
    constructor Create(const Value: Int64); overload;
377

378
    /// <summary>Creates a new BigInteger with the value of the specified Integer.<summary>
379
    constructor Create(const Value: UInt64); overload;
380

381
    /// <summary>Creates a new BigInteger with the integer value of the specified Double.</summary>
382
    constructor Create(const Value: Double); overload;
383

384
  {$IFNDEF NoAnsi}
385
    /// <summary>Creates a new BigInteger with the value of the specified string.</summary>
386
    constructor Create(const Value: PAnsiChar); overload;
387
  {$ENDIF}
388

389
    /// <summary>Creates a new BigInteger with the value of the specified string.</summary>
390
    constructor Create(const Value: PWideChar); overload;
391

392
    /// <summary>Creates a new BigInteger from the value in the byte array.
393
    /// The byte array is considered to be in two's complement.</summary>
394
    /// <remarks>This is the complementary function of ToByteArray</remarks>
395
    constructor Create(const Bytes: array of Byte); overload;
396

397
    /// <summary>Creates a new random BigInteger of the given size. Uses the given IRandom to
398
    ///   generate the random value.</summary>
399
    constructor Create(NumBits: Integer; const Random: IRandom); overload;
400

401
    /// <summary>Creates a new random BigInteger of the given size. Uses the given Random32Proc function to
402
    ///   generate the random value.</summary>
403
    constructor Create(NumBits: Integer; Random: TRandom32Proc); overload;
404

405

406
    // -- Global numeric base related functions --
407

408
    /// <summary>Sets the global numeric base for big integers to 10.</summary>
409
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
410
    ///   the output function.</remarks>
411
    class procedure Decimal; static;
412

413
    /// <summary>Sets the global numeric base for big integers to 16.</summary>
414
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
415
    ///   the output function.</remarks>
416
    class procedure Hexadecimal; static;
417

418
    /// <summary>Sets the global numeric base for big integers to 16.</summary>
419
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
420
    ///   the output function.</remarks>
421
    class procedure Hex; static;
422

423
    /// <summary>Sets the global numeric base for big integers to 2.</summary>
424
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
425
    ///   the output function.</remarks>
426
    class procedure Binary; static;
427

428
    /// <summary>Sets the global numeric base for big integers to 8.</summary>
429
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
430
    ///   the output function.</remarks>
431
    class procedure Octal; static;
432

433

434
    // -- String input functions --
435

436
    /// <summary>Tries to parse the specified string into a valid BigInteger value in the specified numeric base.
437
    ///   Returns False if this failed.</summary>
438
    /// <param name="S">The string that represents a big integer value in the specified numeric base.</param>
439
    /// <param name="ABase">The numeric base that is assumed when parsing the string. Valid values are 2..36.</param>
440
    /// <param name="AValue">The resulting BigInteger, if the parsing succeeds. AValue is undefined if the
441
    ///   parsing fails.</param>
442
    /// <returns>Returns True if S could be parsed into a valid BigInteger in AVaLue. Returns False on failure.</returns>
443
    class function TryParse(const S: string; ABase: TNumberBase; var AValue: BigInteger): Boolean; overload; static;
444

445
    // -------------------------------------------------------------------------------------------------------------//
446
    // Note: most of the parse format for BigIntegers was taken from or inspired by Common Lisp (e.g. '%nnR' or     //
447
    // '_'), some was inspired by other languages, including Delphi (e.g. the '$ 'for hex values), some was         //
448
    // something I prefer (e.g. '0k' additional to '0o' for octal format). It should be usable in Delphi as well    //
449
    // as in C++Builder, as it contains the default formats for integer values in these languages too.              //
450
    // -- Rudy Velthuis.                                                                                            //
451
    //--------------------------------------------------------------------------------------------------------------//
452

453
    /// <summary>Tries to parse the specified string into a valid BigInteger value in the default BigInteger
454
    ///   numeric base.</summary>
455
    /// <param name="S">The string that represents a big integer value in the default numeric base, unless
456
    ///   specified otherwise. See <see cref="BigInteger.Base" /></param>
457
    /// <param name="Value">The resulting BigInteger, if the parsing succeeds. Value is undefined if the parsing
458
    ///   fails.</param>
459
    /// <returns>Returns True if S could be parsed into a valid BigInteger in Res. Returns False on failure.</returns>
460
    /// <remarks>
461
    ///   <para>To make it easier to increase the legibility of large numbers, any '_' in the numeric string
462
    ///      will completely be ignored, so '1_000_000_000' is exactly equivalent to '1000000000'.</para>
463
    ///   <para>The string to be parsed is considered case insensitive, so '$ABC' and '$abc' represent exactly
464
    ///     the same value.</para>
465
    ///   <para>The format of a string to be parsed is as follows:</para>
466
    ///   <para><c>[sign][base override]digits</c></para>
467
    ///   <para>
468
    ///     <param name="sign">This can either be '-' or '+'. It will make the BigInteger negative or
469
    ///       positive, respectively. If no sign is specified, a positive BigInteger is generated.</param>
470
    ///     <param name="base override">There are several ways to override the default numeric base.
471
    ///       <para>Specifying '0x' or '$' here will cause the string to be interpreted as representing a
472
    ///       hexadecimal (base 16) value.</para><para>Specifying '0b' will cause it to be interpreted as
473
    ///       binary (base 2).</para><para>Specifying '0d' will cause it to be interpreted as
474
    ///       decimal (base 10).</para>
475
    ///       <para>Specifying '0o' or '0k' will cause it to be interpreted as octal (base 8).</para>
476
    ///       <para>Finally, to specify any base,
477
    ///       using an override in the format '%nnR' (R for radix) will cause the number to be interpreted to be
478
    ///       in base 'nn', where 'nn' represent one or two decimal digits. So '%36rRudyVelthuis' is a valid
479
    ///       BigInteger value with base 36.</para>
480
    ///     </param>
481
    ///   </para>
482
    /// </remarks>
483
    class function TryParse(const S: string; var Value: BigInteger): Boolean; overload; static;
484

485
    /// <summary>Parses the specified string into a BigInteger, using the default numeric base.</summary>
486
    class function Parse(const S: string): BigInteger; static;
487

488

489
    // -- Sign related functions --
490

491
    /// <summary>Returns True if the BigInteger is zero.</summary>
492
    function IsZero: Boolean; inline;
493

494
    /// <summary>Returns True if the BigInteger is negative (&lt; 0).</summary>
495
    function IsNegative: Boolean; inline;
496

497
    /// <summary>Returns True if the BigInteger is positive (&gt; 0).</summary>
498
    function IsPositive: Boolean; inline;
499

500
    /// <summary>Returns True if the BigInteger is even (0 is considered even too).</summary>
501
    function IsEven: Boolean; inline;
502

503
    /// <summary>Returns True if the magnitude of the BigInteger value is exactly a power of two.</summary>
504
    function IsPowerOfTwo: Boolean;
505

506
    /// <summary>Returns True if the BigInteger represents a value of 1.</summary>
507
    function IsOne: Boolean;
508

509

510
    // -- Bit fiddling --
511

512
    /// <summary>Tests if the bit at the given bit index is set.</summary>
513
    /// <remarks>If the index is outside the magnitude, the bit value is calculated: if the BigInteger is
514
    /// negative, it is assumed to be set, otherwise it is assumed to be clear.</remarks>
515
    function TestBit(Index: Integer): Boolean;
516

517
    /// <summary>Returns a new BigInteger which is a copy of the current one, but with the bit at the given index
518
    /// set. If necessary, the new BigInteger is expanded.</summary>
519
    function SetBit(Index: Integer): BigInteger;
520

521
    /// <summary>Returns a new BigInteger which is a copy of the current one, but with the bit at the given index
522
    /// cleared. If necessary, the new BigInteger is expanded.</summary>
523
    function ClearBit(Index: Integer): BigInteger;
524

525
    /// <summary>Returns a new BigInteger which is a copy of the current one, but with the bit at the given index
526
    /// toggled. If necessary, the new BigInteger is expanded.</summary>
527
    function FlipBit(Index: Integer): BigInteger;
528

529

530
    // -- String output functions --
531

532
    /// <summary>Returns the string interpretation of the specified BigInteger in the default numeric base,
533
    ///   see <see cref="BigInteger.Base" />.
534
    /// </summary>
535
    function ToString: string; overload;
536

537
    /// <summary>Returns the string interpretation of the specified BigInteger in the specified numeric base.</summary>
538
    function ToString(Base: Integer): string; overload;
539

540
    /// <summary>Old, slow, but secure routine.</summary>
541
    /// <remarks>This should only be used for debugging purposes. May be removed anytime.
542
    /// For regular code, use <c>ToString(Base)</c>.</remarks>
543
    function ToStringClassic(Base: Integer): string;
544

545
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 10. Equivalent
546
    ///   to ToString(10).</summary>
547
    function ToDecimalString: string;
548

549
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 16. Equivalent
550
    ///   to ToString(16).</summary>
551
    function ToHexString: string;
552

553
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 2. Equivalent
554
    ///   to ToString(2).</summary>
555
    function ToBinaryString: string;
556

557
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 8. Equivalent
558
    ///   to ToString(8).</summary>
559
    function ToOctalString: string;
560

561

562
    // -- Arithmetic operators --
563

564
    /// <summary>Adds two BigIntegers.</summary>
565
    class operator Add(const Left, Right: BigInteger): BigInteger;
566

567
    /// <summary>Subtracts the second BigInteger from the first.</summary>
568
    class operator Subtract(const Left, Right: BigInteger): BigInteger;
569

570
    /// <summary>Multiplies two BigIntegers.</summary>
571
    class operator Multiply(const Left, Right: BigInteger): BigInteger;
572

573
    /// <summary>Multiplies the specified BigInteger with the specified Word value.</summary>
574
    class operator Multiply(const Left: BigInteger; Right: Word): BigInteger;
575

576
    /// <summary>multiplies the specified Wirdvalue with the specified BigInteger.</summary>
577
    class operator Multiply(Left: Word; const Right: BigInteger): BigInteger;
578

579
    /// <summary>Performs an integer divide of the first BigInteger by the second.
580
    class operator IntDivide(const Left, Right: BigInteger): BigInteger;
581

582
    /// <summary>Performs an integer divide of the first BigInteger by the second.
583
    class operator IntDivide(const Left: BigInteger; Right: UInt16): BigInteger;
584

585
    /// <summary>Performs an integer divide of the first BigInteger by the second.
586
    class operator IntDivide(const Left: BigInteger; Right: UInt32): BigInteger;
587

588
    /// <summary>Returns the remainder of an integer divide of the first BigInteger by the second.</summary>
589
    class operator Modulus(const Left, Right: BigInteger): BigInteger;
590

591
    /// <summary>Returns the remainder of an integer divide of the first BigInteger by the second.</summary>
592
    class operator Modulus(const Left: BigInteger; Right: UInt32): BigInteger;
593

594
    /// <summary>Returns the remainder of an integer divide of the first BigInteger by the second.</summary>
595
    class operator Modulus(const Left: BigInteger; Right: UInt16): BigInteger;
596

597
    /// <summary>Unary minus. Negates the value of the specified BigInteger.</summary>
598
    class operator Negative(const Value: BigInteger): BigInteger;
599

600
{$IFDEF BIGINTEGERIMMUTABLE}
601
  private
602
{$ENDIF}
603
    /// <summary>Increment. Adds 1 to the value of the specified BigInteger very fast.</summary>
604
    class operator Inc(const Value: BigInteger): BigInteger;
605

606
    /// <summary>Decrement. Subtracts 1 from the value of the specified BigInteger very fast.</summary>
607
    class operator Dec(const Value: BigInteger): BigInteger;
608
{$IFDEF BIGINTEGERIMMUTABLE}
609
  public
610
{$ENDIF}
611

612
    // -- Logical and bitwise operators --
613

614
    /// <summary>Returns the result of the bitwise AND operation on its BigInteger operands. The result
615
    /// has two's complement semantics, e.g. '-1 and 7' returns '7'.</summary>
616
    class operator BitwiseAnd(const Left, Right: BigInteger): BigInteger;
617

618
    /// <summary>Returns the result of the bitwise OR operation on its BigInteger operands. The result
619
    /// has two's complement semantics, e.g. '-1 or 7' returns '-1'.</summary>
620
    class operator BitwiseOr(const Left, Right: BigInteger): BigInteger;
621

622
    /// <summary>Returns the result of the bitwise XOR operation on its BigIntegers operands. The result
623
    /// has two's complement semantics, e.g. '-1 xor 7' returns '-8'.</summary>
624
    class operator BitwiseXor(const Left, Right: BigInteger): BigInteger;
625

626
    /// <summary>Returns the result of the bitwise NOT operation on its BigInteger operand. The result
627
    /// has two's complement semantics, e.g. 'not 1' returns '-2'.</summary>
628
    class operator LogicalNot(const Value: BigInteger): BigInteger;
629

630

631
    // -- Shift operators --
632

633
    /// <summary>Shifts the specified BigInteger value the specified number of bits to the left (away from 0).
634
    ///   The size of the BigInteger is adjusted accordingly.</summary>
635
    /// <remarks>Note that this is an arithmetic shift, i.e. the sign is preserved. This is unlike normal
636
    ///   integer shifts in Delphi.</remarks>
637
    class operator LeftShift(const Value: BigInteger; Shift: Integer): BigInteger;
638

639
    /// <summary>Shifts the specified BigInteger value the specified number of bits to the right (toward 0).
640
    ///   The size of the BigInteger is adjusted accordingly.</summary>
641
    /// <remarks>Note that this is an arithmetic shift, i.e. the sign is preserved. This is unlike normal
642
    ///   integer shifts in Delphi. This means that negative values do not finally end up as 0, but
643
    ///   as -1, since the sign bit is always shifted in.</remarks>
644
    class operator RightShift(const Value: BigInteger; Shift: Integer): BigInteger;
645

646

647
    // -- Comparison operators --
648

649
    /// <summary>Returns True if the specified BigIntegers have the same value.</summary>
650
    class operator Equal(const Left, Right: BigInteger): Boolean;
651

652
    /// <summary>Returns True if the specified BigInteger do not have the same value.</summary>
653
    class operator NotEqual(const Left, Right: BigInteger): Boolean;
654

655
    /// <summary>Returns true if the value of Left is mathematically greater than the value of Right.</summary>
656
    class operator GreaterThan(const Left, Right: BigInteger): Boolean;
657

658
    /// <summary>Returns true if the value of Left is mathematically greater than or equal to the value
659
    ///   of Right.</summary>
660
    class operator GreaterThanOrEqual(const Left, Right: BigInteger): Boolean;
661

662
    /// <summary>Returns true if the value of Left is mathematically less than the value of Right.</summary>
663
    class operator LessThan(const Left, Right: BigInteger): Boolean;
664

665
    /// <summary>Returns true if the value of Left is mathematically less than or equal to the
666
    ///   value of Right.</summary>
667
    class operator LessThanOrEqual(const Left, Right: BigInteger): Boolean;
668

669

670
    // -- Implicit conversion operators --
671

672
    /// <summary>Implicitly (i.e. without a cast) converts the specified Integer to a BigInteger.</summary>
673
    class operator Implicit(const Value: Int32): BigInteger;
674

675
    /// <summary>Implicitly (i.e. without a cast) converts the specified Cardinal to a BigInteger.</summary>
676
    class operator Implicit(const Value: UInt32): BigInteger;
677

678
    /// <summary>Implicitly (i.e. without a cast) converts the specified Int64 to a BigInteger.</summary>
679
    class operator Implicit(const Value: Int64): BigInteger;
680

681
    /// <summary>Implicitly (i.e. without a cast) converts the specified UInt64 to a BigInteger.</summary>
682
    class operator Implicit(const Value: UInt64): BigInteger;
683

684
    /// <summary>Implicitly (i.e. without a cast) converts the specified string to a BigInteger. The BigInteger
685
    ///   is the result of a call to Parse(Value).</summary>
686
    class operator Implicit(const Value: string): BigInteger;
687

688
  {$IFNDEF NoAnsi}
689
    /// <summary>Implicitly (i.e. without a cast) converts the specified string to a BigInteger. The BigInteger
690
    ///   is the result of a call to Parse(Value).</summary>
691
    /// <remark>Added for compatibility with C++Builder.</remark>
692
    class operator Implicit(const Value: PAnsiChar): BigInteger;
693
  {$ENDIF}
694

695
    /// <summary>Implicitly (i.e. without a cast) converts the specified string to a BigInteger. The BigInteger
696
    ///   is the result of a call to Parse(Value).</summary>
697
    /// <remark>Added for compatibility with C++Builder.</remark>
698
    class operator Implicit(const Value: PWideChar): BigInteger;
699

700

701
    // -- Explicit conversion operators --
702

703
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an Integer. If necessary, the
704
    ///   value of the BigInteger is truncated or sign-extended to fit in the result.</summary>
705
    class operator Explicit(const Value: BigInteger): Int32;
706

707
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a Cardinal. If necessary, the
708
    ///   value of the BigInteger is truncated to fit in the result.</summary>
709
    class operator Explicit(const Value: BigInteger): UInt32;
710

711
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an Int64. If necessary, the
712
    ///   value of the BigInteger is truncated or sign-extended to fit in the result.</summary>
713
    class operator Explicit(const Value: BigInteger): Int64;
714

715
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an UInt64. If necessary, the
716
    ///   value of the BigInteger is truncated to fit in the result.</summary>
717
    class operator Explicit(const Value: BigInteger): UInt64;
718

719
  {$IFDEF HasExtended}
720
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an Extended.</summary>
721
    class operator Explicit(const Value: BigInteger): Extended;
722
  {$ENDIF}
723

724
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a Double.</summary>
725
    class operator Explicit(const Value: BigInteger): Double;
726

727
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a Single.</summary>
728
    class operator Explicit(const Value: BigInteger): Single;
729

730
    /// <summary>Explicitly (i.e. with a cast) converts the specified Double to a BigInteger.</summary>
731
    class operator Explicit(const Value: Double): BigInteger;
732

733
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a string.</summary>
734
    /// <remarks>Calls Value.ToString to generate the result.</remarks>
735
    class operator Explicit(const Value: BigInteger): string;
736

737

738
    // -- Conversion functions --
739

740
    /// <summary>Converts the specified BigInteger to a Single, if this is possible. Returns an infinity if the
741
    ///   value of the BigInteger is too large.</summary>
742
    function AsSingle: Single;
743

744
    /// <summary>Converts the specified BigInteger to a Double, if this is possible. Returns an infinity if the
745
    ///   value of the BigInteger is too large.</summary>
746
    function AsDouble: Double;
747

748
  {$IFDEF HasExtended}
749
    /// <summary>Converts the specified BigInteger to an Extended, if this is possible. Returns an infinity if the
750
    ///   value of the BigInteger is too large.</summary>
751
    function AsExtended: Extended;
752
  {$ENDIF}
753

754
    /// <summary>Converts the specified BigInteger to an Integer, if this is possible. Returns an exception if the
755
    ///   value of the BigInteger is too large.</summary>
756
    function AsInteger: Integer;
757

758
    /// <summary>Converts the specified BigInteger to a Cardinal, if this is possible. Returns an exception if the
759
    ///   value of the BigInteger is too large or is negative.</summary>
760
    function AsCardinal: Cardinal;
761

762
    /// <summary>Converts the specified BigInteger to an Int64, if this is possible. Returns an exception if the
763
    ///   value of the BigInteger is too large.</summary>
764
    function AsInt64: Int64;
765

766
    /// <summary>Converts the specified BigInteger to a UInt64, if this is possible. Returns an exception if the
767
    ///   value of the BigInteger is too large or is negative.</summary>
768
    function AsUInt64: UInt64;
769

770

771
    // -- Operators as functions --
772

773
    /// <summary>The function equivalent to the operator '+'.</summary>
774
    class function Add(const Left, Right: BigInteger): BigInteger; overload; static;
775
    class procedure Add(const Left, Right: BigInteger; var Result: BigInteger); overload; static;
776

777
    /// <summary>The function equivalent to the operator '-'.</summary>
778
    class function Subtract(const Left, Right: BigInteger): BigInteger; overload; static;
779
    class procedure Subtract(const Left, Right: BigInteger; var Result: BigInteger); overload; static;
780

781
    /// <summary>The function equivalent to the operator '*'.</summary>
782
    class function Multiply(const Left, Right: BigInteger): BigInteger; overload; static;
783
    class procedure Multiply(const Left, Right: BigInteger; var Result: BigInteger); overload; static;
784

785
    /// <summary>Function performing "schoolbook" multiplication.</summary>
786
    class procedure MultiplyBaseCase(const Left, Right: BigInteger; var Result: BigInteger); static;
787

788
    /// <summary>Function performing multiplcation using Karatsuba algorithm. Has more overhead, so only
789
    ///  applied to large BigIntegers.</summary>
790
    class procedure MultiplyKaratsuba(const Left, Right: BigInteger; var Result: BigInteger); static;
791

792
    /// <summary>Function performing multiplication using Toom-Cook 3-way algorithm. Faster than Karatsuba, but,
793
    /// due to its overhead, only for very large BigIntegers.</summary>
794
    class function MultiplyToomCook3(const Left, Right: BigInteger): BigInteger; static;
795

796
    /// <summary>The function equivalent to the operators 'div' and 'mod'. Since calculation of the quotient
797
    ///   automatically leaves a remainder, this function allows you to get both for more or less the "price"
798
    ///   (performance-wise) of one.</summary>
799
    class procedure DivMod(const Dividend, Divisor: BigInteger; var Quotient, Remainder: BigInteger); static;
800

801
    /// <summary>Simple "schoolbook" division according to Knuth, with limb-size digits.</summary>
802
    class procedure DivModKnuth(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger); static;
803

804
    /// <summary>Recursive "schoolbook" division, as described by Burnikel and Ziegler. Faster than
805
    /// <see cref="DivModKnuth" />, but with more overhead, so should only be applied for
806
    ///   larger BigIntegers.</summary>
807
    /// <remark>For smaller BigIntegers, this routine falls back to DivModKnuth.
808
    class procedure DivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger); static;
809

810
    /// <summary>The function equivalent to the operator 'div'.</summary>
811
    class function Divide(const Left, Right: BigInteger): BigInteger; overload; static;
812

813
    /// <summary>The function equivalent to the operator 'div'.</summary>
814
    class function Divide(const Left: BigInteger; Right: UInt16): BigInteger; overload; static;
815

816
    /// <summary>The function equivalent to the operator 'div'.</summary>
817
    class function Divide(const Left:BigInteger; Right: UInt32): BigInteger; overload; static;
818

819
    /// <summary>The function equivalent to the operator 'mod'. Like for integers, the remainder gets
820
    ///   the sign - if any - of the dividend (i.e. of Left).</summary>
821
    class function Remainder(const Left, Right: BigInteger): BigInteger; overload; static;
822

823
    /// <summary>The function equivalent to the operator 'mod'. Like for integers, the remainder gets
824
    ///   the sign - if any - of the dividend (i.e. of Left).</summary>
825
    class function Remainder(const Left: BigInteger; Right: UInt32): BigInteger; overload; static;
826

827
    /// <summary>The function equivalent to the operator 'mod'. Like for integers, the remainder gets
828
    ///   the sign - if any - of the dividend (i.e. of Left).</summary>
829
    class function Remainder(const Left: BigInteger; Right: UInt16): BigInteger; overload; static;
830

831
    class function SqrKaratsuba(const Value: BigInteger): BigInteger; static;
832

833
    /// <summary>Returns the negation of Value.</summary>
834
    class function Negate(const Value: BigInteger): BigInteger; static;
835

836
    /// <summary>The procedural equivalent of the operator 'shl'.</summary>
837
    class procedure ShiftLeft(const Value: BigInteger; Shift: Integer; var Result: BigInteger); overload; static;
838
    /// <summary>The function equivalent of the operator 'shl'.</summary>
839
    class function ShiftLeft(const Value: BigInteger; Shift: Integer): BigInteger; overload; static;
840

841
    /// <summary>The procedural equivalent of the operator 'shr'.</summary>
842
    class procedure ShiftRight(const Value: BigInteger; Shift: Integer; var Result: BigInteger); overload; static;
843
    /// <summary>The function equivalent of the operator 'shr'.</summary>
844
    class function ShiftRight(const Value: BigInteger; Shift: Integer): BigInteger; overload; static;
845

846
    // -- Self-referential operator functions --
847

848
  {$IFNDEF BIGINTEGERIMMUTABLE}
849
    /// <summary>
850
    ///   <para>The functional equivalent to</para>
851
    ///   <code>    A := A + Other;</code>
852
    ///   <para>This can be chained, as the function returns a pointer to itself:</para>
853
    ///   <code>    A.Add(First).Add(Second);</code></summary>
854
    /// <remarks><para>This was added in the hope to gain speed by avoiding some allocations.
855
    ///   This is not so, although a longer chain seems to improve performance, compared to normal addition
856
    ///   using operators, a bit.</para></remarks>
857
    function Add(const Other: BigInteger): PBigInteger; overload;
858

859
    /// <summary>The functional equivalent to Self := Self + Other;</summary>
860
    function Subtract(const Other: BigInteger): PBigInteger; overload;
861

862
    /// <summary>The functional equivalent to Self := Self div Other;</summary>
863
    function Divide(const Other: BigInteger): PBigInteger; overload;
864

865
    /// <summary>The functional equivalent to Self := Self mod Other;</summary>
866
    function Remainder(const Other: BigInteger): PBigInteger; overload;
867

868
    /// <summar>The functional equivalent to Self := Self * Other;</summary>
869
    function Multiply(const Other: BigInteger): PBigInteger; overload;
870
  {$ENDIF}
871

872

873
    // -- Math functions --
874

875
    /// <summary>Returns the absolute value of the value in the BigInteger.</summary>
876
    class function Abs(const Value: BigInteger): BigInteger; overload; static;
877

878
    /// <summary>Returns the absolute value of the current BigInteger.<summary>
879
    function Abs: BigInteger; overload;
880

881
    /// <summary>Returns the predecessor of the current BigInteger, i.e. its value minus one.</summary>
882
    function Pred: BigInteger; overload;
883

884
    // <summary>Returns the successor of the current BigInteger, i.e. its value plus one.</summary>
885
    function Succ: BigInteger; overload;
886

887
    /// <summary>Returns the bit length, the minimum number of bits needed to represent the value, excluding
888
    ///   the sign bit.</summary>
889
    function BitLength: Integer;
890

891
    /// <summary>Returns the number of all bits that are set, assuming two's complement. The sign bit is
892
    ///   included in the count.</summary>
893
    function BitCount: Integer;
894

895
    /// <summary>Returns the index of the rightmost (lowest) bit set. The lowest bit has index 0. Returns -1 if
896
    ///   this BigInteger is zero. </summary>
897
    function LowestSetBit: Integer;
898

899
    /// <summary>Returns a copy of the current BigInteger, with a unique copy of the data.</summary>
900
    function Clone: BigInteger;
901

902
    /// <summary>Returns +1 if the value in Left is greater than the value in Right, 0 if they are equal and
903
    ///   1 if it is lesser.</summary>
904
    class function Compare(const Left, Right: BigInteger): Integer; static;
905

906
    /// <summary>Returns N!, i.e. N * (N - 1) * (N - 2) * ... * 2 as BigInteger.
907
    class function Factorial(N: Integer): BigInteger; static;
908

909
    /// <summary>Returns a single Fibonacci number; 0 --> 0; 1 --> 1; N --> F(N-1) + F(N-2)</summary>
910
    class function Fibonacci(N: Integer): BigInteger; static;
911

912
    /// <summary>Returns the (positive) greatest common divisor of the specified BigInteger values.</summary>
913
    class function GreatestCommonDivisor(const Left, Right: BigInteger): BigInteger; static;
914

915
    /// <summary>Returns the natural logarithm of the BigInteger value.</summary>
916
    class function Ln(const Value: BigInteger): Double; overload; static;
917

918
    /// <summary>Returns the natural logarithm of the current BigInteger.</summary>
919
    function Ln: Double; overload;
920

921
    /// <summary>Returns the logarithm to the specified base of the BigInteger value.</summary>
922
    class function Log(const Value: BigInteger; Base: Double): Double; overload; static;
923

924
    /// <summary>Returns the logarithm to the specified base of the current BigInteger.</summary>
925
    function Log(Base: Double): Double; overload;
926

927
    /// <summary>Returns the logarithm to base 2 of the BigInteger value.</summary>
928
    class function Log2(const Value: BigInteger): Double; overload; static;
929

930
    /// <summary>Returns the logarithm to base 2 of the current BigInteger.</summary>
931
    function Log2: Double; overload;
932

933
    /// <summary>Returns the logarithm to base 10 of the BigInteger value.</summary>
934
    class function Log10(const Value: BigInteger): Double; overload; static;
935

936
    /// <summary>Returns the logarithm to base 10 of the current BigInteger.</summary>
937
    function Log10: Double; overload;
938

939
    /// <summary>The reverse of BigInteger.Ln. Returns e^Value, for very large Value, as BigInteger
940
    class function Exp(const b: Double): BigInteger; static;
941

942
    /// <summary>Returns the larger of two specified values.</summary>
943
    class function Max(const Left, Right: BigInteger): BigInteger; static;
944

945
    /// <summary>Returns the smaller of two specified values.</summary>
946
    class function Min(const Left, Right: BigInteger): BigInteger; static;
947

948
    /// <summary>Returns the modular inverse of Value mod Modulus.</summary>
949
    /// <exception>Returns an exception if there is no modular inverse.</exception>
950
    class function ModInverse(const Value, Modulus: BigInteger): BigInteger; static;
951

952
    /// <summary>Returns the specified modulus value of the specified value raised to the specified power.</summary>
953
    class function ModPow(const ABase, AExponent, AModulus: BigInteger): BigInteger; static;
954

955
    /// <summary>Returns the specified value raised to the specified power.</summary>
956
    class function Pow(const ABase: BigInteger; AExponent: Integer): BigInteger; overload; static;
957

958
    /// <summary>Returns the specified value raised to the spefied power in Result,</summary>
959
    class procedure Pow(const ABase: BigInteger; AExponent: Integer; var Result: BigInteger); overload; static;
960

961
    /// <summary>Returns the nth root R of a BigInteger such that R^index <= Radicand < (R+1)^index.</summary>
962
    class function NthRoot(const Radicand: BigInteger; Index: Integer): BigInteger; static;
963

964
    /// <summary>If R is the nth root of Radicand, returns Radicand - R^index.</summary>
965
    class procedure NthRootRemainder(const Radicand: BigInteger; Index: Integer;
966
      var Root, Remainder: BigInteger); static;
967

968
    /// <summary>Returns the square root R of Radicand, such that R^2 < Radicand < (R+1)^2</summary>
969
    class function BaseCaseSqrt(const Radicand: BigInteger): BigInteger; static;
970

971
    /// <summary>If R is the square root of Radicand, returns Radicand - R^2.</summary>
972
    class procedure BaseCaseSqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger); static;
973

974
    /// <summary>Returns the square root R of the radicand, such that R^2 < radicand < (R+1)^2.</summary>
975
    class function Sqrt(const Radicand: BigInteger): BigInteger; static;
976

977
    /// <summary>Returns square root and remainder of the radicand.</summary>
978
    class procedure SqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger); static;
979

980
    /// <summary>Returns the square of Value, i.e. Value*Value</summary>
981
    class function Sqr(const Value: BigInteger): BigInteger; static;
982

983

984
    // -- Utility functions --
985

986
    /// <summary>Sets whether partial-flags stall must be avoided with modified routines.</summary>
987
    /// <remarks>
988
    ///   <para><b>USING THE WRONG SETTING MAY AFFECT THE TIMING OF CERTAIN ROUTINES CONSIDERABLY, SO USE
989
    ///   THIS WITH EXTREME CARE!</b></para>
990
    ///   <para>The unit is usually able to determine the right settings automatically.</para>
991
    /// </remarks>
992
    class procedure AvoidPartialFlagsStall(Value: Boolean); static;
993

994
    // -- Array function(s) --
995

996
    /// <summary>Converts a BigInteger value to a byte array.</summary>
997
    /// <returns><para>A TArray&lt;Byte&gt;, see remarks.</para></returns>
998
    /// <remarks>
999
    ///   <para>The individual bytes in the array returned by this method appear in little-endian order.</para>
1000
    ///   <para>Negative values are written to the array using two's complement representation in the most compact
1001
    ///   form possible. For example, -1 is represented as a single byte whose value is $FF instead of as an array
1002
    ///   with multiple elements, such as $FF, $FF or $FF, $FF, $FF, $FF.</para>
1003
    ///   <para>Because two's complement representation always interprets the highest-order bit of the last byte in
1004
    ///   the array (the byte at position High(Array)) as the sign bit, the method returns a byte array with
1005
    ///   an extra element whose value is zero to disambiguate positive values that could otherwise be interpreted
1006
    ///   as having their sign bits set. For example, the value 120 or $78 is represented as a single-byte array:
1007
    ///   $78. However, 129, or $81, is represented as a two-byte array: $81, $00. Something similar applies to
1008
    ///   negative values: -179 (or -$B3) must be represented as $4D, $FF.</para>
1009
    /// </remarks>
1010
    function ToByteArray: TArray<Byte>;
1011

1012
    // -- Information functions --
1013

1014
    /// <summary>Returns the number of allocated limbs for the current BigInteger.</summary>
1015
    function GetAllocated: Integer;
1016

1017
    /// <summary>Returns the number of used limbs for the current BigInteger.</summary>
1018
    function GetSize: Integer; inline;
1019

1020
    /// <summary>Returns a pointer to the first limb of the magnitude.</summary>
1021
    function Data: PLimb; inline;
1022

1023
    /// <summary>Returns the sign for the current BigInteger: -1 for negative values, 0 for zero and 1 for
1024
    /// positive values.</summary>
1025
    function GetSign: Integer; inline;
1026

1027
    /// <summary>Sets the sign of the current BigInteger: -1 for negative values, 0 for zero and 1 for
1028
    /// positive values.</summary>
1029
    procedure SetSign(Value: Integer); inline;
1030
  {$ENDREGION}
1031

1032
  private
1033
  {$REGION 'private constants, types and variables'}
1034
    type
1035
      TErrorCode = (ecParse, ecDivByZero, ecConversion, ecInvalidBase, ecOverflow, ecInvalidArg, ecInvalidArgFloat, ecNoInverse,
1036
                    ecNegativeExponent, ecNegativeRadicand);
1037
      TBinaryOperator = procedure(Left, Right, Result: PLimb; LSize, RSize: Integer);
1038
    var
1039
      // The limbs of the magnitude, least significant limb at lowest address.
1040
      FData: TMagnitude;
1041
      // The top bit is the sign bit. Other bits form the unsigned number of valid limbs of the magnitude.
1042
      FSize: Integer;
1043
    class var
1044
      // The currently actual (global) number base.
1045
      FBase: TNumberBase;
1046
      // Flag indicating need to test for partial flag stall.
1047
      FAvoidStall: Boolean;
1048
      // The current rounding mode.
1049
      FRoundingMode: TRoundingMode;
1050

1051
      // The internal functions used to add and subtract. These differ depending on the need to avoid
1052
      // a partial flag stall.
1053
      FInternalAdd: TBinaryOperator;
1054
      FInternalSubtract: TBinaryOperator;
1055
      FLog2: Double;
1056
  {$ENDREGION}
1057

1058
  {$REGION 'private functions'}
1059
  {$IFNDEF PUREPASCAL}
1060
    // Function detecting of current CPU could suffer from partial flag stall.
1061
    class procedure DetectPartialFlagsStall; static;
1062

1063
    // Internal function adding two magnitudes. Contains code to avoid a partial flag stall.
1064
    class procedure InternalAddModified(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1065
    // Internal function adding two magnitudes. Does not contain code to avoid partial flag stall.
1066
    class procedure InternalAddPlain(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1067
    // Internal function subtracting two magnitudes. Contains code to avoid a partial flag stall.
1068
    class procedure InternalSubtractModified(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
1069
    // Internal func9tion subtracting two magnitudes. Does not contain code to avoid a partial flag stall.
1070
    class procedure InternalSubtractPlain(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
1071
    // Internal perfect division by 3 (guaranteed that there is no remainder).
1072
    class procedure InternalDivideBy3(Value, Result: PLimb; ASize: Integer); static;
1073
    // Internal function dividing magnitude by 100, in-place. Leaves quotient in place, returns remainder.
1074
    class function InternalDivMod100(var X: NativeUInt): NativeUInt; static;
1075
    // Function performing int to string conversion, writing to WritePtr.
1076
    class procedure InternalIntToStrDecimal(const Value: NativeUInt; var WritePtr: PChar; MaxDigits: Integer); static;
1077
    // Function calculating floating point components out of a BigInteger.
1078
  {$ELSE}
1079
    // Internal function adding two magnitudes. Pure Pascal (non-assembler) implementation.
1080
    class procedure InternalAddPurePascal(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1081
    // Internal function subtracting two magnitudes. Pure Pascal (non-assembler) implementation.
1082
    class procedure InternalSubtractPurePascal(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
1083
  {$ENDIF}
1084
    class procedure ConvertToFloatComponents(const Value: BigInteger; SignificandSize: Integer;
1085
      var Sign: Integer; var Significand: UInt64; var Exponent: Integer); static;
1086
    // Internal function comparing two magnitudes.
1087
    class function InternalCompare(Left, Right: PLimb; LSize, RSize: Integer): Integer; static; {$IFDEF PUREPASCAL} inline; {$ENDIF}
1088
    // Internal function and-ing two magnitudes.
1089
    class procedure InternalAnd(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1090
    // Internal function or-ing two magnitudes.
1091
    class procedure InternalOr(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1092
    // Internal funciton xor-ing two magnitudes.
1093
    class procedure InternalXor(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1094
    // Internal function and-not-ing two magnitudes (Left^ and not Right^).
1095
    class procedure InternalAndNot(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1096
    // Internal function not-and-ing two magnitudes (not Left^ and Right^).
1097
    class procedure InternalNotAnd(Left, Right, Result: PLimb; LSize, RSize: Integer); static; inline;
1098
    // Internal function performing bitwise operations. The bitwise operations share similar code.
1099
    class procedure InternalBitwise(const Left, Right: BigInteger; var Result: BigInteger;
1100
      PlainOp, OppositeOp, InversionOp: TBinaryOperator); static;
1101
    // Internal function icrementing a magnitude by one, in-place.
1102
    class procedure InternalIncrement(Limbs: PLimb; Size: Integer); static;
1103
    // Internal function decrementing a magnitude by one, in-place.
1104
    class procedure InternalDecrement(Limbs: PLimb; Size: Integer); static;
1105
    // Internal function parsing a decimal string into a BigInteger. Returns False if string not valid.
1106
    class function InternalParseDecimal(P: PChar; var Value: BigInteger): Boolean; static;
1107
    // Internal function parsing a hex string into a BigInteger. Returns False if string not valid.
1108
    class function InternalParseHex(P: PChar; var Value: BigInteger): Boolean; static;
1109
    // Internal function shifting a magnitude left into a new magnitude.
1110
    class procedure InternalShiftLeft(Source, Dest: PLimb; Shift, Size: Integer); static;
1111
    // Internal function shifting a magnitude right into a new magnitude.
1112
    class procedure InternalShiftRight(Source, Dest: PLimb; Shift, Size: Integer); static;
1113
    // Internal function performing int to string function for given numeric base.
1114
    class procedure InternalIntToStrBase(const Value: NativeUInt; Base: Cardinal;
1115
      var WritePtr: PChar; MaxDigits: Integer); static;
1116
    // Internal function performing int to string conversion for bases 2, 4, and 16, doing simple shifts.
1117
    class procedure InternalShiftedToString(const Value: BigInteger; Base: Integer; var WritePtr: PChar); static;
1118
    // Internal function performing int to string conversion, repeatedly dividing by 10 (simple algorithm).
1119
    class procedure InternalPlainToString(const Value: BigInteger; Base: Integer; const BaseInfo: TNumberBaseInfo;
1120
      var WritePtr: PChar; SectionCount: Integer); static;
1121
    // Internal function performing int to string conversion, using recursive divide-and-conquer algorithm.
1122
    class procedure InternalRecursiveToString(const Value: BigInteger; Base: Integer; const BaseInfo: TNumberBaseInfo;
1123
      var WritePtr: PChar; SectionCount: Integer); static;
1124
    // Internal function performing division of two magnitudes, returning quotient and remainder.
1125
    class function InternalDivMod(Dividend, Divisor, Quotient, Remainder: PLimb;
1126
      LSize, RSize: Integer): Boolean; static;
1127
    // Internal function performing division of magnitude by 32 bit integer.
1128
    class function InternalDivMod32(Dividend: PLimb; Divisor: UInt32; Quotient, Remainder: PLimb;
1129
      LSize: Integer): Boolean; static;
1130
    // Internal function performing division of magnitude by 16 bit integer (needed for Pure Pascal division).
1131
    class function InternalDivMod16(Dividend: PLimb; Divisor: UInt16; Quotient, Remainder: PLimb;
1132
      LSize: Integer): Boolean; static;
1133
    // performs a Knuth divmod. Does not compare magnitudes. Called by DivModKnuth.
1134
    class procedure UncheckedDivModKnuth(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger); static;
1135
    // Internal function multiplying two magnitudes.
1136
    class procedure InternalMultiply(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
1137
    // Internal function dividing magnitude by given base value. Leaves quotient in place, returns remainder.
1138
    class function InternalDivideByBase(Mag: PLimb; Base: Integer; var Size: Integer): UInt32; static;
1139
    // Internal function multiplying by 16 bit integer and then adding 16 bit value. Used by parser.
1140
    class procedure InternalMultiply16(const Left: TMagnitude; var Result: TMagnitude; LSize: Integer; Right: Word); static;
1141
    // Internal function multiplying by a base and adding a digit. Condition: ADigit < ABase. Size is updated if necessary.
1142
    // Cf. code of TryParse on how to set up Value.
1143
    class procedure InternalMultiplyAndAdd16(Value: PLimb; ABase, ADigit: Word; var Size: Integer); static;
1144

1145
    // Internal function negating magnitude (treating it as two's complement).
1146
    class procedure InternalNegate(Source, Dest: PLimb; Size: Integer); static;
1147

1148
    // Burnikel-Ziegler and helper functions.
1149
    // Divides two magnitudes using Burnikel-Ziegler algorithm.
1150
    class procedure InternalDivModBurnikelZiegler(const Left, Right: BigInteger;
1151
      var Quotient, Remainder: BigInteger); static;
1152
    // Divides a BigInteger by 3 exactly. BigInteger is guaranteed to be a positive multiple of 3.
1153
    class function DivideBy3Exactly(const A: BigInteger): BigInteger; static;
1154
    // Helper function for Burnikel-Ziegler division. See explanation in implementation section.
1155
    class procedure DivThreeHalvesByTwo(const LeftUpperMid, LeftLower, Right, RightUpper: BigInteger;
1156
      const RightLower: BigInteger;
1157
      N: Integer; var Quotient, Remainder: BigInteger); static;
1158
    // Helper function for Burnikel-Ziegler division.
1159
    class procedure DivTwoDigitsByOne(const Left, Right: BigInteger; N: Integer;
1160
      var Quotient, Remainder: BigInteger); static;
1161

1162
    // Karatsuba and Toom-Cook helper function
1163
    // Split BigInteger into smaller BigIntegers of size BlockSize.
1164
    function Split(BlockSize, BlockCount: Integer): TArray<BigInteger>;
1165

1166
    // Sets global numeric base.
1167
    class procedure SetBase(const Value: TNumberBase); static;
1168
    // Raises exceptions depending on given error code.
1169
    class procedure Error(ErrorCode: TErrorCode; const ErrorInfo: array of const); static;
1170

1171
    class procedure Compact(var Data: TMagnitude; var Size: Integer); overload; static;
1172
    // Resets size thus that there are no leading zero limbs.
1173
    procedure Compact; overload; inline;
1174
    // Reallocates magnitude to ensure a given size.
1175
    procedure EnsureSize(RequiredSize: Integer);
1176
    // Creates a new magnitude.
1177
    procedure MakeSize(RequiredSize: Integer);
1178
  {$ENDREGION}
1179

1180
  public
1181
  {$REGION 'public properties'}
1182
    /// <summary>Number of valid limbs in the magnitude</summary>
1183
    property Size: Integer read GetSize;
1184
    /// <summary>Number of allocated limbs in the mangitude</summary>
1185
    property Allocated: Integer read GetAllocated;
1186
    /// <summary>Indicates whether BigInteger is negative</summary>
1187
    property Negative: Boolean read IsNegative;
1188
    /// <summary>The sign of the BigInteger: -1, 0 or 1</summary>
1189
    property Sign: Integer read GetSign write SetSign;
1190
    /// <summary>Magnitude, dynamic array of TLimb, containing the (unsigned) value of the BigInteger</summary>
1191
    property Magnitude: TMagnitude read FData;
1192

1193
    /// <summary>Global numeric base for BigIntegers</summary>
1194
    class property Base: TNumberBase read FBase write SetBase;
1195
    /// <summary>A pure alias for Base</summary>
1196
    class property Radix: TNumberBase read FBase write SetBase;
1197
    /// <summary>Global rounding mode used for conversion to floating point</summary>
1198
    class property RoundingMode: TRoundingMode read FRoundingMode write FRoundingMode;
1199
    /// <summary>Global flag indicating if partial flag stall is avoided</summary>
1200
    class property StallAvoided: Boolean read FAvoidStall;
1201
  {$ENDREGION}
1202

1203
  end;
1204

1205
/// <summary>Returns sign bit (top bit) of an integer.</summary>
1206
function SignBitOf(Value: Integer): Integer; inline;
1207

1208
var
1209
  // Set this to True if you want to generate debug output.
1210
  DoDebug: Boolean = True;
1211

1212
{$HPPEMIT END '#include "Velthuis.BigIntegers.operators.hpp"'}
1213

1214
implementation
1215

1216
// To switch PUREPASCAL for debugging purposes, $UNDEF PUREPASCAL before the routine and $DEFINE PUREPASCAL
1217
// after the routine, if PP was defined.
1218
{$IFDEF PUREPASCAL}
1219
{$DEFINE PP}
1220
{$ENDIF}
1221

1222
// Copy the following around the routine for which you want to switch off PUREPASCAL
1223

1224
{$UNDEF PUREPASCAL}
1225
// Routine here.
1226
{$IFDEF PP}
1227
{$DEFINE PUREPASCAL}
1228
{$UNDEF PP}
1229
{$ENDIF}
1230

1231
uses
1232
{$IFDEF DEBUG}
1233
  {$IFDEF MSWINDOWS}
1234
  Winapi.Windows,
1235
  {$ENDIF}
1236
{$ENDIF}
1237
  Velthuis.Sizes, Velthuis.Numerics, Velthuis.FloatUtils, Velthuis.StrConsts;
1238

1239
{$POINTERMATH ON}
1240

1241
const
1242
  KZero: NativeUInt = 0;
1243

1244
{$REGION 'Debug related tools -- can eventually be removed'}
1245
{$IFDEF DEBUG}
1246
function Join(const Delimiter: string; const Values: array of string): string;
1247
var
1248
  I: Integer;
1249
begin
1250
  if Length(Values) > 0 then
1251
  begin
1252
    Result := Values[0];
1253
    for I := 1 to High(Values) do
1254
      Result := Delimiter + Result;
1255
  end;
1256
end;
1257

1258
function DumpPLimb(P: PLimb; Size: Integer): string;
1259
var
1260
  SL: TArray<string>;
1261
  I: Integer;
1262
begin
1263
  Result := '';
1264
  SetLength(SL, Size);
1265
  for I := 0 to Size - 1 do
1266
    SL[I] := Format('%.8x', [P[Size - I - 1]]);
1267
  Result := Result + Join(' ', SL);
1268
end;
1269

1270
procedure Debug(const Msg: string; const Params: array of const); overload;
1271
begin
1272
  if not DoDebug then
1273
    Exit;
1274

1275
  if IsConsole then
1276
    // Write to console.
1277
    Writeln(System.ErrOutput, Format(Msg, Params))
1278
{$IFDEF MSWINDOWS}
1279
  else
1280

1281
    // Inside the IDE, this will be displayed in the Event Log.
1282
    OutputDebugString(PChar(Format(Msg, Params)));
1283
{$ELSE}
1284
    ;
1285
{$ENDIF}
1286

1287
end;
1288

1289
procedure Debug(const Msg: string); overload;
1290
begin
1291
  Debug(Msg, []);
1292
end;
1293
{$ELSE}
1294
procedure Debug(const Msg: string; const Params: array of const);
1295
begin
1296
end;
1297
{$ENDIF}
1298
{$ENDREGION}
1299

1300
{$REGION 'Partial flag stall avoidance code'}
1301
const
1302
  CTimingLoops = $40000;
1303

1304
{$IFNDEF PUREPASCAL}
1305
procedure Timing(var T1, T2, T3: UInt64); stdcall;
1306
{$IFDEF WIN32}
1307
asm
1308
        RDTSC
1309
        MOV     ECX,T1
1310
        MOV     DWORD PTR [ECX],EAX
1311
        MOV     DWORD PTR [ECX+4],EDX
1312
        XOR     EAX,EAX
1313
        MOV     EDX,CTimingLoops
1314

1315
@ADCLoop:
1316

1317
        ADC     EAX,[ECX]       // Partial-flags stall on some "older" processors causes a measurable
1318
        DEC     EDX             //   timing difference. DEC only changes one flag, not entire flags register,
1319
        JNE     @ADCLoop        //   causing a stall when ADC reads flag register.
1320

1321
        RDTSC
1322
        MOV     ECX,T2
1323
        MOV     [ECX],EAX
1324
        MOV     [ECX+4],EDX
1325
        XOR     EAX,EAX
1326
        MOV     EDX,CTimingLoops
1327

1328
        .ALIGN  16
1329

1330
@ADDLoop:
1331

1332
        ADD     EAX,[ECX]       // ADD does not read carry flag, so no partial-flags stall.
1333
        DEC     EDX
1334
        JNE     @ADDLoop
1335

1336
        RDTSC
1337
        MOV     ECX,T3
1338
        MOV     [ECX],EAX
1339
        MOV     [ECX+4],EDX
1340
end;
1341
{$ELSE}
1342
asm
1343
        MOV     R9,RDX
1344
        RDTSC
1345
        MOV     [RCX],EAX
1346
        MOV     [RCX+4],EDX
1347
        XOR     EAX,EAX
1348
        MOV     EDX,CTimingLoops
1349

1350
        .ALIGN  16
1351

1352
@ADCLoop:
1353

1354
        ADC     EAX,[RCX]
1355
        DEC     EDX
1356
        JNE     @ADCLoop
1357

1358
        RDTSC
1359
        MOV     [R9],EAX
1360
        MOV     [R9+4],EDX
1361
        XOR     EAX,EAX
1362
        MOV     EDX,CTimingLoops
1363

1364
        .ALIGN  16
1365

1366
@ADDLoop:
1367

1368
        ADD     EAX,[RCX]
1369
        DEC     EDX
1370
        JNE     @ADDLoop
1371

1372
        RDTSC
1373
        MOV     [R8],EAX
1374
        MOV     [R8+4],EDX
1375
end;
1376
{$ENDIF}
1377

1378
class procedure BigInteger.DetectPartialFlagsStall;
1379
var
1380
  T1, T2, T3: UInt64;
1381
  I1, I2: UInt64;
1382
begin
1383
  repeat
1384
    Timing(T1, T2, T3);
1385
    I1 := T2 - T1;
1386
    I2 := T3 - T2;
1387
//    Debug('Timing: %d / %d = %.2f', [I1, I2, I1 / I2]);
1388

1389
    // Make sure timings are far enough apart. Repeat if in "grey area" inbetween.
1390
    if I1 / I2 > 4.0 then
1391
    begin
1392
      AvoidPartialFlagsStall(True);
1393
      Exit;
1394
    end
1395
    else if I1 / I2 < 2.0 then
1396
    begin
1397
      AvoidPartialFlagsStall(False);
1398
      Exit;
1399
    end;
1400
  until False;
1401
end;
1402
{$ENDIF !PUREPASCAL}
1403
{$ENDREGION}
1404

1405
{$RANGECHECKS OFF}
1406
{$OVERFLOWCHECKS OFF}
1407
{$POINTERMATH ON}
1408
{$STACKFRAMES OFF}
1409

1410
{$DEFINE LIBDIVIDE}
1411

1412
type
1413
  TUInt64 = record
1414
    Lo, Hi: UInt32;
1415
  end;
1416

1417
const
1418
  // Size of a single limb, used in e.g. asm blocks.
1419
  CLimbSize = SizeOf(TLimb);
1420

1421
  // Double limb, for 64 bit access
1422
  DLimbSize = 2 * CLimbSize;
1423

1424
  // Array mapping a digit in a specified base to its textual representation.
1425
  CBaseChars: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
1426
  CNumBase = Ord('0');
1427
  CAlphaBase = Ord('A');
1428

1429
  // Array mapping a specified base to the maximum number of digits required to represent one limb in that base.
1430
  // They map a specified base to Ceil(32 / Log2(base)).
1431
  CStringMaxLengths: array[TNumberBase] of Integer =
1432
  (
1433
    32, 21, 16, 14, 13, 12, 11,
1434
    11, 10, 10,  9,  9,  9,  9,
1435
     8,  8,  8,  8,  8,  8,  8,
1436
     8,  7,  7,  7,  7,  7,  7,
1437
     7,  7,  7,  7,  7,  7,  7
1438
  );
1439

1440
  CStringMinLengths: array[TNumberBase] of Integer =
1441
  (
1442
    32, 20, 16, 13, 12, 11, 10,
1443
    10,  9,  9,  8,  8,  8,  8,
1444
     8,  7,  7,  7,  7,  7,  7,
1445
     7,  6,  6,  6,  6,  6,  6,
1446
     6,  6,  6,  6,  6,  6,  6
1447
  );
1448

1449
  // Various useful sizes and bitcounts.
1450
  CLimbBits     = CByteBits * CLimbSize;
1451
  CLimbWords    = CLimbSize div SizeOf(Word);
1452
  CUInt64Limbs  = SizeOf(UInt64) div CLimbSize;
1453
  CInt64Limbs   = SizeOf(Int64) div CLimbSize;
1454

1455
{$INCLUDE 'bases.inc'}
1456

1457
var
1458
  CBasePowers: array[TNumberBase] of TArray<BigInteger>;
1459

1460
  ValueCache: array[-15..15] of BigInteger;
1461

1462
type
1463
  PDynArrayRec = ^TDynArrayRec;
1464
  TDynArrayRec = packed record
1465
  {$IFDEF CPU64BITS}
1466
    _Padding: Integer; // Make 16 byte align for payload.
1467
  {$ENDIF}
1468
    RefCnt: Integer;
1469
    Length: NativeInt;
1470
  end;
1471

1472
procedure SwapIntegers(var L, R: Integer); inline;
1473
var
1474
  Temp: Integer;
1475
begin
1476
  Temp := L;
1477
  L := R;
1478
  R := Temp;
1479
end;
1480

1481
procedure SwapPLimbs(var L, R: PLimb); inline;
1482
var
1483
  Temp: PLimb;
1484
begin
1485
  Temp := L;
1486
  L := R;
1487
  R := Temp;
1488
end;
1489

1490
function ActualSize(Limb: PLimb; Size: Integer): Integer;
1491
{$IFDEF PUREPASCAL}
1492
begin
1493
  while (Size > 0) and (Limb[Size - 1] = 0) do
1494
    Dec(Size);
1495
  Result := Size;
1496
end;
1497
{$ELSE}
1498
{$IFDEF WIN32}
1499
asm
1500

1501
        LEA     EAX,[EAX + EDX * CLimbSize - CLimbSize]
1502
        XOR     ECX,ECX
1503

1504
@Loop:
1505

1506
        CMP     [EAX],ECX
1507
        JNE     @Exit
1508
        LEA     EAX,[EAX - CLimbSize]
1509
        DEC     EDX
1510
        JNE     @Loop
1511

1512
@Exit:
1513

1514
        MOV     EAX,EDX
1515

1516
end;
1517
{$ELSE !WIN32}
1518
asm
1519

1520
        LEA     RAX,[RCX + RDX * CLimbSize - CLimbSize]
1521
        XOR     ECX,ECX
1522

1523
@Loop:
1524

1525
        CMP     [RAX],ECX
1526
        JNE     @Exit
1527
        LEA     RAX,[RAX - CLimbSize]
1528
        DEC     EDX
1529
        JNE     @Loop
1530

1531
@Exit:
1532

1533
        MOV     EAX,EDX
1534

1535
end;
1536
{$ENDIF !WIN32}
1537
{$ENDIF}
1538

1539
function IntMax(Left, Right: UInt32): UInt32;
1540
{$IFNDEF PUREPASCAL}
1541
{$IFDEF WIN32}
1542
asm
1543
        CMP    EAX,EDX
1544
        CMOVB  EAX,EDX
1545
end;
1546
{$ELSE WIN64}
1547
asm
1548
        MOV    EAX,ECX
1549
        CMP    EAX,EDX
1550
        CMOVB  EAX,EDX
1551
end;
1552
{$ENDIF}
1553
{$ELSE}
1554
begin
1555
  Result := Left;
1556
  if Left < Right then
1557
    Result := Right;
1558
end;
1559
{$ENDIF}
1560

1561
function IntMin(Left, Right: UInt32): UInt32;
1562
{$IFNDEF PUREPASCAL}
1563
{$IFDEF WIN32}
1564
asm
1565
        CMP    EAX,EDX
1566
        CMOVA  EAX,EDX
1567
end;
1568
{$ELSE WIN64}
1569
asm
1570
        MOV    EAX,ECX
1571
        CMP    EAX,EDX
1572
        CMOVA  EAX,EDX
1573
end;
1574
{$ENDIF}
1575
{$ELSE}
1576
begin
1577
  Result := Left;
1578
  if Left > Right then
1579
    Result := Right;
1580
end;
1581
{$ENDIF}
1582

1583
function ShouldUseBurnikelZiegler(LSize, RSize: Integer): Boolean; inline;
1584
begin
1585
  // http://mail.openjdk.java.net/pipermail/core-libs-dev/2013-November/023493.html
1586
  Result := (RSize >= BigInteger.BurnikelZieglerThreshold) and
1587
            ((LSize - RSize) >= BigInteger.BurnikelZieglerOffsetThreshold);
1588
end;
1589

1590
function SizeBitsOf(Value: Integer): Integer; inline;
1591
begin
1592
  Result := Value and BigInteger.SizeMask;
1593
end;
1594

1595
function SignBitOf(Value: Integer): Integer; inline;
1596
begin
1597
  Result := Value and BigInteger.SignMask;
1598
end;
1599

1600
function Min(const A, B: BigInteger): BigInteger; inline;
1601
begin
1602
  Result := BigInteger.Min(A, B);
1603
end;
1604

1605
function Max(const A, B: BigInteger): BigInteger; inline;
1606
begin
1607
  Result := BigInteger.Max(A, B);
1608
end;
1609

1610
function AllocLimbs(Size: Integer): PLimb; inline;
1611
begin
1612
  GetMem(Result, Size * CLimbSize);
1613
end;
1614

1615
procedure CopyLimbs(Src, Dest: PLimb; Count: Integer); inline;
1616
begin
1617
  Move(Src^, Dest^, Count * CLimbSize);
1618
end;
1619

1620
// Replacement for SetLength() only for TMagnitudes, i.e. dynamic arrays of TLimb.
1621
procedure AllocNewMagnitude(var AData: TMagnitude; RequiredSize: Integer);
1622
var
1623
  NewData: PByte;
1624
  NewSize: Integer;
1625
begin
1626
  NewSize := (RequiredSize + 3) and BigInteger.CapacityMask;
1627
  NewData := AllocMem(NewSize * CLimbSize + SizeOf(TDynArrayRec));
1628
  PDynArrayRec(NewData).RefCnt := 1;
1629
  PDynArrayRec(NewData).Length := NewSize;
1630
  PByte(AData) := NewData + SizeOf(TDynArrayRec);
1631
end;
1632

1633
{ BigInteger }
1634

1635
procedure ShallowCopy(const Value: BigInteger; var Result: BigInteger); inline;
1636
begin
1637
  Result.FSize := Value.FSize;
1638
  Result.FData := Value.FData;
1639
end;
1640

1641
procedure DeepCopy(const Value: BigInteger; var Result: BigInteger); inline;
1642
begin
1643
  Result.FSize := Value.FSize;
1644
  Result.FData := Copy(Value.FData);
1645
end;
1646

1647
function BigInteger.Abs: BigInteger;
1648
begin
1649
  ShallowCopy(Self, Result);
1650
  Result.FSize := Result.FSize and SizeMask;
1651
end;
1652

1653
class function BigInteger.Abs(const Value: BigInteger): BigInteger;
1654
begin
1655
  ShallowCopy(Value, Result);
1656
  Result.SetSign(0);
1657
end;
1658

1659
function BigInteger.Pred: BigInteger;
1660
begin
1661
  ShallowCopy(Self, Result);
1662
  Dec(Result);
1663
end;
1664

1665
function BigInteger.Succ: BigInteger;
1666
begin
1667
  ShallowCopy(Self, Result);
1668
  Inc(Result);
1669
end;
1670

1671
class function BigInteger.Add(const Left, Right: BigInteger): BigInteger;
1672
begin
1673
  Add(Left, Right, Result);
1674
end;
1675

1676
class procedure BigInteger.Add(const Left, Right: BigInteger; var Result: BigInteger);
1677
var
1678
  LSize, RSize, ResSize: Integer;
1679
  LSign, RSign, ResSign: Integer;
1680
  NewSize: Integer;
1681
  Comparison: Integer;
1682
  ResData: TMagnitude;
1683
begin
1684
  if not Assigned(Left.FData) then
1685
  begin
1686
    Result.FSize := Right.FSize;
1687
    Result.FData := Right.FData;
1688
    Exit;
1689
  end
1690
  else if not Assigned(Right.FData) then
1691
  begin
1692
    Result.FSize := Left.FSize;
1693
    Result.FData := Left.FData;
1694
    Exit;
1695
  end;
1696

1697
  LSize := Left.FSize and SizeMask;
1698
  RSize := Right.FSize and SizeMask;
1699
  LSign := Left.FSize and SignMask;
1700
  RSign := Right.FSize and SignMask;
1701
  ResSize := IntMax(LSize, RSize) + 1;
1702
  AllocNewMagnitude(ResData, ResSize);
1703

1704
  if LSign = RSign then
1705
  begin
1706
    // Same sign: add both magnitudes and transfer sign.
1707
    FInternalAdd(PLimb(Left.FData), PLimb(Right.FData), PLimb(ResData), LSize, RSize);
1708
    ResSign := LSign;
1709
  end
1710
  else
1711
  begin
1712
    Comparison := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize);
1713

1714
    if Comparison = 0 then
1715
    begin
1716
      Result.FSize := 0;
1717
      Result.FData := nil;
1718
      Exit;
1719
    end;
1720

1721
    if Comparison < 0 then
1722
    begin
1723
      FInternalSubtract(PLimb(Right.FData), PLimb(Left.FData), PLimb(ResData), RSize, LSize);
1724
      ResSign := RSign;
1725
    end
1726
    else
1727
    begin
1728
      FInternalSubtract(PLimb(Left.FData), PLimb(Right.FData), PLimb(ResData), LSize, RSize);
1729
      ResSign := LSign;
1730
    end;
1731
  end;
1732

1733
  NewSize := ActualSize(PLimb(ResData), ResSize);
1734
  if NewSize = 0 then
1735
  begin
1736
    Result.FSize := 0;
1737
    Result.FData := nil;
1738
  end
1739
  else
1740
  begin
1741
  {$IFDEF RESETSIZE}
1742
    if NewSize < (2 * ResSize div 3) then
1743
      SetLength(ResData, NewSize);
1744
  {$ENDIF}
1745
    Result.FSize := NewSize or ResSign;
1746
    Result.FData := ResData;
1747
  end;
1748
end;
1749

1750
class operator BigInteger.Add(const Left, Right: BigInteger): BigInteger;
1751
begin
1752
  Add(Left, Right, Result);
1753
end;
1754

1755
class procedure BigInteger.Binary;
1756
begin
1757
  FBase := 2;
1758
end;
1759

1760
class procedure BigInteger.InternalAnd(Left, Right, Result: PLimb; LSize, RSize: Integer);
1761
{$IFDEF PUREPASCAL}
1762
var
1763
  I: Integer;
1764
begin
1765
  if RSize > LSize then
1766
    RSize := LSize;
1767
  for I := 0 to RSize - 1 do
1768
    Result[I] := Left[I] and Right[I];
1769
end;
1770
{$ELSE !PUREPASCAL}
1771
{$IFDEF WIN32}
1772
asm
1773
        PUSH    ESI
1774
        PUSH    EDI
1775
        PUSH    EBX
1776

1777
        MOV     EBX,RSize
1778
        MOV     EDI,LSize
1779

1780
        CMP     EDI,EBX
1781
        JAE     @SkipSwap
1782
        XCHG    EBX,EDI
1783
        XCHG    EAX,EDX
1784

1785
@SkipSwap:
1786

1787
        MOV     EDI,EBX
1788
        AND     EDI,CUnrollMask
1789
        SHR     EBX,CUnrollShift
1790
        JE      @MainTail
1791

1792
@MainLoop:
1793

1794
        MOV     ESI,[EAX]
1795
        AND     ESI,[EDX]
1796
        MOV     [ECX],ESI
1797

1798
        MOV     ESI,[EAX + CLimbSize]
1799
        AND     ESI,[EDX + CLimbSize]
1800
        MOV     [ECX + CLimbSize],ESI
1801

1802
        MOV     ESI,[EAX + 2*CLimbSize]
1803
        AND     ESI,[EDX + 2*CLimbSize]
1804
        MOV     [ECX + 2*CLimbSize],ESI
1805

1806
        MOV     ESI,[EAX + 3*CLimbSize]
1807
        AND     ESI,[EDX + 3*CLimbSize]
1808
        MOV     [ECX + 3*CLimbSize],ESI
1809

1810
        LEA     EAX,[EAX + 4*CLimbSize]
1811
        LEA     EDX,[EDX + 4*CLimbSize]
1812
        LEA     ECX,[ECX + 4*CLimbSize]
1813
        DEC     EBX
1814
        JNE     @MainLoop
1815

1816
@MainTail:
1817

1818
        LEA     EAX,[EAX + EDI*CLimbSize]
1819
        LEA     EDX,[EDX + EDI*CLimbSize]
1820
        LEA     ECX,[ECX + EDI*CLimbSize]
1821
        LEA     EBX,[@JumpsMain]
1822
        JMP     [EBX + EDI*TYPE Pointer]
1823

1824
        .ALIGN  16
1825

1826
@JumpsMain:
1827

1828
        DD      @Exit
1829
        DD      @Main1
1830
        DD      @Main2
1831
        DD      @Main3
1832

1833
@Main3:
1834

1835
        MOV     ESI,[EAX - 3*CLimbSize]
1836
        AND     ESI,[EDX - 3*CLimbSize]
1837
        MOV     [ECX - 3*CLimbSize],ESI
1838

1839
@Main2:
1840

1841
        MOV     ESI,[EAX - 2*CLimbSize]
1842
        AND     ESI,[EDX - 2*CLimbSize]
1843
        MOV     [ECX - 2*CLimbSize],ESI
1844

1845
@Main1:
1846

1847
        MOV     ESI,[EAX - CLimbSize]
1848
        AND     ESI,[EDX - CLimbSize]
1849
        MOV     [ECX - CLimbSize],ESI
1850

1851
@Exit:
1852

1853
        POP     EBX
1854
        POP     EDI
1855
        POP     ESI
1856
end;
1857
{$ELSE WIN64}
1858
asm
1859
        MOV     R10D,RSize
1860

1861
        CMP     R9D,R10D
1862
        JAE     @SkipSwap
1863
        XCHG    R10D,R9D
1864
        XCHG    RCX,RDX
1865

1866
@SkipSwap:
1867

1868
        MOV     R9D,R10D
1869
        AND     R9D,CUnrollMask
1870
        SHR     R10D,CUnrollShift
1871
        JE      @MainTail
1872

1873
@MainLoop:
1874

1875
        MOV     RAX,[RCX]
1876
        AND     RAX,[RDX]
1877
        MOV     [R8],RAX
1878
        MOV     RAX,[RCX + DLimbSize]
1879
        AND     RAX,[RDX + DLimbSize]
1880
        MOV     [R8 + DLimbSize],RAX
1881
        LEA     RCX,[RCX + 2*DLimbSize]
1882
        LEA     RDX,[RDX + 2*DLimbSize]
1883
        LEA     R8,[R8 + 2*DLimbSize]
1884
        DEC     R10D
1885
        JNE     @MainLoop
1886

1887
@MainTail:
1888

1889
        LEA     RCX,[RCX + R9*CLimbSize]
1890
        LEA     RDX,[RDX + R9*CLimbSize]
1891
        LEA     R8,[R8 + R9*CLimbSize]
1892
        LEA     R10,[@JumpsMain]
1893
        JMP     [R10 + R9*TYPE Pointer]
1894

1895
        .ALIGN  16
1896

1897
@JumpsMain:
1898

1899
        DQ      @Exit
1900
        DQ      @Main1
1901
        DQ      @Main2
1902
        DQ      @Main3
1903

1904
@Main3:
1905

1906
        MOV     EAX,[RCX - 3*CLimbSize]
1907
        AND     EAX,[RDX - 3*CLimbSize]
1908
        MOV     [R8 - 3*CLimbSize],EAX
1909

1910
@Main2:
1911

1912
        MOV     EAX,[RCX - 2*CLimbSize]
1913
        AND     EAX,[RDX - 2*CLimbSize]
1914
        MOV     [R8 - 2*CLimbSize],EAX
1915

1916
@Main1:
1917

1918
        MOV     EAX,[RCX - CLimbSize]
1919
        AND     EAX,[RDX - CLimbSize]
1920
        MOV     [R8 - CLimbSize],EAX
1921

1922
@Exit:
1923

1924
end;
1925
{$ENDIF WIN64}
1926
{$ENDIF !PUREPASCAL}
1927

1928
class procedure BigInteger.InternalXor(Left, Right, Result: PLimb; LSize, RSize: Integer);
1929
{$IFDEF PUREPASCAL}
1930
var
1931
  I: Integer;
1932
begin
1933
  if LSize < RSize then
1934
  begin
1935
    SwapIntegers(LSize, RSize);
1936
    SwapPLimbs(Left, Right);
1937
  end;
1938
  for I := 0 to RSize - 1 do
1939
    Result[I] := Left[I] xor Right[I];
1940
  for I := RSize to LSize - 1 do
1941
    Result[I] := Left[I];
1942
end;
1943
{$ELSE !PUREPASCAL}
1944
{$IFDEF WIN32}
1945
asm
1946
        PUSH    ESI
1947
        PUSH    EDI
1948
        PUSH    EBX
1949

1950
        MOV     EBX,RSize
1951
        MOV     EDI,LSize
1952

1953
        CMP     EDI,EBX
1954
        JAE     @SkipSwap
1955
        XCHG    EBX,EDI
1956
        XCHG    EAX,EDX
1957

1958
@SkipSwap:
1959

1960
        SUB     EDI,EBX
1961
        PUSH    EDI                             // Number of "tail" loops
1962
        MOV     EDI,EBX
1963
        AND     EDI,CUnrollMask
1964
        SHR     EBX,CUnrollShift
1965
        JE      @MainTail
1966

1967
@MainLoop:
1968

1969
        MOV     ESI,[EAX]
1970
        XOR     ESI,[EDX]
1971
        MOV     [ECX],ESI
1972

1973
        MOV     ESI,[EAX + CLimbSize]
1974
        XOR     ESI,[EDX + CLimbSize]
1975
        MOV     [ECX + CLimbSize],ESI
1976

1977
        MOV     ESI,[EAX + 2*CLimbSize]
1978
        XOR     ESI,[EDX + 2*CLimbSize]
1979
        MOV     [ECX + 2*CLimbSize],ESI
1980

1981
        MOV     ESI,[EAX + 3*CLimbSize]
1982
        XOR     ESI,[EDX + 3*CLimbSize]
1983
        MOV     [ECX + 3*CLimbSize],ESI
1984

1985
        LEA     EAX,[EAX + 4*CLimbSize]
1986
        LEA     EDX,[EDX + 4*CLimbSize]
1987
        LEA     ECX,[ECX + 4*CLimbSize]
1988
        DEC     EBX
1989
        JNE     @MainLoop
1990

1991
@MainTail:
1992

1993
        LEA     EAX,[EAX + EDI*CLimbSize]
1994
        LEA     EDX,[EDX + EDI*CLimbSize]
1995
        LEA     ECX,[ECX + EDI*CLimbSize]
1996
        LEA     EBX,[@JumpsMain]
1997
        JMP     [EBX + EDI*TYPE Pointer]
1998

1999
        .ALIGN  16
2000

2001
@JumpsMain:
2002

2003
        DD      @DoRestLoop
2004
        DD      @Main1
2005
        DD      @Main2
2006
        DD      @Main3
2007

2008
@Main3:
2009

2010
        MOV     ESI,[EAX - 3*CLimbSize]
2011
        XOR     ESI,[EDX - 3*CLimbSize]
2012
        MOV     [ECX - 3*CLimbSize],ESI
2013

2014
@Main2:
2015

2016
        MOV     ESI,[EAX - 2*CLimbSize]
2017
        XOR     ESI,[EDX - 2*CLimbSize]
2018
        MOV     [ECX - 2*CLimbSize],ESI
2019

2020
@Main1:
2021

2022
        MOV     ESI,[EAX - CLimbSize]
2023
        XOR     ESI,[EDX - CLimbSize]
2024
        MOV     [ECX - CLimbSize],ESI
2025

2026
@DoRestLoop:
2027

2028
        XOR     EDX,EDX
2029
        POP     EBX
2030
        MOV     EDI,EBX
2031
        AND     EDI,CUnrollMask
2032
        SHR     EBX,CunrollShift
2033
        JE      @RestLast3
2034

2035
@RestLoop:
2036

2037
        MOV     EDX,[EAX]
2038
        MOV     [ECX],EDX
2039

2040
        MOV     EDX,[EAX + CLimbSize]
2041
        MOV     [ECX + CLimbSize],EDX
2042

2043
        MOV     EDX,[EAX + 2*CLimbSize]
2044
        MOV     [ECX + 2*CLimbSize],EDX
2045

2046
        MOV     EDX,[EAX + 3*CLimbSize]
2047
        MOV     [ECX + 3*CLimbSize],EDX
2048

2049
        LEA     EAX,[EAX + 4*CLimbSize]
2050
        LEA     ECX,[ECX + 4*CLimbSize]
2051
        DEC     EBX
2052
        JNE     @RestLoop
2053

2054
@RestLast3:
2055

2056
        LEA     EAX,[EAX + EDI*CLimbSize]
2057
        LEA     ECX,[ECX + EDI*CLimbSize]
2058
        LEA     EBX,[@RestJumps]
2059
        JMP     [EBX + EDI*TYPE Pointer]
2060

2061
        .ALIGN  16
2062

2063
@RestJumps:
2064

2065
        DD      @Exit
2066
        DD      @Rest1
2067
        DD      @Rest2
2068
        DD      @Rest3
2069

2070
@Rest3:
2071

2072
        MOV     EDX,[EAX - 3*CLimbSize]
2073
        MOV     [ECX - 3*CLimbSize],EDX
2074

2075
@Rest2:
2076

2077
        MOV     EDX,[EAX - 2*CLimbSize]
2078
        MOV     [ECX - 2*CLimbSize],EDX
2079

2080
@Rest1:
2081

2082
        MOV     EDX,[EAX - CLimbSize]
2083
        MOV     [ECX - CLimbSize],EDX
2084

2085
@Exit:
2086

2087
        POP     EBX
2088
        POP     EDI
2089
        POP     ESI
2090
end;
2091
{$ELSE WIN64}
2092
asm
2093
        MOV     R10D,RSize
2094

2095
        CMP     R9D,R10D
2096
        JAE     @SkipSwap
2097
        XCHG    R10D,R9D
2098
        XCHG    RCX,RDX
2099

2100
@SkipSwap:
2101

2102
        SUB     R9D,R10D
2103
        PUSH    R9
2104
        MOV     R9D,R10D
2105
        AND     R9D,CUnrollMask
2106
        SHR     R10D,CUnrollShift
2107
        JE      @MainTail
2108

2109
@MainLoop:
2110

2111
        MOV     RAX,[RCX]
2112
        XOR     RAX,[RDX]
2113
        MOV     [R8],RAX
2114

2115
        MOV     RAX,[RCX + DLimbSize]
2116
        XOR     RAX,[RDX + DLimbSize]
2117
        MOV     [R8 + DLimbSize],RAX
2118

2119
        LEA     RCX,[RCX + 2*DLimbSize]
2120
        LEA     RDX,[RDX + 2*DLimbSize]
2121
        LEA     R8,[R8 + 2*DLimbSize]
2122
        DEC     R10D
2123
        JNE     @MainLoop
2124

2125
@MainTail:
2126

2127
        LEA     RCX,[RCX + R9*CLimbSize]
2128
        LEA     RDX,[RDX + R9*CLimbSize]
2129
        LEA     R8,[R8 + R9*CLimbSize]
2130
        LEA     R10,[@JumpsMain]
2131
        JMP     [R10 + R9*TYPE Pointer]
2132

2133
@JumpsMain:
2134

2135
        DQ      @DoRestLoop
2136
        DQ      @Main1
2137
        DQ      @Main2
2138
        DQ      @Main3
2139

2140
@Main3:
2141

2142
        MOV     EAX,[RCX - 3*CLimbSize]
2143
        XOR     EAX,[RDX - 3*CLimbSize]
2144
        MOV     [R8 - 3*CLimbSize],EAX
2145

2146
@Main2:
2147

2148
        MOV     EAX,[RCX - 2*CLimbSize]
2149
        XOR     EAX,[RDX - 2*CLimbSize]
2150
        MOV     [R8 - 2*CLimbSize],EAX
2151

2152
@Main1:
2153

2154
        MOV     EAX,[RCX - CLimbSize]
2155
        XOR     EAX,[RDX - CLimbSize]
2156
        MOV     [R8 - CLimbSize],EAX
2157

2158
@DoRestLoop:
2159

2160
        POP     R10
2161
        TEST    R10D,R10D
2162
        JE      @Exit
2163
        MOV     R9D,R10D
2164
        AND     R9D,CUnrollMask
2165
        SHR     R10D,CUnrollShift
2166
        JE      @RestLast3
2167

2168
@RestLoop:
2169

2170
        MOV     RAX,[RCX]
2171
        MOV     [R8],RAX
2172

2173
        MOV     RAX,[RCX + DLimbSize]
2174
        MOV     [R8 + DLimbSize],RAX
2175

2176
        LEA     RCX,[RCX + 2*DLimbSize]
2177
        LEA     R8,[R8 + 2*DLimbSize]
2178
        DEC     R10D
2179
        JNE     @RestLoop
2180

2181
@RestLast3:
2182

2183
        LEA     RCX,[RCX + R9*CLimbSize]
2184
        LEA     R8,[R8 + R9*CLimbSize]
2185
        LEA     R10,[@RestJumps]
2186
        JMP     [R10 + R9*TYPE Pointer]
2187

2188
@RestJumps:
2189

2190
        DQ      @Exit
2191
        DQ      @Rest1
2192
        DQ      @Rest2
2193
        DQ      @Rest3
2194

2195
@Rest3:
2196

2197
        MOV     EAX,[RCX - 3*CLimbSize]
2198
        MOV     [R8 - 3*CLimbSize],EAX
2199

2200
@Rest2:
2201

2202
        MOV     EAX,[RCX - 2*CLimbSize]
2203
        MOV     [R8 - 2*CLimbSize],EAX
2204

2205
@Rest1:
2206

2207
        MOV     EAX,[RCX - CLimbSize]
2208
        MOV     [R8 - CLimbSize],EAX
2209

2210
@Exit:
2211

2212
end;
2213
{$ENDIF WIN64}
2214
{$ENDIF !PUREPASCAL}
2215

2216
class procedure BigInteger.InternalOr(Left, Right, Result: PLimb; LSize, RSize: Integer);
2217
{$IFDEF PUREPASCAL}
2218
var
2219
  I: Integer;
2220
begin
2221
  // Ensure Left/LSize belong to largest BigInteger.
2222
  if LSize < RSize then
2223
  begin
2224
    SwapIntegers(LSize, RSize);
2225
    SwapPLimbs(Left, Right);
2226
  end;
2227
  for I := 0 to RSize - 1 do
2228
    Result[I] := Left[I] or Right[I];
2229
  for I := RSize to LSize - 1 do
2230
    Result[I] := Left[I];
2231
end;
2232
{$ELSE !PUREPASCAL}
2233
{$IFDEF WIN32}
2234
asm
2235
        PUSH    ESI
2236
        PUSH    EDI
2237
        PUSH    EBX
2238

2239
        MOV     EBX,RSize
2240
        MOV     EDI,LSize
2241

2242
        CMP     EDI,EBX
2243
        JAE     @SkipSwap
2244
        XCHG    EBX,EDI
2245
        XCHG    EAX,EDX
2246

2247
@SkipSwap:
2248

2249
        SUB     EDI,EBX
2250
        PUSH    EDI                             // Number of "rest" loops
2251
        MOV     EDI,EBX
2252
        AND     EDI,CUnrollMask
2253
        SHR     EBX,CUnrollShift
2254
        JE      @MainTail
2255

2256
@MainLoop:
2257

2258
        MOV     ESI,[EAX]
2259
        OR      ESI,[EDX]
2260
        MOV     [ECX],ESI
2261

2262
        MOV     ESI,[EAX + CLimbSize]
2263
        OR      ESI,[EDX + CLimbSize]
2264
        MOV     [ECX + CLimbSize],ESI
2265

2266
        MOV     ESI,[EAX + 2*CLimbSize]
2267
        OR      ESI,[EDX + 2*CLimbSize]
2268
        MOV     [ECX + 2*CLimbSize],ESI
2269

2270
        MOV     ESI,[EAX + 3*CLimbSize]
2271
        OR      ESI,[EDX + 3*CLimbSize]
2272
        MOV     [ECX + 3*CLimbSize],ESI
2273

2274
        LEA     EAX,[EAX + 4*CLimbSize]
2275
        LEA     EDX,[EDX + 4*CLimbSize]
2276
        LEA     ECX,[ECX + 4*CLimbSize]
2277
        DEC     EBX
2278
        JNE     @MainLoop
2279

2280
@MainTail:
2281

2282
        LEA     EAX,[EAX + EDI*CLimbSize]
2283
        LEA     EDX,[EDX + EDI*CLimbSize]
2284
        LEA     ECX,[ECX + EDI*CLimbSize]
2285
        LEA     EBX,[@JumpsMain]
2286
        JMP     [EBX + EDI*TYPE Pointer]
2287

2288
        .ALIGN  16
2289

2290
@JumpsMain:
2291

2292
        DD      @DoRestLoop
2293
        DD      @Main1
2294
        DD      @Main2
2295
        DD      @Main3
2296

2297
@Main3:
2298

2299
        MOV     ESI,[EAX - 3*CLimbSize]
2300
        OR      ESI,[EDX - 3*CLimbSize]
2301
        MOV     [ECX - 3*CLimbSize],ESI
2302

2303
@Main2:
2304

2305
        MOV     ESI,[EAX - 2*CLimbSize]
2306
        OR      ESI,[EDX - 2*CLimbSize]
2307
        MOV     [ECX - 2*CLimbSize],ESI
2308

2309
@Main1:
2310

2311
        MOV     ESI,[EAX - CLimbSize]
2312
        OR      ESI,[EDX - CLimbSize]
2313
        MOV     [ECX - CLimbSize],ESI
2314

2315
@DoRestLoop:
2316

2317
        XOR     EDX,EDX
2318
        POP     EBX
2319
        MOV     EDI,EBX
2320
        AND     EDI,CUnrollMask
2321
        SHR     EBX,CUnrollShift
2322
        JE      @RestLast3
2323

2324
@RestLoop:
2325

2326
        MOV     EDX,[EAX]
2327
        MOV     [ECX],EDX
2328

2329
        MOV     EDX,[EAX + CLimbSize]
2330
        MOV     [ECX + CLimbSize],EDX
2331

2332
        MOV     EDX,[EAX + 2*CLimbSize]
2333
        MOV     [ECX + 2*CLimbSize],EDX
2334

2335
        MOV     EDX,[EAX + 3*CLimbSize]
2336
        MOV     [ECX + 3*CLimbSize],EDX
2337

2338
        LEA     EAX,[EAX + 4*CLimbSize]
2339
        LEA     ECX,[ECX + 4*CLimbSize]
2340
        DEC     EBX
2341
        JNE     @RestLoop
2342

2343
@RestLast3:
2344

2345
        LEA     EAX,[EAX + EDI*CLimbSize]
2346
        LEA     ECX,[ECX + EDI*CLimbSize]
2347
        LEA     EBX,[@RestJumps]
2348
        JMP     [EBX + EDI*TYPE Pointer]
2349

2350
        .ALIGN  16
2351

2352
@RestJumps:
2353

2354
        DD      @Exit
2355
        DD      @Rest1
2356
        DD      @Rest2
2357
        DD      @Rest3
2358

2359
@Rest3:
2360

2361
        MOV     EDX,[EAX - 3*CLimbSize]
2362
        MOV     [ECX - 3*CLimbSize],EDX
2363

2364
@Rest2:
2365

2366
        MOV     EDX,[EAX - 2*CLimbSize]
2367
        MOV     [ECX - 2*CLimbSize],EDX
2368

2369
@Rest1:
2370

2371
        MOV     EDX,[EAX - CLimbSize]
2372
        MOV     [ECX - CLimbSize],EDX
2373

2374
@Exit:
2375

2376
        POP     EBX
2377
        POP     EDI
2378
        POP     ESI
2379
end;
2380
{$ELSE WIN64}
2381
asm
2382
        MOV     R10D,RSize
2383

2384
        CMP     R9D,R10D
2385
        JAE     @SkipSwap
2386
        XCHG    R10D,R9D
2387
        XCHG    RCX,RDX
2388

2389
@SkipSwap:
2390

2391
        SUB     R9D,R10D
2392
        PUSH    R9
2393
        MOV     R9D,R10D
2394
        AND     R9D,CUnrollMask
2395
        SHR     R10D,CUnrollShift
2396
        JE      @MainTail
2397

2398
@MainLoop:
2399

2400
        MOV     RAX,[RCX]
2401
        OR      RAX,[RDX]
2402
        MOV     [R8],RAX
2403

2404
        MOV     RAX,[RCX + DLimbSize]
2405
        OR      RAX,[RDX + DLimbSize]
2406
        MOV     [R8 + DLimbSize],RAX
2407

2408
        LEA     RCX,[RCX + 2*DLimbSize]
2409
        LEA     RDX,[RDX + 2*DLimbSize]
2410
        LEA     R8,[R8 + 2*DLimbSize]
2411
        DEC     R10D
2412
        JNE     @MainLoop
2413

2414
@MainTail:
2415

2416
        LEA     RCX,[RCX + R9*CLimbSize]
2417
        LEA     RDX,[RDX + R9*CLimbSize]
2418
        LEA     R8,[R8 + R9*CLimbSize]
2419
        LEA     R10,[@JumpsMain]
2420
        JMP     [R10 + R9*TYPE Pointer]
2421

2422
        // Align jump table manually, with NOPs.
2423

2424
        DB      $90,$90,$90,$90,$90,$90
2425

2426
@JumpsMain:
2427

2428
        DQ      @DoRestLoop
2429
        DQ      @Main1
2430
        DQ      @Main2
2431
        DQ      @Main3
2432

2433
@Main3:
2434

2435
        MOV     EAX,[RCX - 3*CLimbSize]
2436
        OR      EAX,[RDX - 3*CLimbSize]
2437
        MOV     [R8 - 3*CLimbSize],EAX
2438

2439
@Main2:
2440

2441
        MOV     EAX,[RCX - 2*CLimbSize]
2442
        OR      EAX,[RDX - 2*CLimbSize]
2443
        MOV     [R8 - 2*CLimbSize],EAX
2444

2445
@Main1:
2446

2447
        MOV     EAX,[RCX - CLimbSize]
2448
        OR      EAX,[RDX - CLimbSize]
2449
        MOV     [R8 - CLimbSize],EAX
2450

2451
@DoRestLoop:
2452

2453
        POP     R10
2454
        TEST    R10D,R10D
2455
        JE      @Exit
2456
        MOV     R9D,R10D
2457
        AND     R9D,CUnrollMask
2458
        SHR     R10D,CUnrollShift
2459
        JE      @RestLast3
2460

2461
@RestLoop:
2462

2463
        MOV     RAX,[RCX]
2464
        MOV     [R8],RAX
2465

2466
        MOV     RAX,[RCX + DLimbSize]
2467
        MOV     [R8 + DLimbSize],RAX
2468

2469
        LEA     RCX,[RCX + 2*DLimbSize]
2470
        LEA     R8,[R8 + 2*DLimbSize]
2471
        DEC     R10D
2472
        JNE     @RestLoop
2473

2474
@RestLast3:
2475

2476
        LEA     RCX,[RCX + R9*CLimbSize]
2477
        LEA     R8,[R8 + R9*CLimbSize]
2478
        LEA     R10,[@RestJumps]
2479
        JMP     [R10 + R9*TYPE Pointer]
2480

2481
        // Align jump table manually, with NOPs.
2482

2483
        // -- Aligned.
2484

2485
@RestJumps:
2486

2487
        DQ      @Exit
2488
        DQ      @Rest1
2489
        DQ      @Rest2
2490
        DQ      @Rest3
2491

2492
@Rest3:
2493

2494
        MOV     EAX,[RCX - 3*CLimbSize]
2495
        MOV     [R8 - 3*CLimbSize],EAX
2496

2497
@Rest2:
2498

2499
        MOV     EAX,[RCX - 2*CLimbSize]
2500
        MOV     [R8 - 2*CLimbSize],EAX
2501

2502
@Rest1:
2503

2504
        MOV     EAX,[RCX - CLimbSize]
2505
        MOV     [R8 - CLimbSize],EAX
2506

2507
@Exit:
2508

2509
end;
2510
{$ENDIF WIN64}
2511
{$ENDIF !PUREPASCAL}
2512

2513
class procedure BigInteger.InternalAndNot(Left, Right, Result: PLimb; LSize, RSize: Integer);
2514
{$IFDEF PUREPASCAL}
2515
var
2516
  I: Integer;
2517
begin
2518

2519
  // Note: AndNot is - of course - not commutative.
2520
  if LSize < RSize then
2521
    RSize := LSize;
2522
  for I := 0 to RSize - 1 do
2523
    Result[I] := not Right[I] and Left[I];
2524
  for I := RSize to LSize - 1 do
2525
    Result[I] := Left[I];
2526
end;
2527
{$ELSE !PUREPASCAL}
2528
{$IFDEF WIN32}
2529
asm
2530
        PUSH    ESI
2531
        PUSH    EDI
2532
        PUSH    EBX
2533

2534
        MOV     EBX,RSize
2535
        MOV     EDI,LSize
2536

2537
        CMP     EDI,EBX
2538
        JAE     @SkipSwap
2539
        MOV     EBX,EDI
2540

2541
@SkipSwap:
2542

2543
        SUB     EDI,EBX
2544
        PUSH    EDI                             // Number of "rest" loops
2545
        MOV     EDI,EBX
2546
        AND     EDI,CUnrollMask
2547
        SHR     EBX,CUnrollShift
2548
        JE      @MainTail
2549

2550
@MainLoop:
2551

2552
        MOV     ESI,[EDX]
2553
        NOT     ESI
2554
        AND     ESI,[EAX]
2555
        MOV     [ECX],ESI
2556

2557
        MOV     ESI,[EDX + CLimbSize]
2558
        NOT     ESI
2559
        AND     ESI,[EAX + CLimbSize]
2560
        MOV     [ECX + CLimbSize],ESI
2561

2562
        MOV     ESI,[EDX + 2*CLimbSize]
2563
        NOT     ESI
2564
        AND     ESI,[EAX + 2*CLimbSize]
2565
        MOV     [ECX + 2*CLimbSize],ESI
2566

2567
        MOV     ESI,[EDX + 3*CLimbSize]
2568
        NOT     ESI
2569
        AND     ESI,[EAX + 3*CLimbSize]
2570
        MOV     [ECX + 3*CLimbSize],ESI
2571

2572
        LEA     EAX,[EAX + 4*CLimbSize]
2573
        LEA     EDX,[EDX + 4*CLimbSize]
2574
        LEA     ECX,[ECX + 4*CLimbSize]
2575
        DEC     EBX
2576
        JNE     @MainLoop
2577

2578
@MainTail:
2579

2580
        LEA     EAX,[EAX + EDI*CLimbSize]
2581
        LEA     EDX,[EDX + EDI*CLimbSize]
2582
        LEA     ECX,[ECX + EDI*CLimbSize]
2583
        LEA     EBX,[@JumpsMain]
2584
        JMP     [EBX + EDI*TYPE Pointer]
2585

2586
        .ALIGN  16
2587

2588
@JumpsMain:
2589

2590
        DD      @DoRestLoop
2591
        DD      @Main1
2592
        DD      @Main2
2593
        DD      @Main3
2594

2595
@Main3:
2596

2597
        MOV     ESI,[EDX - 3*CLimbSize]
2598
        NOT     ESI
2599
        AND     ESI,[EAX - 3*CLimbSize]
2600
        MOV     [ECX - 3*CLimbSize],ESI
2601

2602
@Main2:
2603

2604
        MOV     ESI,[EDX - 2*CLimbSize]
2605
        NOT     ESI
2606
        AND     ESI,[EAX - 2*CLimbSize]
2607
        MOV     [ECX - 2*CLimbSize],ESI
2608

2609
@Main1:
2610

2611
        MOV     ESI,[EDX - CLimbSize]
2612
        NOT     ESI
2613
        AND     ESI,[EAX - CLimbSize]
2614
        MOV     [ECX - CLimbSize],ESI
2615

2616
@DoRestLoop:
2617

2618
        XOR     EDX,EDX
2619
        POP     EBX
2620
        MOV     EDI,EBX
2621
        AND     EDI,CUnrollMask
2622
        SHR     EBX,CUnrollShift
2623
        JE      @RestLast3
2624

2625
@RestLoop:
2626

2627
        //      X AND NOT 0 = X AND -1 = X
2628
        MOV     EDX,[EAX]
2629
        MOV     [ECX],EDX
2630

2631
        MOV     EDX,[EAX + CLimbSize]
2632
        MOV     [ECX + CLimbSize],EDX
2633

2634
        MOV     EDX,[EAX + 2*CLimbSize]
2635
        MOV     [ECX + 2*CLimbSize],EDX
2636

2637
        MOV     EDX,[EAX + 3*CLimbSize]
2638
        MOV     [ECX + 3*CLimbSize],EDX
2639

2640
        LEA     EAX,[EAX + 4*CLimbSize]
2641
        LEA     ECX,[ECX + 4*CLimbSize]
2642
        DEC     EBX
2643
        JNE     @RestLoop
2644

2645
@RestLast3:
2646

2647
        LEA     EAX,[EAX + EDI*CLimbSize]
2648
        LEA     ECX,[ECX + EDI*CLimbSize]
2649
        LEA     EBX,[@RestJumps]
2650
        JMP     [EBX + EDI*TYPE Pointer]
2651

2652
        // Align jump table manually, with NOPs.
2653

2654
@RestJumps:
2655

2656
        DD      @Exit
2657
        DD      @Rest1
2658
        DD      @Rest2
2659
        DD      @Rest3
2660

2661
@Rest3:
2662

2663
        MOV     EDX,[EAX - 3*CLimbSize]
2664
        MOV     [ECX - 3*CLimbSize],EDX
2665

2666
@Rest2:
2667

2668
        MOV     EDX,[EAX - 2*CLimbSize]
2669
        MOV     [ECX - 2*CLimbSize],EDX
2670

2671
@Rest1:
2672

2673
        MOV     EDX,[EAX - CLimbSize]
2674
        MOV     [ECX - CLimbSize],EDX
2675

2676
@Exit:
2677

2678
        POP     EBX
2679
        POP     EDI
2680
        POP     ESI
2681
end;
2682
{$ELSE WIN64}
2683
asm
2684
        MOV     R10D,RSize
2685

2686
        CMP     R9D,R10D
2687
        JAE     @SkipSwap
2688
        MOV     R10D,R9D
2689

2690
@SkipSwap:
2691

2692
        SUB     R9D,R10D
2693
        PUSH    R9
2694
        MOV     R9D,R10D
2695
        AND     R9D,CUnrollMask
2696
        SHR     R10D,CUnrollShift
2697
        JE      @MainTail
2698

2699
@MainLoop:
2700

2701
        MOV     RAX,[RDX]
2702
        NOT     RAX
2703
        AND     RAX,[RCX]
2704
        MOV     [R8],RAX
2705

2706
        MOV     RAX,[RDX + DLimbSize]
2707
        NOT     RAX
2708
        AND     RAX,[RCX + DLimbSize]
2709
        MOV     [R8 + DLimbSize],RAX
2710

2711
        LEA     RCX,[RCX + 2*DLimbSize]
2712
        LEA     RDX,[RDX + 2*DLimbSize]
2713
        LEA     R8,[R8 + 2*DLimbSize]
2714
        DEC     R10D
2715
        JNE     @MainLoop
2716

2717
@MainTail:
2718

2719
        LEA     RCX,[RCX + R9*CLimbSize]
2720
        LEA     RDX,[RDX + R9*CLimbSize]
2721
        LEA     R8,[R8 + R9*CLimbSize]
2722
        LEA     R10,[@JumpsMain]
2723
        JMP     [R10 + R9*TYPE Pointer]
2724

2725
        // Align jump table manually, with NOPs.
2726

2727
        DB      $90,$90,$90
2728

2729
@JumpsMain:
2730

2731
        DQ      @DoRestLoop
2732
        DQ      @Main1
2733
        DQ      @Main2
2734
        DQ      @Main3
2735

2736
@Main3:
2737

2738
        MOV     EAX,[RDX - 3*CLimbSize]
2739
        NOT     EAX
2740
        AND     EAX,[RCX - 3*CLimbSize]
2741
        MOV     [R8 - 3*CLimbSize],EAX
2742

2743
@Main2:
2744

2745
        MOV     EAX,[RDX - 2*CLimbSize]
2746
        NOT     EAX
2747
        AND     EAX,[RCX - 2*CLimbSize]
2748
        MOV     [R8 - 2*CLimbSize],EAX
2749

2750
@Main1:
2751

2752
        MOV     EAX,[RDX - CLimbSize]
2753
        NOT     EAX
2754
        AND     EAX,[RCX - CLimbSize]
2755
        MOV     [R8 - CLimbSize],EAX
2756

2757
@DoRestLoop:
2758

2759
        POP     R10
2760
        TEST    R10D,R10D
2761
        JE      @Exit
2762
        MOV     R9D,R10D
2763
        AND     R9D,CUnrollMask
2764
        SHR     R10D,CUnrollShift
2765
        JE      @RestLast3
2766

2767
@RestLoop:
2768

2769
        //      X AND NOT 0 = X AND -1 = X
2770

2771
        MOV     RAX,[RCX]
2772
        MOV     RDX,[RCX + DLimbSize]
2773
        MOV     [R8],RAX
2774
        MOV     [R8 + DLimbSize],RDX
2775

2776
        LEA     RCX,[RCX + 2*DLimbSize]
2777
        LEA     R8,[R8 + 2*DLimbSize]
2778
        DEC     R10D
2779
        JNE     @RestLoop
2780

2781
@RestLast3:
2782

2783
        LEA     RCX,[RCX + R9*CLimbSize]
2784
        LEA     R8,[R8 + R9*CLimbSize]
2785
        LEA     R10,[@RestJumps]
2786
        JMP     [R10 + R9*TYPE Pointer]
2787

2788
        // Align jump table manually, with NOPs.
2789

2790
        DB      $90,$90
2791

2792
@RestJumps:
2793

2794
        DQ      @Exit
2795
        DQ      @Rest1
2796
        DQ      @Rest2
2797
        DQ      @Rest3
2798

2799
@Rest3:
2800

2801
        MOV     EAX,[RCX - 3*CLimbSize]
2802
        MOV     [R8 - 3*CLimbSize],EAX
2803

2804
@Rest2:
2805

2806
        MOV     EAX,[RCX - 2*CLimbSize]
2807
        MOV     [R8 - 2*CLimbSize],EAX
2808

2809
@Rest1:
2810

2811
        MOV     EAX,[RCX - CLimbSize]
2812
        MOV     [R8 - CLimbSize],EAX
2813

2814
@Exit:
2815

2816
end;
2817
{$ENDIF WIN64}
2818
{$ENDIF !PUREPASCAL}
2819

2820
class procedure BigInteger.InternalNotAnd(Left, Right, Result: PLimb; LSize, RSize: Integer);
2821
begin
2822
  InternalAndNot(Right, Left, Result, RSize, LSize);
2823
end;
2824

2825
class operator BigInteger.BitwiseAnd(const Left, Right: BigInteger): BigInteger;
2826
begin
2827

2828
  // Special handling for 0.
2829
  if (Left.FData = nil)  or (Right.FData = nil) then
2830
  begin
2831
    Result.FData := nil;
2832
    Result.FSize := 0;
2833
    Exit;
2834
  end;
2835

2836
  InternalBitwise(Left, Right, Result, InternalAnd, InternalOr, InternalAndNot);
2837
end;
2838

2839
class operator BigInteger.BitwiseOr(const Left, Right: BigInteger): BigInteger;
2840
begin
2841

2842
  // Special handling for 0.
2843
  if Left.FData = nil then
2844
  begin
2845
    Result.FSize := Right.FSize;
2846
    Result.FData := Right.FData;
2847
    Exit;
2848
  end
2849
  else if Right.FData = nil then
2850
  begin
2851
    Result.FSize := Left.FSize;
2852
    Result.FData := Left.FData;
2853
    Exit;
2854
  end;
2855

2856
  InternalBitwise(Left, Right, Result, InternalOr, InternalAnd, InternalNotAnd);
2857
end;
2858

2859
class operator BigInteger.BitwiseXor(const Left, Right: BigInteger): BigInteger;
2860
begin
2861

2862
  // Special handling for 0.
2863
  if Left.FData = nil then
2864
  begin
2865
    ShallowCopy(Right, Result);
2866
    Exit;
2867
  end
2868
  else if Right.FData = nil then
2869
  begin
2870
    ShallowCopy(Left, Result);
2871
    Exit;
2872
  end;
2873

2874
  InternalBitwise(Left, Right, Result, InternalXor, InternalXor, InternalXor);
2875
end;
2876

2877
function BigInteger.Clone: BigInteger;
2878
begin
2879
  DeepCopy(Self, Result);
2880
end;
2881

2882
class procedure BigInteger.Compact(var Data: TMagnitude; var Size: Integer);
2883
var
2884
  NewSize: Integer;
2885
begin
2886
  if Data = nil then
2887
  begin
2888
    Size := 0;
2889
    Exit;
2890
  end;
2891

2892
  NewSize := ActualSize(PLimb(Data), Size and SizeMask);
2893
  if NewSize < (Size and SizeMask) then
2894
  begin
2895
    if NewSize = 0 then
2896
    begin
2897
      Size := 0;
2898
      Data := nil;
2899
    end
2900
    else
2901
    begin
2902
      Size := SignBitOf(Size) or NewSize;
2903
    {$IFDEF RESETSIZE}
2904
      SetLength(Data, (NewSize + 4) and CapacityMask);
2905
    {$ENDIF}
2906
    end;
2907
  end;
2908
end;
2909

2910
procedure BigInteger.Compact;
2911
begin
2912
  Compact(FData, FSize);
2913
end;
2914

2915
class function BigInteger.Compare(const Left, Right: BigInteger): Integer;
2916
const
2917
  Results: array[Boolean] of Integer = (-1, 1);
2918
var
2919
  LSize, RSize: Integer;
2920
begin
2921
  if Left.FData = nil then
2922
    if Right.FData = nil then
2923
      Exit(0)                           // Compare(0, 0) = 0
2924
    else
2925
      Exit(Results[Right.FSize < 0])    // Compare(0, negative) = 1
2926
  else if Right.FData = nil then
2927
    Exit(Results[Left.FSize > 0]);      // Compare(positive, 0) = 1
2928

2929
  if ((Left.FSize xor Right.FSize) and SignMask) <> 0 then
2930
    Exit(Results[Left.FSize > 0]);      // Compare(positive, negative) = 1; Compare(negative, positive) = -1
2931

2932
  // Same sign:
2933
  LSize := Left.FSize and SizeMask;
2934
  RSize := Right.FSize and SizeMask;
2935
  Result := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize);
2936

2937
  if Left.FSize < 0 then
2938
      Result := -Result;
2939
end;
2940

2941
constructor BigInteger.Create(const Value: BigInteger);
2942
begin
2943
  Self.FSize := Value.FSize;
2944
  Self.FData := Value.FData;
2945
end;
2946

2947
constructor BigInteger.Create(const Magnitude: TMagnitude; Negative: Boolean);
2948
begin
2949
  FSize := Length(Magnitude) or (Ord(Negative) * SignMask);
2950
  FData := Copy(Magnitude);     // Must copy; otherwise modifying magnitude would modify this BigInteger.
2951
  Compact;
2952
end;
2953

2954
constructor BigInteger.Create(const Value: Int32);
2955
begin
2956
  if (Value >= Low(ValueCache)) and (Value <= High(ValueCache)) then
2957
    Self := ValueCache[Value]
2958
  else
2959
  begin
2960
    Create(UInt32(System.Abs(Value)));
2961
    if Value < 0 then
2962
      FSize := FSize or SignMask;
2963
    Compact;
2964
  end;
2965
end;
2966

2967
constructor BigInteger.Create(const Value: Int64);
2968
begin
2969
  if (Value >= Low(ValueCache)) and (Value <= High(ValueCache)) then
2970
    Self := ValueCache[Value]
2971
  else
2972
  begin
2973
    Create(UInt64(System.Abs(Value)));
2974
    if Value < 0 then
2975
      FSize := FSize or SignMask;
2976
    Compact;
2977
  end;
2978
end;
2979

2980
constructor BigInteger.Create(const Value: Cardinal);
2981
begin
2982
  if Value <= UInt32(High(ValueCache)) then
2983
    Self := ValueCache[Value]
2984
  else
2985
  begin
2986
    if Value <> 0 then
2987
    begin
2988
      FSize := 1;
2989
      SetLength(FData, 4);
2990
      FData[0] := Value;
2991
    end
2992
    else
2993
    begin
2994
      FData := nil;
2995
      FSize := 0;
2996
    end;
2997
    Compact;
2998
  end;
2999
end;
3000

3001
constructor BigInteger.Create(const Value: UInt64);
3002
begin
3003
  if Value <= High(ValueCache) then
3004
    Self := ValueCache[Value]
3005
  else
3006
  begin
3007
    FData := nil;
3008
    if Value <> 0 then
3009
    begin
3010
      if Value > High(UInt32) then
3011
        FSize := CUInt64Limbs
3012
      else
3013
        FSize := 1;
3014
      SetLength(FData, 4);
3015
      Move(Value, FData[0], SizeOf(Value));
3016
    end
3017
    else
3018
    begin
3019
      FData := nil;
3020
      FSize := 0;
3021
    end;
3022
    Compact;
3023
  end;
3024
end;
3025

3026
const
3027
  CMantissaBits = 52;
3028
  CMaxShift     = 62;
3029

3030
constructor BigInteger.Create(const Value: Double);
3031
var
3032
  Exponent: Integer;
3033
  Mantissa: UInt64;
3034
  Sign, Guard, Round, Sticky: Boolean;
3035
  Shift: Integer;
3036
  ZeroExponentLimit: Integer;
3037
begin
3038
  FSize := 0;
3039
//  FData := nil;
3040

3041
  // Error for special values.
3042
  if IsNan(Value) or IsInfinite(Value) then
3043
    Error(ecInvalidArgFloat, ['Double']);
3044

3045
  // Get the required values from TDoubleHelper.
3046
  Mantissa := GetSignificand(Value);
3047
  Exponent := GetExponent(Value);
3048
  Sign := PInt64(@Value)^ < 0;
3049

3050
  // Make 0 for denormal values and values < 0.5.
3051
  if FRoundingMode <> rmTruncate then
3052
    ZeroExponentLimit := -1
3053
  else
3054
    ZeroExponentLimit := 0;
3055

3056
  // Denormals and values with small exponent convert to 0.
3057
  if IsDenormal(Value) or (Exponent < ZeroExponentLimit) then
3058
  begin
3059
    Self := BigInteger.Zero;
3060
    Exit;
3061
  end;
3062

3063
  // Internal shift of the mantissa.
3064
  Shift := Exponent;
3065
  if Shift > CMaxShift then
3066
    Shift := CMaxShift;
3067

3068
  // Guard, Round and Sticky bits are used to determine rounding.
3069
  Guard := False;
3070
  Round := False;
3071
  Sticky := False;
3072
  if (FRoundingMode <> rmTruncate) and (Exponent < CMantissaBits) then
3073
  begin
3074
    // Round anything with a fraction >= 0.5 away from 0. No Round and Sticky bits required.
3075
    Guard := ((UInt64(1) shl (CMantissaBits - 1 - Exponent)) and Mantissa) <> 0;
3076

3077
    if FRoundingMode = rmRound then
3078
    begin
3079
      // Only if full rounding (like System.Round() performs) is required: Round any fraction > 0.5 away from 0.
3080
      Round := ((UInt64(1) shl (CMantissaBits - 2 - Exponent)) and Mantissa) <> 0;
3081
      Sticky := ((Int64(-1) shr (Exponent + (64 - CMantissaBits + 2))) and Mantissa) <> 0;
3082
    end;
3083
  end;
3084

3085
  // Shift mantissa left or right to get the most bits out of it before converting to BigInteger.
3086
  if Shift > CMantissaBits then
3087
    Mantissa := Mantissa shl (Shift - CMantissaBits)
3088
  else
3089
    Mantissa := Mantissa shr (CMantissaBits - Shift);
3090

3091
  // Round shifted mantissa.
3092
  if ((RoundingMode = rmSchool) and Guard) or
3093
     ((RoundingMode = rmRound) and (Guard and (Round or Sticky))) then
3094
    Inc(Mantissa);
3095

3096
  // Turn shifted mantissa (a UInt64) into BigInteger.
3097
  Self := 0;
3098
  Self.Create(UInt64(Mantissa));
3099

3100
  // Shift left by the remaining value of the exponent.
3101
  if Exponent > Shift then
3102
    Self := Self shl (Exponent - Shift);
3103
  if Sign then
3104
    FSize := FSize or SignMask;
3105
  Compact;
3106
end;
3107

3108
{$IFNDEF NoAnsi}
3109
constructor BigInteger.Create(const Value: PAnsiChar);
3110
begin
3111
  if not TryParse(string(AnsiString(Value)), Self) then
3112
    Error(ecParse, [string(AnsiString(Value)), 'BigInteger']);
3113
end;
3114
{$ENDIF}
3115

3116
constructor BigInteger.Create(const Value: PWideChar);
3117
begin
3118
  if not TryParse(Value, Self) then
3119
    Error(ecParse, [Value, 'BigInteger']);
3120
end;
3121

3122
// Bytes are considered to contain value in two's complement format.
3123
constructor BigInteger.Create(const Bytes: array of Byte);
3124
var
3125
  Limbs: TMagnitude;
3126
  Negative: Boolean;
3127
begin
3128
  Negative := Bytes[High(Bytes)] > Byte(High(Shortint));
3129
  SetLength(Limbs, (Length(Bytes) + 3) div 4);
3130
  if Negative then
3131
    Limbs[High(Limbs)] := TLimb(-1);
3132
  Move((@Bytes[0])^, PLimb(Limbs)^, Length(Bytes));
3133
  if Negative then
3134
    InternalNegate(PLimb(Limbs), PLimb(Limbs), Length(Limbs));
3135
  Create(Limbs, Negative);
3136
  Compact;
3137
end;
3138

3139
// This assumes sign-magnitude format.
3140
constructor BigInteger.Create(const Limbs: array of TLimb; Negative: Boolean);
3141
var
3142
  LSize: Integer;
3143
begin
3144
  LSize := Length(Limbs);
3145
  if LSize > 0 then
3146
  begin
3147
    MakeSize(LSize);
3148
    FSize := LSize or (Ord(Negative) * SignMask);
3149
    CopyLimbs(@Limbs[0], PLimb(FData), LSize);
3150
    Compact;
3151
  end
3152
  else
3153
    FSize := 0;
3154
end;
3155

3156
constructor BigInteger.Create(NumBits: Integer; Random: TRandom32Proc);
3157
var
3158
  I: Integer;
3159
begin
3160
  if NumBits <= 0 then
3161
  begin
3162
    FSize := 0;
3163
    FData := nil;
3164
    Exit;
3165
  end;
3166

3167
  FSize := (NumBits + CLimbBits - 1) div CLimbBits;
3168
  SetLength(FData, (4 * FSize + 3) div 4);
3169
  for I := 0 to FSize - 1 do
3170
    FData[I] := Random();
3171

3172
  // At most Numbits bits, so mask top limb.
3173
  FData[FSize - 1] := FData[FSize - 1] and (1 shl (NumBits and CLimbBits) - 1);
3174
  Compact;
3175
end;
3176

3177
constructor BigInteger.Create(NumBits: Integer; const Random: IRandom);
3178
var
3179
  Bytes: TArray<Byte>;
3180
  Bits: Byte;
3181
begin
3182
  if NumBits = 0 then
3183
  begin
3184
    ShallowCopy(Zero, Self);
3185
    Exit;
3186
  end;
3187

3188
  SetLength(Bytes, (NumBits + 7) shr 3 + 1);
3189
  Random.NextBytes(Bytes);
3190

3191
  // One byte too many was allocated, to get a top byte of 0, i.e. always positive.
3192
  Bytes[High(Bytes)] := 0;
3193

3194
  // Set bits above required bit length to 0.
3195
  Bits := NumBits and $07;
3196
  if Bits = 0 then
3197
    Bits := 8;
3198
  Bytes[High(Bytes) - 1] := Bytes[High(Bytes) - 1] and ($FF shr (8 - Bits));
3199
  Create(Bytes);
3200
  Compact;
3201
//  Assert(BitLength <= Numbits, Format('BitLength (%d) >= NumBits (%d): %s', [BitLength, NumBits, Self.ToString(2)]));
3202
end;
3203

3204
function BigInteger.GetAllocated: Integer;
3205
begin
3206
  Result := Length(FData);
3207
end;
3208

3209
function BigInteger.IsEven: Boolean;
3210
begin
3211
  Result := IsZero or ((FData[0] and 1) = 0);
3212
end;
3213

3214
function BigInteger.IsNegative: Boolean;
3215
begin
3216
  Result := Assigned(FData) and (FSize < 0);
3217
end;
3218

3219
function BigInteger.IsOne: Boolean;
3220
begin
3221
  Result := Assigned(FData) and (FSize = 1) and (FData[0] = 1);
3222
end;
3223

3224
function BigInteger.IsPositive: Boolean;
3225
begin
3226
  Result := Assigned(FData) and (FSize > 0);
3227
end;
3228

3229
function BigInteger.IsPowerOfTwo: Boolean;
3230
var
3231
  FirstNonZeroIndex: Integer;
3232
  AHigh: Integer;
3233
begin
3234
  AHigh := (FSize and SizeMask) - 1;
3235
  if (FData = nil) or not Velthuis.Numerics.IsPowerOfTwo(FData[AHigh]) then
3236
    Result := False
3237
  else
3238
  begin
3239
    FirstNonZeroIndex := 0;
3240

3241
    // All limbs below top one must be 0
3242
    while FData[FirstNonZeroIndex] = 0 do
3243
      Inc(FirstNonZeroIndex);
3244

3245
    // Top limb must be power of two.
3246
    Result := (FirstNonZeroIndex = AHigh);
3247
  end;
3248
end;
3249

3250
function BigInteger.GetSign: Integer;
3251
begin
3252
  if FData = nil then
3253
  begin
3254
    FSize := 0;
3255
    Exit(0);
3256
  end;
3257

3258
  Result := 2 * Ord(FSize > 0) - 1;
3259
end;
3260

3261
function BigInteger.GetSize: Integer;
3262
begin
3263
  if FData = nil then
3264
    FSize := 0;
3265
  Result := FSize and SizeMask;
3266
end;
3267

3268
function BigInteger.Data: PLimb;
3269
begin
3270
  Result := PLimb(FData);
3271
end;
3272

3273
class operator BigInteger.GreaterThan(const Left, Right: BigInteger): Boolean;
3274
begin
3275
  Result := Compare(Left, Right) > 0;
3276
//  Result := not (Left <= Right);
3277
end;
3278

3279
class operator BigInteger.GreaterThanOrEqual(const Left, Right: BigInteger): Boolean;
3280
begin
3281
  Result := Compare(left, Right) >= 0;
3282
end;
3283

3284
// Divide and Conquer. For N = 100,000, this is 20 x as fast as a plain iterative multiplication.
3285
class function BigInteger.Factorial(N: Integer): BigInteger;
3286

3287
  ////////////////////////////////////////////////////////////////////////////
3288
  // Alternative algorithm:                                                 //
3289
  // [1 2 3 4 5 6 7 8 9] --> [1*9 2*8 3*7 4*6 5] = [9 16 21 24 5]           //
3290
  // [9 16 21 24 5] --> [9*5 16*24 21] = [45 384 21]                        //
3291
  // [45 384 21] --> [45*21 384] = [945 384]                                //
3292
  // Result = 945 * 384 = 362880 = 9!                                       //
3293
  // But that is a little slower than the following and needs an array      //
3294
  // of (N div 2) BigIntegers.                                              //
3295
  ////////////////////////////////////////////////////////////////////////////
3296

3297
  ////////////////////////////////////////////////////////////////////////////
3298
  // Optimization: every even integer is shifted right by 1. The end result //
3299
  // is shifted back by an equal amount of bits (n div 2).                  //
3300
  ////////////////////////////////////////////////////////////////////////////
3301

3302
  function MultiplyRange(First, Last: Integer): BigInteger;
3303
  var
3304
    Split: Integer;
3305
  begin
3306
    if Last - First <= 3 then
3307
    begin
3308
      if Odd(First) then
3309
        case Last - First of
3310
          0: Result := BigInteger(First);
3311
          1: Result := BigInteger(First) * BigInteger(Last shr 1);
3312
          2: Result := BigInteger(First) * BigInteger((First + 1) shr 1) * BigInteger(Last);
3313
          3: Result := BigInteger(First) * BigInteger((First + 1) shr 1) * BigInteger(First + 2) * BigInteger(Last shr 1);
3314
        end
3315
      else
3316
        case Last - First of
3317
          0: Result := BigInteger(First shr 1);
3318
          1: Result := BigInteger(First shr 1) * BigInteger(Last);
3319
          2: Result := BigInteger(First shr 1) * BigInteger(First + 1) * BigInteger(Last shr 1);
3320
          3: Result := BigInteger(First shr 1) * BigInteger(First + 1) * BigInteger(First shr 1 + 1) * BigInteger(Last);
3321
        end;
3322
    end
3323
    else
3324
    begin
3325
      Split := (First + Last) shr 1;
3326
      Result := MultiplyRange(First, Split) * MultiplyRange(Split + 1, Last);
3327
    end;
3328
  end;
3329

3330
begin
3331
  if N <= 0 then
3332
    Result := 0
3333
  else if N = 1 then
3334
    Result := 1
3335
  else
3336
    Result := MultiplyRange(2, N) shl (N shr 1);
3337
end;
3338

3339
// https://www.nayuki.io/page/fast-fibonacci-algorithms
3340
// https://codegolf.stackexchange.com/questions/3191/write-the-fastest-fibonacci
3341
// https://math.stackexchange.com/questions/1124590/need-help-understanding-fibonacci-fast-doubling-proof
3342
class function BigInteger.Fibonacci(N: Integer): BigInteger;
3343

3344
////////////////////////////////////////////////////////////////////////////////////////////////////
3345
// So called "fast doubling". Relies on the following formulas:                                   //
3346
//                                                                                                //
3347
//   fib(2n)     = fib(n)*(2*fib(n+1) – fib(n))                                                       //
3348
//   fib(2n + 1) = fib(n)^2 + fib(n+1)^2                                                          //
3349
//                                                                                                //
3350
// Another method relies on the fact that if we exponentiate the simple matrix below, we get:     //
3351
//                                                                                                //
3352
//   [  1   1  ]^n  = [ fib(n+1)  fib(n)   ]                                                      //
3353
//   [  1   0  ]      [ fib(n)    fib(n-1) ]                                                      //
3354
//                                                                                                //
3355
// Most methods use exponentiation by squaring to exponentiate the matrix. But we must write      //
3356
// a (rather slow?) matrix multiplication algorithm, which generally makes it slower than         //
3357
// fast doubling.                                                                                 //
3358
////////////////////////////////////////////////////////////////////////////////////////////////////
3359

3360
var
3361
  FibOfN, FibOfNPlus1, Temp: BigInteger;
3362
  FibOf2N, FibOf2NPlus1: BigInteger;
3363
  Bit: Integer;
3364
begin
3365
  FibOfN := BigInteger.Zero;
3366
  FibOfNPlus1 := BigInteger.One;
3367
  Bit := HighestOneBit(N);
3368
  Temp := N;
3369
  while Bit <> 0 do
3370
  begin
3371
    FibOf2N := FibOfN * ((FibOfNPlus1 shl 1) - FibOfN);          // fib(2n)     = fib(n) * (2 * fib(n + 1) - fib(n))
3372
    FibOf2NPlus1 := FibOfN * FibOfN + FibOfNPlus1 * FibOfNPlus1; // fib(2n + 1) = fib(n)^2 + fib(n + 1)^2
3373
    FibOfN := FibOf2N;
3374
    FibOfNPlus1 := FibOf2NPlus1;
3375

3376
    // Advance by one conditionally
3377
    if (N and Bit) <> 0 then
3378
    begin
3379
      Temp := FibOfN + FibOfNPlus1;
3380
      FibOfN := FibOfNPlus1;
3381
      FibOfNPlus1 := Temp;
3382
    end;
3383

3384
    Bit := Bit shr 1;
3385
  end;
3386
  Result := FibOfN;
3387
end;
3388

3389
// http://en.wikipedia.org/wiki/Binary_GCD_algorithm
3390
class function BigInteger.GreatestCommonDivisor(const Left, Right: BigInteger): BigInteger;
3391
var
3392
  Shift: Integer;
3393
  ALeft, ARight: BigInteger;
3394
  Temp: BigInteger;
3395
begin
3396
  // GCD(left, 0) = left; GCD(0, right) = right; GCD(0, 0) = 0
3397
  if Left.IsZero then
3398
    Exit(Abs(Right));
3399
  if Right.IsZero then
3400
    Exit(Abs(Left));
3401

3402
  ALeft := Abs(Left);
3403
  ARight := Abs(Right);
3404

3405
  // Let Shift = Log2(K), where K is the greatest power of 2 dividing
3406
  // both ALeft and ARight.
3407
  Shift := IntMin(Left.LowestSetBit, Right.LowestSetBit);
3408
  ALeft := ALeft shr Shift;
3409
  ARight := ARight shr Shift;
3410

3411
  while ALeft.IsEven do
3412
    ALeft := ALeft shr 1;
3413

3414
  // Now, ALeft is always odd.
3415
  repeat
3416
    // Remove all factors of 2 in ARight, since they are not in common.
3417
    // ARight is not 0, so the loop will terminate
3418
    while ARight.IsEven do
3419
      ARight := ARight shr 1;
3420

3421
    // ALeft and ARight are both odd. Swap if necessary, so that ALeft <= ARight,
3422
    // then set ARight to ARight - ALeft (which is even).
3423
    if ALeft > ARight then
3424
    begin
3425
      // Swap ALeft and ARight.
3426
      Temp := ALeft;
3427
      Aleft := ARight;
3428
      ARight := Temp;
3429
    end;
3430
    ARight := ARight - ALeft;
3431
  until ARight = 0;
3432

3433
  // Restore common factors of 2.
3434
  Result := ALeft shl Shift;
3435
end;
3436

3437
class procedure BigInteger.Hexadecimal;
3438
begin
3439
  FBase := 16;
3440
end;
3441

3442
class procedure BigInteger.Hex;
3443
begin
3444
  FBase := 16;
3445
end;
3446

3447
class operator BigInteger.Implicit(const Value: Int32): BigInteger;
3448
begin
3449
  // Note: Create will also get BigIntegers from the ValueCache, but this is a little faster.
3450
  if (Value >= Low(ValueCache)) and (Value <= High(ValueCache)) then
3451
    Result := ValueCache[Value]
3452
  else
3453
    Result := BigInteger.Create(Value);
3454
end;
3455

3456
class operator BigInteger.Implicit(const Value: UInt32): BigInteger;
3457
begin
3458
  if Value <= UInt32(High(ValueCache)) then
3459
    Result := ValueCache[Value]
3460
  else
3461
    Result := BigInteger.Create(Value);
3462
end;
3463

3464
class operator BigInteger.Implicit(const Value: Int64): BigInteger;
3465
begin
3466
  if (Value >= Low(ValueCache)) and (Value <= High(ValueCache)) then
3467
    Result := ValueCache[Value]
3468
  else
3469
    Result := BigInteger.Create(Value);
3470
end;
3471

3472
class operator BigInteger.Implicit(const Value: UInt64): BigInteger;
3473
begin
3474
  if Value <= High(ValueCache) then
3475
    Result := ValueCache[Value]
3476
  else
3477
    Result := BigInteger.Create(Value);
3478
end;
3479

3480
class constructor BigInteger.Initialize;
3481
var
3482
  I: Integer;
3483
  J: Integer;
3484
  LPower: BigInteger;
3485
  LMaxPower: BigInteger;
3486
begin
3487
  for I := Low(ValueCache) to High(ValueCache) do
3488
  begin
3489
    if I <> 0 then
3490
    begin
3491
      SetLength(ValueCache[I].FData, 4);
3492
      if I < 0 then
3493
      begin
3494
        ValueCache[I].FData[0] := -I;
3495
        ValueCache[I].FSize := 1 or SignMask;
3496
      end
3497
      else
3498
      begin
3499
        ValueCache[I].FData[0] := I;
3500
        ValueCache[I].FSize := 1;
3501
      end;
3502
    end
3503
    else
3504
    begin
3505
      ValueCache[0].FData := nil;
3506
      Valuecache[0].FSize := 0;
3507
    end;
3508
  end;
3509
  MinusOne := ValueCache[-1];
3510
  Zero := ValueCache[0];
3511
  One := ValueCache[1];
3512
  Ten := ValueCache[10];
3513
  FBase := 10;
3514
  FRoundingMode := rmTruncate;
3515
  FLog2 := System.Ln(2.0);
3516
{$IFNDEF PUREPASCAL}
3517
  // See comments for BigInteger.InternalAddEmu.
3518
  BigInteger.DetectPartialFlagsStall;
3519
{$ELSE}
3520
  FInternalAdd := InternalAddPurePascal;
3521
  FInternalSubtract := InternalSubtractPurePascal;
3522
{$ENDIF}
3523
  for I := Low(TNumberBase) to High(TNumberBase) do
3524
  begin
3525
    LMaxPower := CBaseInfos[I].MaxPower;
3526
    SetLength(CBasePowers[I], 10);
3527
    LPower := BigInteger.One;
3528
    for J := 0 to High(CBasePowers[I]) do
3529
    begin
3530
      CBasePowers[I, J] := LPower;
3531
      LPower := LPower * LMaxPower;
3532
    end;
3533
//    LMaxPower := BigInteger.Zero; // $$RV Rio: leak if not set to zero.
3534
  end;
3535
end;
3536

3537
class operator BigInteger.IntDivide(const Left, Right: BigInteger): BigInteger;
3538
begin
3539
  Result := Divide(Left, Right);
3540
end;
3541

3542
class operator BigInteger.IntDivide(const Left: BigInteger; Right: UInt16): BigInteger;
3543
begin
3544
  Result := Divide(Left, Right);
3545
end;
3546

3547
class operator BigInteger.IntDivide(const Left: BigInteger; Right: UInt32): BigInteger;
3548
begin
3549
  Result := Divide(Left, Right);
3550
end;
3551

3552
{$IFNDEF PUREPASCAL}
3553
class procedure BigInteger.InternalAddModified(Left, Right, Result: PLimb; LSize, RSize: Integer);
3554
{$IFDEF WIN32}
3555
asm
3556
        PUSH    ESI
3557
        PUSH    EDI
3558
        PUSH    EBX
3559

3560
        MOV     ESI,EAX                 // ESI: Left
3561
        MOV     EDI,EDX                 // EDI: Right
3562
        MOV     EBX,ECX                 // EBX: Result
3563

3564
        MOV     ECX,RSize
3565
        MOV     EDX,LSize
3566
        CMP     EDX,ECX                 // Swap Left/Right and LSize/RSize if RSize > LSize
3567
        JAE     @SkipSwap
3568
        XCHG    ECX,EDX
3569
        XCHG    ESI,EDI
3570

3571
@SkipSwap:
3572

3573
        // Here: Left longer than or equal length as Right.
3574

3575
        SUB     EDX,ECX
3576
        PUSH    EDX                     // Difference in sizes --> length of rest loop.
3577
        MOV     EDX,ECX                 // Smallest size.
3578
        AND     EDX,CUnrollMask         // Tail counter.
3579
        SHR     ECX,CUnrollShift        // Unrolled loop counter.
3580
        CLC
3581
        JE      @MainTail
3582

3583
// Intel proposal:
3584
//   Intel 64 and IA-32 Architectures Optimization Reference Manual
3585
//   3.5.2.6 Partial Flag Register Stalls -- Example 3-29
3586

3587
        XOR     EAX,EAX
3588

3589
        .ALIGN  16
3590

3591
@MainLoop:
3592

3593
        // Unrolled main loop.
3594

3595
        ADD     EAX,[ESI]
3596
        ADC     EAX,[EDI]
3597
        MOV     [EBX],EAX
3598

3599
        MOV     EAX,[ESI + CLimbSize]
3600
        ADC     EAX,[EDI + CLimbSize]
3601
        MOV     [EBX + CLimbSize],EAX
3602

3603
        MOV     EAX,[ESI + 2*CLimbSize]
3604
        ADC     EAX,[EDI + 2*CLimbSize]
3605
        MOV     [EBX + 2*CLimbSize],EAX
3606

3607
        MOV     EAX,[ESI + 3*CLimbSize]
3608
        ADC     EAX,[EDI + 3*CLimbSize]
3609
        MOV     [EBX + 3*CLimbSize],EAX
3610

3611
        SETC    AL
3612
        MOVZX   EAX,AL
3613

3614
        LEA     ESI,[ESI + CUnrollIncrement*CLimbSize]
3615
        LEA     EDI,[EDI + CUnrollIncrement*CLimbSize]
3616
        LEA     EBX,[EBX + CUnrollIncrement*CLimbSize]
3617

3618
        DEC     ECX
3619
        JNZ     @MainLoop
3620

3621
@MainTail:
3622

3623
        LEA     ESI,[ESI + EDX*CLimbSize]
3624
        LEA     EDI,[EDI + EDX*CLimbSize]
3625
        LEA     EBX,[EBX + EDX*CLimbSize]
3626

3627
        LEA     ECX,[@JumpsMain]
3628
        JMP     [ECX + EDX*TYPE Pointer]
3629

3630
        .ALIGN  4
3631

3632
@JumpsMain:
3633

3634
        DD      @DoRestLoop
3635
        DD      @Main1
3636
        DD      @Main2
3637
        DD      @Main3
3638

3639
@Main3:
3640

3641
        MOV     EAX,[ESI - 3*CLimbSize]
3642
        ADC     EAX,[EDI - 3*CLimbSize]
3643
        MOV     [EBX - 3*CLimbSize],EAX
3644

3645
@Main2:
3646

3647
        MOV     EAX,[ESI - 2*CLimbSize]
3648
        ADC     EAX,[EDI - 2*CLimbSize]
3649
        MOV     [EBX - 2*CLimbSize],EAX
3650

3651
@Main1:
3652

3653
        MOV     EAX,[ESI - CLimbSize]
3654
        ADC     EAX,[EDI - CLimbSize]
3655
        MOV     [EBX - CLimbSize],EAX
3656

3657
@DoRestLoop:
3658

3659
        SETC    AL                      // Save Carry Flag
3660
        XOR     EDI,EDI
3661
        POP     ECX
3662
        MOV     EDX,ECX
3663
        AND     EDX,CUnrollMask         // Tail counter
3664
        SHR     ECX,CUnrollShift        // Unrolled loop counter
3665
        ADD     AL,255                  // Restore Carry Flag.
3666
        JECXZ   @RestLastN
3667

3668
        .ALIGN  16
3669

3670
@RestLoop:
3671

3672
        /////////////////////////////////////////////////////////////////////
3673
        // Tests showed that branching out of the loop as soon as the      //
3674
        // carry is clear (using JNC @label, where @label is in a second   //
3675
        // loop that only copies and does not add anymore) actually makes  //
3676
        // the code slightly SLOWER, most of the time.                     //
3677
        /////////////////////////////////////////////////////////////////////
3678

3679
        MOV     EAX,[ESI]
3680
        ADC     EAX,EDI
3681
        MOV     [EBX],EAX
3682

3683
        MOV     EAX,[ESI + CLimbSize]
3684
        ADC     EAX,EDI
3685
        MOV     [EBX + CLimbSize],EAX
3686

3687
        MOV     EAX,[ESI + 2*CLimbSize]
3688
        ADC     EAX,EDI
3689
        MOV     [EBX + 2*CLimbSize],EAX
3690

3691
        MOV     EAX,[ESI + 3*CLimbSize]
3692
        ADC     EAX,EDI
3693
        MOV     [EBX + 3*CLimbSize],EAX
3694

3695
        SETC    AL
3696
        MOVZX   EAX,AL
3697

3698
        LEA     ESI,[ESI + CUnrollIncrement*CLimbSize]
3699
        LEA     EBX,[EBX + CUnrollIncrement*CLimbSize]
3700

3701
        LOOP    @RestLoop
3702

3703
@RestLastN:
3704

3705
        LEA     ESI,[ESI + EDX*CLimbSize]
3706
        LEA     EBX,[EBX + EDX*CLimbSize]
3707

3708
        LEA     ECX,[@RestJumps]
3709
        JMP     [ECX + EDX*TYPE Pointer]
3710

3711
        .ALIGN  4
3712

3713
@RestJumps:
3714

3715
        DD      @LastLimb
3716
        DD      @Rest1
3717
        DD      @Rest2
3718
        DD      @Rest3
3719

3720
@Rest3:
3721

3722
        MOV     EAX,[ESI - 3*CLimbSize]
3723
        ADC     EAX,EDI
3724
        MOV     [EBX - 3*CLimbSize],EAX
3725

3726
@Rest2:
3727

3728
        MOV     EAX,[ESI - 2*CLimbSize]
3729
        ADC     EAX,EDI
3730
        MOV     [EBX - 2*CLimbSize],EAX
3731

3732
@Rest1:
3733

3734
        MOV     EAX,[ESI - CLimbSize]
3735
        ADC     EAX,EDI
3736
        MOV     [EBX - CLimbSize],EAX
3737

3738
@LastLimb:
3739

3740
        ADC     EDI,EDI
3741
        MOV     [EBX],EDI
3742

3743
@Exit:
3744

3745
        POP     EBX
3746
        POP     EDI
3747
        POP     ESI
3748
end;
3749
{$ELSE WIN64}
3750
asm
3751
        MOV     R10,RCX
3752
        MOV     ECX,RSize
3753

3754
        CMP     R9D,ECX
3755
        JAE     @SkipSwap
3756
        XCHG    ECX,R9D
3757
        XCHG    R10,RDX
3758

3759
@SkipSwap:
3760

3761
        SUB     R9D,ECX
3762
        PUSH    R9
3763

3764
        MOV     R9D,ECX
3765
        AND     R9D,CUnrollMask
3766
        SHR     ECX,CUnrollShift
3767

3768
        CLC
3769
        JE      @MainTail
3770

3771
        .ALIGN  16
3772

3773
@MainLoop:
3774

3775
        MOV     RAX,[R10]
3776
        ADC     RAX,[RDX]
3777
        MOV     [R8],RAX
3778

3779
        MOV     RAX,[R10 + DLimbSize]
3780
        ADC     RAX,[RDX + DLimbSize]
3781
        MOV     [R8 + DLimbSize],RAX
3782

3783
        LEA     R10,[R10 + 2*DLimbSize]
3784
        LEA     RDX,[RDX + 2*DLimbSize]
3785
        LEA     R8,[R8 + 2*DLimbSize]
3786

3787
        LEA     RCX,[RCX - 1]
3788
        JECXZ   @MainTail
3789
        JMP     @MainLoop
3790

3791
@MainTail:
3792

3793
        LEA     RCX,[@MainJumps]
3794
        JMP     [RCX + R9*TYPE Pointer]
3795

3796
        .ALIGN  16
3797

3798
@MainJumps:
3799

3800
        DQ      @DoRestLoop
3801
        DQ      @Main1
3802
        DQ      @Main2
3803
        DQ      @Main3
3804

3805
@Main3:
3806

3807
        MOV     RAX,[R10]
3808
        ADC     RAX,[RDX]
3809
        MOV     [R8],RAX
3810

3811
        MOV     EAX,[R10 + 2*CLimbSize]
3812
        ADC     EAX,[RDX + 2*CLimbSize]
3813
        MOV     [R8 + 2*CLimbSize],EAX
3814

3815
        LEA     R10,[R10 + 3*CLimbSize]
3816
        LEA     RDX,[RDX + 3*CLimbSize]
3817
        LEA     R8,[R8 + 3*CLimbSize]
3818

3819
        JMP     @DoRestLoop
3820

3821
@Main2:
3822

3823
        MOV     RAX,[R10]
3824
        ADC     RAX,[RDX]
3825
        MOV     [R8],RAX
3826

3827
        LEA     R10,[R10 + 2*CLimbSize]
3828
        LEA     RDX,[RDX + 2*CLimbSize]
3829
        LEA     R8,[R8 + 2*CLimbSize]
3830

3831
        JMP     @DoRestLoop
3832

3833
@Main1:
3834

3835
        MOV     EAX,[R10]
3836
        ADC     EAX,[RDX]
3837
        MOV     [R8],EAX
3838

3839
        LEA     R10,[R10 + CLimbSize]
3840
        LEA     RDX,[RDX + CLimbSize]
3841
        LEA     R8,[R8 + CLimbSize]
3842

3843
@DoRestLoop:
3844

3845
        SETC    AL                      // Save Carry Flag
3846

3847
        XOR     EDX,EDX
3848

3849
        POP     RCX
3850
        MOV     R9D,ECX
3851
        AND     R9D,CUnrollMask
3852
        SHR     ECX,CUnrollShift
3853

3854
        ADD     AL,255                  // Restore Carry Flag.
3855

3856
        JECXZ   @RestLast3
3857

3858
        .ALIGN  16
3859

3860
@RestLoop:
3861

3862
        MOV     RAX,[R10]
3863
        ADC     RAX,RDX
3864
        MOV     [R8],RAX
3865

3866
        MOV     RAX,[R10 + DLimbSize]
3867
        ADC     RAX,RDX
3868
        MOV     [R8 + DLimbSize],RAX
3869

3870
        LEA     R10,[R10 + 2*DLimbSize]
3871
        LEA     R8,[R8 + 2*DLimbSize]
3872

3873
        LEA     RCX,[RCX - 1]
3874
        JECXZ   @RestLast3
3875
        JMP     @RestLoop
3876

3877
@RestLast3:
3878

3879
        LEA     RCX,[@RestJumps]
3880
        JMP     [RCX + R9*TYPE Pointer]
3881

3882
        .ALIGN  16
3883

3884
@RestJumps:
3885

3886
        DQ      @LastLimb
3887
        DQ      @Rest1
3888
        DQ      @Rest2
3889
        DQ      @Rest3
3890

3891
@Rest3:
3892

3893
        MOV     RAX,[R10]
3894
        ADC     RAX,RDX
3895
        MOV     [R8],RAX
3896

3897
        MOV     EAX,[R10 + 2*CLimbSize]
3898
        ADC     EAX,EDX
3899
        MOV     [R8 + 2*CLimbSize],EAX
3900

3901
        LEA     R8,[R8 + 3*CLimbSize]
3902

3903
        JMP     @LastLimb
3904

3905
@Rest2:
3906

3907
        MOV     RAX,[R10]
3908
        ADC     RAX,RDX
3909
        MOV     [R8],RAX
3910

3911
        LEA     R8,[R8 + 2*CLimbSize]
3912

3913
        JMP     @LastLimb
3914

3915
@Rest1:
3916

3917
        MOV     EAX,[R10]
3918
        ADC     EAX,EDX
3919
        MOV     [R8],EAX
3920

3921
        LEA     R8,[R8 + CLimbSize]
3922

3923
@LastLimb:
3924

3925
        ADC     EDX,EDX
3926
        MOV     [R8],EDX
3927

3928
@Exit:
3929

3930
end;
3931
{$ENDIF WIN32/WIN64}
3932

3933
class procedure BigInteger.InternalAddPlain(Left, Right, Result: PLimb; LSize, RSize: Integer);
3934

3935
////////////////////////////////////////////////////
3936
/// To understand the code, please read this:    ///
3937
///                                              ///
3938
///   http://stackoverflow.com/q/32084204/95954  ///
3939
///                                              ///
3940
/// especially Peter Cordes' answer:             ///
3941
///                                              ///
3942
///   http://stackoverflow.com/a/32087095/95954  ///
3943
////////////////////////////////////////////////////
3944

3945
{$IFDEF WIN32}
3946
asm
3947
        PUSH    ESI
3948
        PUSH    EDI
3949
        PUSH    EBX
3950

3951
        MOV     ESI,EAX                         // Left
3952
        MOV     EDI,EDX                         // Right
3953
        MOV     EBX,ECX                         // Result
3954

3955
        MOV     ECX,RSize
3956
        MOV     EDX,LSize
3957

3958
        CMP     EDX,ECX
3959
        JAE     @SkipSwap
3960
        XCHG    ECX,EDX
3961
        XCHG    ESI,EDI
3962

3963
@SkipSwap:
3964

3965
        SUB     EDX,ECX
3966
        PUSH    EDX
3967
        XOR     EDX,EDX
3968

3969
        XOR     EAX,EAX
3970

3971
        MOV     EDX,ECX
3972
        AND     EDX,CUnrollMask
3973
        SHR     ECX,CUnrollShift
3974

3975
        CLC
3976
        JE      @MainTail
3977

3978
@MainLoop:
3979

3980
        MOV     EAX,[ESI]
3981
        ADC     EAX,[EDI]
3982
        MOV     [EBX],EAX
3983

3984
        MOV     EAX,[ESI + CLimbSize]
3985
        ADC     EAX,[EDI + CLimbSize]
3986
        MOV     [EBX + CLimbSize],EAX
3987

3988
        MOV     EAX,[ESI + 2*CLimbSize]
3989
        ADC     EAX,[EDI + 2*CLimbSize]
3990
        MOV     [EBX + 2*CLimbSize],EAX
3991

3992
        MOV     EAX,[ESI + 3*CLimbSize]
3993
        ADC     EAX,[EDI + 3*CLimbSize]
3994
        MOV     [EBX + 3*CLimbSize],EAX
3995

3996
        LEA     ESI,[ESI + 4*CLimbSize]
3997
        LEA     EDI,[EDI + 4*CLimbSize]
3998
        LEA     EBX,[EBX + 4*CLimbSize]
3999

4000
        DEC     ECX                     // Does not affect carry flag, but that can cause partial flags stall.
4001
        JNE     @MainLoop
4002

4003
@MainTail:
4004

4005
        LEA     ESI,[ESI + EDX*CLimbSize]
4006
        LEA     EDI,[EDI + EDX*CLimbSize]
4007
        LEA     EBX,[EBX + EDX*CLimbSize]
4008

4009
        LEA     ECX,[@JumpsMain]
4010
        JMP     [ECX + EDX*TYPE Pointer]
4011

4012
        .ALIGN  16
4013

4014
@JumpsMain:
4015

4016
        DD      @DoRestLoop
4017
        DD      @Main1
4018
        DD      @Main2
4019
        DD      @Main3
4020

4021
@Main3:
4022

4023
        MOV     EAX,[ESI - 3*CLimbSize]
4024
        ADC     EAX,[EDI - 3*CLimbSize]
4025
        MOV     [EBX - 3*CLimbSize],EAX
4026

4027
@Main2:
4028

4029
        MOV     EAX,[ESI - 2*CLimbSize]
4030
        ADC     EAX,[EDI - 2*CLimbSize]
4031
        MOV     [EBX - 2*CLimbSize],EAX
4032

4033
@Main1:
4034

4035
        MOV     EAX,[ESI - CLimbSize]
4036
        ADC     EAX,[EDI - CLimbSize]
4037
        MOV     [EBX - CLimbSize],EAX
4038

4039
@DoRestLoop:
4040

4041
        SETC    AL                      // Save Carry Flag
4042

4043
        XOR     EDI,EDI
4044

4045
        POP     ECX
4046
        MOV     EDX,ECX
4047
        AND     EDX,CUnrollMask
4048
        SHR     ECX,CUnrollShift
4049

4050
        ADD     AL,255                  // Restore Carry Flag.
4051

4052
        INC     ECX
4053
        DEC     ECX
4054
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
4055

4056
@RestLoop:
4057

4058
        MOV     EAX,[ESI]
4059
        ADC     EAX,EDI
4060
        MOV     [EBX],EAX
4061

4062
        MOV     EAX,[ESI + CLimbSize]
4063
        ADC     EAX,EDI
4064
        MOV     [EBX + CLimbSize],EAX
4065

4066
        MOV     EAX,[ESI + 2*CLimbSize]
4067
        ADC     EAX,EDI
4068
        MOV     [EBX + 2*CLimbSize],EAX
4069

4070
        MOV     EAX,[ESI + 3*CLimbSize]
4071
        ADC     EAX,EDI
4072
        MOV     [EBX + 3*CLimbSize],EAX
4073

4074
        LEA     ESI,[ESI + 4*CLimbSize]
4075
        LEA     EBX,[EBX + 4*CLimbSize]
4076

4077
        DEC     ECX
4078
        JNE     @RestLoop
4079

4080
@RestLast3:
4081

4082
        LEA     ESI,[ESI + EDX*CLimbSize]
4083
        LEA     EBX,[EBX + EDX*CLimbSize]
4084

4085
        LEA     ECX,[@RestJumps]
4086
        JMP     [ECX + EDX*TYPE Pointer]
4087

4088
        .ALIGN  16
4089

4090
@RestJumps:
4091

4092
        DD      @LastLimb
4093
        DD      @Rest1
4094
        DD      @Rest2
4095
        DD      @Rest3
4096

4097
@Rest3:
4098

4099
        MOV     EAX,[ESI - 3*CLimbSize]
4100
        ADC     EAX,EDI
4101
        MOV     [EBX - 3*CLimbSize],EAX
4102

4103
@Rest2:
4104

4105
        MOV     EAX,[ESI - 2*CLimbSize]
4106
        ADC     EAX,EDI
4107
        MOV     [EBX - 2*CLimbSize],EAX
4108

4109
@Rest1:
4110

4111
        MOV     EAX,[ESI - CLimbSize]
4112
        ADC     EAX,EDI
4113
        MOV     [EBX - CLimbSize],EAX
4114

4115
@LastLimb:
4116

4117
        ADC     EDI,EDI
4118
        MOV     [EBX],EDI
4119

4120
@Exit:
4121

4122
        POP     EBX
4123
        POP     EDI
4124
        POP     ESI
4125
end;
4126
{$ELSE WIN64}
4127
asm
4128
        MOV     R10,RCX
4129
        MOV     ECX,RSize
4130

4131
        CMP     R9D,ECX
4132
        JAE     @SkipSwap
4133
        XCHG    ECX,R9D
4134
        XCHG    R10,RDX
4135

4136
@SkipSwap:
4137

4138
        SUB     R9D,ECX
4139
        PUSH    R9
4140

4141
        MOV     R9D,ECX
4142
        AND     R9D,CUnrollMask
4143
        SHR     ECX,CUnrollShift
4144

4145
        CLC
4146
        JE      @MainTail
4147

4148
@MainLoop:
4149

4150
        MOV     RAX,[R10]
4151
        ADC     RAX,[RDX]
4152
        MOV     [R8],RAX
4153

4154
        MOV     RAX,[R10 + DLimbSize]
4155
        ADC     RAX,[RDX + DLimbSize]
4156
        MOV     [R8 + DLimbSize],RAX
4157

4158
        LEA     R10,[R10 + 2*DLimbSize]
4159
        LEA     RDX,[RDX + 2*DLimbSize]
4160
        LEA     R8,[R8 + 2*DLimbSize]
4161

4162
        DEC     ECX
4163
        JNE     @MainLoop
4164

4165
@MainTail:
4166

4167
        LEA     RCX,[@MainJumps]
4168
        JMP     [RCX + R9*TYPE Pointer]
4169

4170
        .ALIGN  16
4171

4172
@MainJumps:
4173

4174
        DQ      @DoRestLoop
4175
        DQ      @Main1
4176
        DQ      @Main2
4177
        DQ      @Main3
4178

4179
@Main3:
4180

4181
        MOV     RAX,[R10]
4182
        ADC     RAX,[RDX]
4183
        MOV     [R8],RAX
4184

4185
        MOV     EAX,[R10 + 2*CLimbSize]
4186
        ADC     EAX,[RDX + 2*CLimbSize]
4187
        MOV     [R8 + 2*CLimbSize],EAX
4188

4189
        LEA     R10,[R10 + 3*CLimbSize]
4190
        LEA     RDX,[RDX + 3*CLimbSize]
4191
        LEA     R8,[R8 + 3*CLimbSize]
4192

4193
        JMP     @DoRestLoop
4194

4195
@Main2:
4196

4197
        MOV     RAX,[R10]
4198
        ADC     RAX,[RDX]
4199
        MOV     [R8],RAX
4200

4201
        LEA     R10,[R10 + 2*CLimbSize]
4202
        LEA     RDX,[RDX + 2*CLimbSize]
4203
        LEA     R8,[R8 + 2*CLimbSize]
4204

4205
        JMP     @DoRestLoop
4206

4207
@Main1:
4208

4209
        MOV     EAX,[R10]
4210
        ADC     EAX,[RDX]
4211
        MOV     [R8],EAX
4212

4213
        LEA     R10,[R10 + CLimbSize]
4214
        LEA     RDX,[RDX + CLimbSize]
4215
        LEA     R8,[R8 + CLimbSize]
4216

4217
@DoRestLoop:
4218

4219
        SETC    AL                      // Save Carry Flag
4220

4221
        XOR     EDX,EDX
4222

4223
        POP     RCX
4224
        MOV     R9D,ECX
4225
        AND     R9D,CUnrollMask
4226
        SHR     ECX,CUnrollShift
4227

4228
        ADD     AL,255                  // Restore Carry Flag.
4229

4230
        INC     ECX
4231
        DEC     ECX
4232
        JE      @RestLast3
4233

4234
@RestLoop:
4235

4236
        MOV     RAX,[R10]
4237
        ADC     RAX,RDX
4238
        MOV     [R8],RAX
4239

4240
        MOV     RAX,[R10 + DLimbSize]
4241
        ADC     RAX,RDX
4242
        MOV     [R8 + DLimbSize],RAX
4243

4244
        LEA     R10,[R10 + 2*DLimbSize]
4245
        LEA     R8,[R8 + 2*DLimbSize]
4246

4247
        DEC     ECX
4248
        JNE     @RestLoop
4249

4250
@RestLast3:
4251

4252
        LEA     RCX,[@RestJumps]
4253
        JMP     [RCX + R9*TYPE Pointer]
4254

4255
        // If necessary, align second jump table with NOPs
4256

4257
        // -- Aligned.
4258

4259
@RestJumps:
4260

4261
        DQ      @LastLimb
4262
        DQ      @Rest1
4263
        DQ      @Rest2
4264
        DQ      @Rest3
4265

4266
@Rest3:
4267

4268
        MOV     RAX,[R10]
4269
        ADC     RAX,RDX
4270
        MOV     [R8],RAX
4271

4272
        MOV     EAX,[R10 + DLimbSize]
4273
        ADC     EAX,EDX
4274
        MOV     [R8 + DLimbSize],EAX
4275

4276
        LEA     R8,[R8 + 3*CLimbSize]
4277

4278
        JMP     @LastLimb
4279

4280
@Rest2:
4281

4282
        MOV     RAX,[R10]
4283
        ADC     RAX,RDX
4284
        MOV     [R8],RAX
4285

4286
        LEA     R8,[R8 + DLimbSize]
4287

4288
        JMP     @LastLimb
4289

4290
@Rest1:
4291

4292
        MOV     EAX,[R10]
4293
        ADC     EAX,EDX
4294
        MOV     [R8],EAX
4295

4296
        LEA     R8,[R8 + CLimbSize]
4297

4298
@LastLimb:
4299

4300
        ADC     EDX,EDX
4301
        MOV     [R8],EDX
4302

4303
@Exit:
4304

4305
end;
4306
{$ENDIF !WIN32}
4307
{$ENDIF !PUREPASCAL}
4308

4309
{$IFDEF PUREPASCAL}
4310
class procedure BigInteger.InternalAddPurePascal(Left, Right, Result: PLimb; LSize, RSize: Integer);
4311
var
4312
  LCount, LTail: Integer;
4313
  Sum: NativeUInt;
4314
  I: Integer;
4315
  L: PLimb;
4316
begin
4317
  if LSize < RSize then
4318
  begin
4319
    I := LSize;
4320
    LSize := RSize;
4321
    RSize := I;
4322
    L := Left;
4323
    Left := Right;
4324
    Right := L;
4325
  end;
4326

4327
  Sum := 0;
4328

4329
  Dec(LSize, RSize);          // LSize is length of non-overlapping part.
4330

4331
  LTail := RSize and CUnrollMask;
4332
  LCount := RSize shr CUnrollShift;
4333

4334
  while LCount > 0 do
4335
  begin
4336
  {$IFDEF CPU64BITS}
4337
    Sum := UInt64(Left[0]) + Right[0] + (Sum shr 32);
4338
    Result[0] := TLimb(Sum);
4339

4340
    Sum := UInt64(Left[1]) + Right[1] + (Sum shr 32);
4341
    Result[1] := TLimb(Sum);
4342

4343
    Sum := UInt64(Left[2]) + Right[2] + (Sum shr 32);
4344
    Result[2] := TLimb(Sum);
4345

4346
    Sum := UInt64(Left[3]) + Right[3] + (Sum shr 32);
4347
    Result[3] := TLimb(Sum);
4348
  {$ELSE}
4349
    Sum := UInt32(PUInt16(Left)[0]) + PUInt16(Right)[0] + (Sum shr 16);
4350
    PUInt16(Result)[0] := UInt16(Sum);
4351

4352
    Sum := UInt32(PUInt16(Left)[1]) + PUInt16(Right)[1] + (Sum shr 16);
4353
    PUInt16(Result)[1] := UInt16(Sum);
4354

4355
    Sum := UInt32(PUInt16(Left)[2]) + PUInt16(Right)[2] + (Sum shr 16);
4356
    PUInt16(Result)[2] := UInt16(Sum);
4357

4358
    Sum := UInt32(PUInt16(Left)[3]) + PUInt16(Right)[3] + (Sum shr 16);
4359
    PUInt16(Result)[3] := UInt16(Sum);
4360

4361
    Sum := UInt32(PUInt16(Left)[4]) + PUInt16(Right)[4] + (Sum shr 16);
4362
    PUInt16(Result)[4] := UInt16(Sum);
4363

4364
    Sum := UInt32(PUInt16(Left)[5]) + PUInt16(Right)[5] + (Sum shr 16);
4365
    PUInt16(Result)[5] := UInt16(Sum);
4366

4367
    Sum := UInt32(PUInt16(Left)[6]) + PUInt16(Right)[6] + (Sum shr 16);
4368
    PUInt16(Result)[6] := UInt16(Sum);
4369

4370
    Sum := UInt32(PUInt16(Left)[7]) + PUInt16(Right)[7] + (Sum shr 16);
4371
    PUInt16(Result)[7] := UInt16(Sum);
4372
  {$ENDIF}
4373

4374
    Inc(Left, CUnrollIncrement);
4375
    Inc(Right, CUnrollIncrement);
4376
    Inc(Result, CUnrollIncrement);
4377
    Dec(LCount);
4378
  end;
4379
  while LTail > 0 do
4380
  begin
4381
  {$IFDEF CPU64BITS}
4382
    Sum := UInt64(Left[0]) + Right[0] + (Sum shr 32);
4383
    Result[0] := TLimb(Sum);
4384
  {$ELSE}
4385
    Sum := UInt32(PUInt16(Left)[0]) + PUInt16(Right)[0] + (Sum shr 16);
4386
    PUInt16(Result)[0] := UInt16(Sum);
4387

4388
    Sum := UInt32(PUInt16(Left)[1]) + PUInt16(Right)[1] + (Sum shr 16);
4389
    PUInt16(Result)[1] := UInt16(Sum);
4390
  {$ENDIF}
4391

4392
    Inc(Left);
4393
    Inc(Right);
4394
    Inc(Result);
4395
    Dec(LTail);
4396
  end;
4397

4398
  LTail := LSize and CUnrollMask;
4399
  LCount := LSize shr CUnrollShift;
4400

4401
  while LCount > 0 do
4402
  begin
4403
  {$IFDEF CPU64BITS}
4404
    Sum := UInt64(Left[0]) + (Sum shr 32);
4405
    Result[0] := TLimb(Sum);
4406

4407
    Sum := UInt64(Left[1]) + (Sum shr 32);
4408
    Result[1] := TLimb(Sum);
4409

4410
    Sum := UInt64(Left[2]) + (Sum shr 32);
4411
    Result[2] := TLimb(Sum);
4412

4413
    Sum := UInt64(Left[3]) + (Sum shr 32);
4414
    Result[3] := TLimb(Sum);
4415
  {$ELSE}
4416
    Sum := UInt32(PUInt16(Left)[0]) + (Sum shr 16);
4417
    PUInt16(Result)[0] := UInt16(Sum);
4418

4419
    Sum := UInt32(PUInt16(Left)[1]) + (Sum shr 16);
4420
    PUInt16(Result)[1] := UInt16(Sum);
4421

4422
    Sum := UInt32(PUInt16(Left)[2]) + (Sum shr 16);
4423
    PUInt16(Result)[2] := UInt16(Sum);
4424

4425
    Sum := UInt32(PUInt16(Left)[3]) + (Sum shr 16);
4426
    PUInt16(Result)[3] := UInt16(Sum);
4427

4428
    Sum := UInt32(PUInt16(Left)[4]) + (Sum shr 16);
4429
    PUInt16(Result)[4] := UInt16(Sum);
4430

4431
    Sum := UInt32(PUInt16(Left)[5]) + (Sum shr 16);
4432
    PUInt16(Result)[5] := UInt16(Sum);
4433

4434
    Sum := UInt32(PUInt16(Left)[6]) + (Sum shr 16);
4435
    PUInt16(Result)[6] := UInt16(Sum);
4436

4437
    Sum := UInt32(PUInt16(Left)[7]) + (Sum shr 16);
4438
    PUInt16(Result)[7] := UInt16(Sum);
4439
  {$ENDIF}
4440

4441
    Inc(Left, CUnrollIncrement);
4442
    Inc(Result, CUnrollIncrement);
4443
    Dec(LCount);
4444
  end;
4445

4446
  while LTail > 0 do
4447
  begin
4448
  {$IFDEF CPU64BITS}
4449
    Sum := UInt64(Left[0]) + (Sum shr 32);
4450
    Result[0] := TLimb(Sum);
4451
  {$ELSE}
4452
    Sum := UInt32(PUInt16(Left)[0]) + (Sum shr 16);
4453
    PUInt16(Result)[0] := UInt16(Sum);
4454

4455
    Sum := UInt32(PUInt16(Left)[1]) + (Sum shr 16);
4456
    PUInt16(Result)[1] := UInt16(Sum);
4457
  {$ENDIF}
4458

4459
    Inc(Left);
4460
    Inc(Result);
4461
    Dec(LTail);
4462
  end;
4463

4464
{$IFDEF CPU64BITS}
4465
  Result[0] := Sum shr 32;
4466
{$ELSE}
4467
  Result[0] := Sum shr 16;
4468
{$ENDIF};
4469

4470
end;
4471
{$ENDIF}
4472

4473
class procedure BigInteger.InternalMultiply(Left, Right, Result: PLimb; LSize, RSize: Integer);
4474
{$IFDEF PUREPASCAL}
4475

4476
//////////////////////////////////////////////////////////////////////////////
4477
// Tests with using a UInt32 Product and emulating 16 bit limbs produced    //
4478
// 50% slower code.                                                         //
4479
// 64 bit multiplication and addition doesn't generate optimal code, but    //
4480
// it is apparently still faster than faking 16 bit limbs.                  //
4481
//////////////////////////////////////////////////////////////////////////////
4482
// What is really needed is a function that multiplies two UInt32 and       //
4483
// produces an UInt64 directly, i.e. without conversion of the UInt32s into //
4484
// UInt64 first. This is easy in assembler, but not in PUREPASCAL.          //
4485
//////////////////////////////////////////////////////////////////////////////
4486

4487
type
4488
  TUInt64 = packed record
4489
    Lo, Hi: TLimb;
4490
  end;
4491
var
4492
  Product: UInt64;
4493
  LTail, LCount: Integer;
4494
  CurrentRightLimb: TLimb;
4495
  PLeft, PDest, PRight, PDestRowStart: PLimb;
4496
  LCarry: TLimb;
4497
begin
4498
  // Ensure that Left is the longer of both magnitudes.
4499
  if RSize > LSize then
4500
  begin
4501
    SwapPLimbs(Left, Right);
4502
    SwapIntegers(LSize, RSize);
4503
  end;
4504

4505
  // Each new row is one limb further to the left.
4506
  PRight := Right;
4507
  PDestRowStart := Result;
4508

4509
  PLeft := Left;
4510
  PDest := PDestRowStart;
4511
  Inc(PDestRowStart);
4512
  CurrentRightLimb := PRight^;
4513
  Inc(PRight);
4514
  TUInt64(Product).Hi := 0;
4515
  Dec(RSize);
4516
  LCount := LSize;
4517
  LCarry := 0;
4518

4519
  // First row. No previous result, so no need to add it in.
4520
  while LCount > 0 do
4521
  begin
4522
    Product := UInt64(PLeft^) * CurrentRightLimb;
4523
    Inc(Product, LCarry);
4524
    PDest^ := TUInt64(Product).Lo;
4525
    LCarry := TUInt64(Product).Hi;
4526
    Inc(PLeft);
4527
    Inc(PDest);
4528
    Dec(LCount);
4529
  end;
4530
  PDest^ := TUInt64(Product).Hi;
4531

4532
  LTail := LSize and CUnrollMask; // Low 2 bits: 0..3.
4533
  LSize := LSize shr CUnrollShift; // Divide by 4.
4534
  while RSize > 0 do
4535
  begin
4536
    PLeft := Left;
4537
    PDest := PDestRowStart;
4538
    Inc(PDestRowStart);
4539
    CurrentRightLimb := PRight^;
4540
    Inc(PRight);
4541

4542
    if CurrentRightLimb <> 0 then
4543
    begin
4544
      LCarry := 0;
4545
      LCount := LSize;
4546

4547
      // Inner loop, unrolled.
4548
      while LCount > 0 do
4549
      begin
4550

4551
        // Note: The following will not produce an overflow.
4552
        // Proof: say B = High(TLimb) + 1 = $100000000
4553
        // Assume PLeft[0], CurrentRightLimb, PRight[0] and Product.Hi are all
4554
        // the maximum value (B - 1) (i.e. $FFFFFFFF).
4555
        // Then Product = (B - 1)^2 + (B - 1) + (B - 1)
4556
        //              = B^2 - 2*B + 1 + 2*B - 2
4557
        //              = B^2 - 1 = $FFFFFFFFFFFFFFFF = High(UInt64)
4558
        // so no overflow possible!
4559

4560
        // Note2: The previous code was
4561
        //
4562
        //          Product := UInt64(PLeft[0]) * CurrentRightLimb + PDest[0] + TUInt64(Product).Hi;
4563
        //          etc...
4564
        //
4565
        //        The following source produces shorter generated code, but is only slightly faster
4566
        //        than the above (3% speed increase).
4567

4568
        Product := UInt64(PLeft[0]) * CurrentRightLimb;
4569
        Inc(Product, PDest[0]);
4570
        Inc(Product, LCarry);
4571
        PDest[0] := TLimb(Product);
4572
        LCarry := TUInt64(Product).Hi;
4573

4574
        Product := UInt64(PLeft[1]) * CurrentRightLimb;
4575
        Inc(Product, PDest[1]);
4576
        Inc(Product, LCarry);
4577
        PDest[1] := TLimb(Product);
4578
        LCarry := TUInt64(Product).Hi;
4579

4580
        Product := UInt64(PLeft[2]) * CurrentRightLimb;
4581
        Inc(Product, PDest[2]);
4582
        Inc(Product, LCarry);
4583
        PDest[2] := TLimb(Product);
4584
        LCarry := TUInt64(Product).Hi;
4585

4586
        Product := UInt64(PLeft[3]) * CurrentRightLimb;
4587
        Inc(Product, PDest[3]);
4588
        Inc(Product, LCarry);
4589
        PDest[3] := TLimb(Product);
4590
        LCarry := TUInt64(Product).Hi;
4591

4592
        Inc(PLeft, CUnrollIncrement);
4593
        Inc(PDest, CunrollIncrement);
4594
        Dec(LCount);
4595
      end;
4596

4597
      // Rest loop.
4598
      LCount := LTail;
4599
      while LCount > 0 do
4600
      begin
4601
        Product := UInt64(PLeft^) * CurrentRightLimb;
4602
        Inc(Product, PDest^);
4603
        Inc(Product, LCarry);
4604
        LCarry := TUInt64(Product).Hi;
4605
        PDest^ := TUInt64(Product).Lo;
4606

4607
        Inc(PLeft);
4608
        Inc(PDest);
4609
        Dec(LCount);
4610
      end;
4611

4612
      // Last (top) limb of this row.
4613
      PDest^ := TUInt64(Product).Hi;
4614
    end;
4615
    Dec(RSize);
4616
  end;
4617
end;
4618
{$ELSE !PUREPASCAL}
4619
{$IFDEF WIN32)}
4620
var
4621
  SaveResult: PLimb;
4622
  LRest, LCount: Integer;
4623
  PRight, PDestRowStart: PLimb;
4624
  LLeft, LRight: PLimb;
4625
asm
4626
        PUSH    ESI
4627
        PUSH    EDI
4628
        PUSH    EBX
4629

4630
        MOV     SaveResult,ECX
4631

4632
        MOV     ESI,LSize
4633
        MOV     EDI,RSize
4634
        CMP     ESI,EDI
4635
        JA      @SkipSwap
4636

4637
        XCHG    EAX,EDX
4638
        XCHG    ESI,EDI
4639
        MOV     LSize,ESI
4640
        MOV     RSize,EDI
4641

4642
// The longest loop should ideally be unrolled. After this, Left should be longer or same length.
4643

4644
@SkipSwap:
4645

4646
        MOV     LLeft,EAX
4647
        MOV     LRight,EDX
4648

4649
// First loop, setting up first row:
4650

4651
        MOV     PRight,EDX
4652
        MOV     EDI,SaveResult
4653
        MOV     PDestRowStart,EDI               // EDI = PDest
4654

4655
        MOV     ESI,LLeft                       // ESI = PLeft
4656

4657
// If CurrentLimbRight = 0, we can skip a lot, and simply do a FillChar
4658

4659
        MOV     ECX,[EDX]                       // CurrentRightLimb
4660
        XOR     EBX,EBX                         // PreviousProductHi
4661
        ADD     PDestRowStart,CLimbSize
4662
        ADD     PRight,CLimbSize
4663
        MOV     EAX,LSize
4664
        MOV     LCount,EAX
4665

4666
// The setup loop fills the row without an attempt to add to the data already in the result.
4667

4668
@SetupLoop:
4669

4670
        MOV     EAX,[ESI]
4671
        MUL     EAX,ECX                         // Uses MUL EAX,ECX syntax because of bug in XE2 assembler.
4672
        ADD     EAX,EBX
4673
        ADC     EDX,KZero
4674
        MOV     [EDI],EAX
4675
        MOV     EBX,EDX
4676
        LEA     ESI,[ESI + CLimbSize]
4677
        LEA     EDI,[EDI + CLimbSize]
4678
        DEC     LCount
4679
        JNE     @SetupLoop
4680
        MOV     [EDI],EDX
4681

4682
        MOV     EAX,LSize
4683
        MOV     EDX,EAX
4684
        SHR     EAX,CUnrollShift
4685
        MOV     LSize,EAX
4686
        AND     EDX,CUnrollMask
4687
        MOV     LRest,EDX
4688

4689
        DEC     RSize
4690
        JE      @Exit
4691

4692
// The outer loop iterates over the limbs of the shorter operand. After the setup loop, the lowest limb
4693
// has already been taken care of.
4694

4695
@OuterLoop:
4696

4697
        MOV     ESI,LLeft
4698
        MOV     EDI,PDestRowStart
4699
        ADD     PDestRowStart,CLimbSize
4700
        MOV     EAX,PRight
4701
        ADD     PRight,CLimbSize
4702

4703
// If PRight^ is 0, then we can skip multiplication for the entire row.
4704

4705
        MOV     ECX,[EAX]
4706
        TEST    ECX,ECX
4707
        JE      @NextOuterLoop
4708

4709
        XOR     EBX,EBX
4710
        MOV     EAX,LSize
4711
        MOV     LCount,EAX
4712

4713

4714
        CMP     EAX,KZero
4715
        JE      @EndInnerLoop
4716

4717
        .ALIGN  16
4718

4719
@InnerLoop:
4720

4721
        // Loop unrolled. Approx. 70% faster than simple loop.
4722

4723
        // TODO: Use MMX registers for multiplication and addition.
4724
        // E.g.
4725
        // MOV     MM7,ECX
4726
        // PXOR    MM6,MM6
4727
        // @Innerloop0:
4728
        // MOV     MM0,[ESI]
4729
        // MOV     MM1,[ESI + CLimbSize]
4730
        // MOV     MM2,[ESI + 2*CLimbSize]
4731
        // MOV     MM3,[ESI + 3*CLimbSize]
4732
        // PMULUDQ MM0,MM7
4733
        // PADDQ   MM6,MM0
4734
        // MOV     [ESI],MM6
4735
        // PSHRQ   MM6,32
4736
        // PMULUDQ MM1,MM7
4737
        // PADDQ   MM6,MM1
4738
        // MOV     [ESI+CLimbSize],MM6
4739
        // PSHRQ   MM6,32
4740
        // etc...
4741
        // @InnerLoopRest:
4742
        // Do the same as above, but add to existing content in [ESI+...]
4743

4744
        MOV     EAX,[ESI]                  // The following pattern is not faster:
4745
        MUL     ECX                        // MOV    EAX,[ESI]
4746
        ADD     EAX,[EDI]                  // MUL    ECX
4747
        ADC     EDX,0                      // ADD    EAX,EBX
4748
        ADD     EAX,EBX                    // ADC    EDX,0
4749
        ADC     EDX,0                      // ADD    [EDI],EAX
4750
        MOV     [EDI],EAX                  // ADC    EDX,0
4751
        MOV     EBX,EDX                    // MOV    EBX,EDX
4752

4753
        MOV     EAX,[ESI + CLimbSize]
4754
        MUL     ECX
4755
        ADD     EAX,[EDI + CLimbSize]
4756
        ADC     EDX,0
4757
        ADD     EAX,EBX
4758
        ADC     EDX,0
4759
        MOV     [EDI + CLimbSize],EAX
4760
        MOV     EBX,EDX
4761

4762
        MOV     EAX,[ESI + 2*CLimbSize]
4763
        MUL     ECX
4764
        ADD     EAX,[EDI + 2*CLimbSize]
4765
        ADC     EDX,0
4766
        ADD     EAX,EBX
4767
        ADC     EDX,0
4768
        MOV     [EDI + 2*CLimbSize],EAX
4769
        MOV     EBX,EDX
4770

4771
        MOV     EAX,[ESI + 3*CLimbSize]
4772
        MUL     ECX
4773
        ADD     EAX,[EDI + 3*CLimbSize]
4774
        ADC     EDX,0
4775
        ADD     EAX,EBX
4776
        ADC     EDX,0
4777
        MOV     [EDI + 3*CLimbSize],EAX
4778
        MOV     EBX,EDX
4779

4780
        LEA     ESI,[ESI + 4*CLimbSize]
4781
        LEA     EDI,[EDI + 4*CLimbSize]
4782

4783
        DEC     LCount
4784
        JNE     @InnerLoop
4785

4786
@EndInnerLoop:
4787

4788
        // The remaining limbs to be handled.
4789

4790
        MOV     EAX,LRest
4791
        MOV     LCount,EAX
4792
        CMP     EAX,0
4793
        JE      @EndInnerRestLoop
4794

4795
@InnerRestLoop:
4796

4797
        MOV     EAX,[ESI]
4798
        MUL     EAX,ECX
4799
        ADD     EAX,EBX
4800
        ADC     EDX,0
4801
        ADD     EAX,[EDI]
4802
        ADC     EDX,0
4803
        MOV     [EDI],EAX
4804
        MOV     EBX,EDX
4805
        LEA     ESI,[ESI + CLimbSize]
4806
        LEA     EDI,[EDI + CLimbSize]
4807
        DEC     LCount
4808
        JNE     @InnerRestLoop
4809

4810
@EndInnerRestLoop:
4811

4812
        // The last (left) limb gets the top of the 64 bit product.
4813

4814
        MOV     [EDI],EBX
4815

4816
@NextOuterLoop:
4817

4818
        DEC     RSize
4819
        JNE     @OuterLoop
4820

4821
@Exit:
4822
        POP     EBX
4823
        POP     EDI
4824
        POP     ESI
4825
end;
4826
{$ELSE WIN64}
4827

4828
// This uses 64 bit multiplication as much as possible. The logic handles any odd (top) limbs especially.
4829

4830
var
4831
  LeftOdd, RightOdd: Boolean;                   // Left, Right (resp.): odd number of limbs?
4832
  SaveLeft: PLimb;
4833
  LeftSize, RightSize: Integer;
4834
asm
4835
        .PUSHNV RSI
4836
        .PUSHNV RDI
4837
        .PUSHNV RBX
4838
        .PUSHNV R12
4839

4840
        MOV     EDI,RSize
4841
        CMP     R9D,EDI
4842
        JAE     @SwapEnd
4843

4844
        XCHG    RCX,RDX
4845
        XCHG    R9D,EDI
4846

4847
@SwapEnd:
4848

4849
        MOV     SaveLeft,RCX
4850
        XOR     R12,R12
4851

4852
        MOV     EAX,R9D
4853
        SHR     R9D,1
4854
        MOV     LeftSize,R9D            // Number of double limbs of Left
4855
        AND     AL,1
4856
        MOV     LeftOdd,AL              // Does Left have an odd number of limbs?
4857

4858
        MOV     EAX,EDI
4859
        SHR     EDI,1
4860
        MOV     RightSize,EDI           // Number of double limbs of Right
4861
        AND     AL,1
4862
        MOV     RightOdd,AL             // Does Right have an odd number of limbs?
4863

4864
        MOV     R10,RDX                 // Current limb to be multiplied
4865
        XOR     RBX,RBX                 // Top DWORD (EDX) of previous multiplication
4866

4867
        // If no more 64 bit limbs in Right, we must skip to final odd limb.
4868

4869
        CMP     RightSize,0
4870
        JE      @FinalOddPart
4871

4872
        MOV     RCX,[R10]               // Current Right limb's value
4873
        MOV     RDI,R8                  // Result limb pointer
4874
        MOV     RSI,SaveLeft            // Left limb pointer
4875
        ADD     R8,DLimbSize            // Result's pointer to start of current row
4876
        ADD     R10,DLimbSize           // Current Right limb pointer
4877

4878
        MOV     R11D,LeftSize           // Loop counter
4879
        CMP     R11D,0
4880
        JE      @SetupOddPart
4881

4882
// Setup loop (64 bit part)
4883

4884
@SetupLoop64:
4885

4886
        MOV     RAX,[RSI]
4887
        MUL     RCX
4888
        ADD     RAX,RBX
4889
        ADC     RDX,R12
4890
        MOV     [RDI],RAX
4891
        MOV     RBX,RDX
4892
        LEA     RSI,[RSI + DLimbSize]
4893
        LEA     RDI,[RDI + DLimbSize]
4894
        DEC     R11D
4895
        JNE     @SetupLoop64
4896

4897
// Setup loop, last limb ("odd" part).
4898

4899
@SetupOddPart:
4900

4901
        CMP     LeftOdd,0
4902
        JE      @SkipSetupOddPart
4903

4904
        MOV     EAX,[RSI]               // 32 bit register to read odd limb of this loop
4905
        MUL     RCX
4906
        ADD     RAX,RBX
4907
        ADC     RDX,R12
4908
        MOV     [RDI],RAX
4909
        MOV     [RDI + DLimbSize],RDX
4910
        JMP     @SkipSkipSetupOddPart
4911

4912
@SkipSetupOddPart:
4913

4914
        MOV     [RDI],RDX
4915

4916
@SkipSkipSetupOddPart:
4917

4918
        DEC     RightSize
4919
        JE      @FinalOddPart
4920

4921
@OuterLoop:
4922

4923
        MOV     RDI,R8
4924
        ADD     R8,DLimbSize
4925
        MOV     RCX,[R10]
4926
        ADD     R10,DLimbSize
4927

4928
        TEST    RCX,RCX
4929
        JE      @NextOuterLoop
4930

4931
        MOV     RSI,SaveLeft
4932
        XOR     RBX,RBX
4933
        MOV     R11D,LeftSize
4934
        CMP     R11D,0
4935
        JE      @InnerLoopOddPart
4936

4937
        SHR     R11D,CUnrollShift
4938
        JE      @InnerTail64
4939

4940
@InnerLoop64:
4941

4942
        MOV     RAX,[RSI]               // Get double limb from Left data
4943
        MUL     RCX                     // multiply it with current Right double limb's value --> RDX:RAX
4944
        ADD     RAX,RBX                 // Add top limb from previous multiplication to RDX:RAX
4945
        ADC     RDX,R12
4946
        ADD     [RDI],RAX               // Add RAX to result array
4947
        ADC     RDX,R12                 // And adjust top limb again
4948
        MOV     RBX,RDX                 // And save top limb as "carry".
4949

4950
        MOV     RAX,[RSI + DLimbSize]
4951
        MUL     RCX
4952
        ADD     RAX,RBX
4953
        ADC     RDX,R12
4954
        ADD     [RDI + DLimbSize],RAX
4955
        ADC     RDX,R12
4956
        MOV     RBX,RDX
4957

4958
        MOV     RAX,[RSI + 2*DLimbSize]
4959
        MUL     RCX
4960
        ADD     RAX,RBX
4961
        ADC     RDX,R12
4962
        ADD     [RDI + 2*DLimbSize],RAX
4963
        ADC     RDX,R12
4964
        MOV     RBX,RDX
4965

4966
        MOV     RAX,[RSI + 3*DLimbSize]
4967
        MUL     RCX
4968
        ADD     RAX,RBX
4969
        ADC     RDX,R12
4970
        ADD     [RDI + 3*DLimbSize],RAX
4971
        ADC     RDX,R12
4972
        MOV     RBX,RDX
4973

4974
        LEA     RSI,[RSI + 4*DLimbSize]
4975
        LEA     RDI,[RDI + 4*DLimbSize]
4976
        DEC     R11D
4977
        JNE     @InnerLoop64
4978

4979
@InnerTail64:
4980

4981
        MOV     R11D,LeftSize
4982
        AND     R11D,CUnrollMask
4983
        JE      @InnerLoopOddPart
4984

4985
@InnerTailLoop64:
4986

4987
        MOV     RAX,[RSI]
4988
        MUL     RCX
4989
        ADD     RAX,[RDI]
4990
        ADC     RDX,R12
4991
        ADD     RAX,RBX
4992
        ADC     RDX,R12
4993
        MOV     [RDI],RAX
4994
        MOV     RBX,RDX
4995
        LEA     RSI,[RSI + DLimbSize]
4996
        LEA     RDI,[RDI + DLimbSize]
4997
        DEC     R11D
4998
        JNE     @InnerTailLoop64
4999

5000
@InnerLoopOddPart:
5001

5002
        CMP     LeftOdd,0               // If Left's size is odd, handle last limb.
5003
        JE      @InnerLoopLastLimb
5004

5005
        MOV     RAX,[RSI]
5006
        MUL     RCX
5007
        ADD     RAX,[RDI]
5008
        ADC     RDX,R12
5009
        ADD     RAX,RBX
5010
        ADC     RDX,R12
5011
        MOV     [RDI],RAX
5012
        MOV     [RDI + DLimbSize],RDX
5013
        JMP     @NextOuterLoop
5014

5015
@InnerLoopLastLimb:
5016

5017
        MOV     [RDI],RDX
5018

5019
@NextOuterLoop:
5020

5021
        DEC     RightSize
5022
        JNE     @OuterLoop
5023

5024
@FinalOddPart:
5025

5026
        CMP     RightOdd,0
5027
        JE      @Exit
5028

5029
        MOV     RDI,R8
5030
        MOV     RSI,SaveLeft
5031
        MOV     RAX,R10
5032
        MOV     ECX,[RAX]                      // Right is odd, so read single TLimb
5033
        XOR     RBX,RBX
5034
        MOV     R11D,LeftSize
5035
        CMP     R11D,0
5036
        JE      @SkipFinalLoop
5037

5038
        .ALIGN  16
5039

5040
@FinalLoop:
5041

5042
        MOV     RAX,[RSI]
5043
        MUL     RCX
5044
        ADD     RAX,[RDI]
5045
        ADC     RDX,0
5046
        ADD     RAX,RBX
5047
        ADC     RDX,0
5048
        MOV     [RDI],RAX
5049
        MOV     RBX,RDX
5050
        LEA     RSI,[RSI + DLimbSize]
5051
        LEA     RDI,[RDI + DLimbSize]
5052
        DEC     R11D
5053
        JNE     @FinalLoop
5054

5055
@SkipFinalLoop:
5056

5057
        CMP    LeftOdd,0
5058
        JE     @LastLimb
5059

5060
        MOV    EAX,[RSI]
5061
        MUL    RCX
5062
        ADD    RAX,[RDI]
5063
        ADC    RDX,0
5064
        ADD    RAX,RBX
5065
        ADC    RDX,0
5066
        MOV    [RDI],RAX
5067
        MOV    [RDI + DLimbSize],RDX
5068
        JMP    @Exit
5069

5070
@LastLimb:
5071

5072
        MOV    [RDI],RDX
5073

5074
@Exit:
5075

5076
end;
5077
{$ENDIF !WIN32}
5078
{$ENDIF !PUREPASCAL}
5079

5080
function BigInteger.ToBinaryString: string;
5081
begin
5082
  Result := ToString(2);
5083
end;
5084

5085
function BigInteger.ToByteArray: TArray<Byte>;
5086
var
5087
  Mag: TMagnitude;
5088
  Bytes, Bits: Integer;
5089
  ExtraByte: Byte;
5090
begin
5091
  if IsZero then
5092
  begin
5093
    SetLength(Result, 1);
5094
    Result[0] := 0;
5095
    Exit;
5096
  end;
5097

5098
  Bytes := BitLength;
5099
  Bits := Bytes and $07;
5100
  Bytes := (Bytes + 7) shr 3;
5101
  if FSize > 0 then
5102
  begin
5103
    Mag := FData;
5104
    ExtraByte := $00;
5105
  end
5106
  else
5107
  begin
5108
    SetLength(Mag, Size);
5109
    InternalNegate(PLimb(FData), PLimb(Mag), Size);
5110
    ExtraByte := $FF;
5111
  end;
5112
  SetLength(Result, Bytes + Byte(Bits = 0));
5113
  Move(Mag[0], Result[0], Bytes);
5114
  if Bits = 0 then
5115
    Result[Bytes] := ExtraByte;
5116
end;
5117

5118
function BigInteger.ToDecimalString: string;
5119
begin
5120
  Result := ToString(10);
5121
end;
5122

5123
function BigInteger.ToHexString: string;
5124
begin
5125
  Result := ToString(16);
5126
end;
5127

5128
function BigInteger.ToOctalString: string;
5129
begin
5130
  Result := ToString(8);
5131
end;
5132

5133
{$IFNDEF PUREPASCAL}
5134
procedure DivModNativeUInts(Dividend, Divisor: NativeUInt; var Quotient, Remainder: NativeUint);
5135
{$IFDEF WIN32}
5136
asm
5137
        PUSH    EBX
5138
        MOV     EBX,EDX
5139
        XOR     EDX,EDX
5140
        DIV     EAX,EBX
5141
        MOV     [ECX],EAX
5142
        MOV     EBX,Remainder
5143
        MOV     [EBX],EDX
5144
        POP     EBX
5145
end;
5146
{$ELSE WIN64}
5147
asm
5148
        .NOFRAME
5149

5150
        MOV     RAX,RCX
5151
        MOV     RCX,RDX
5152
        XOR     EDX,EDX
5153
        DIV     RAX,RCX
5154
        MOV     [R8],RAX
5155
        MOV     [R9],RDX
5156
end;
5157
{$ENDIF WIN64}
5158
{$ENDIF !PUREPASCAL}
5159

5160
const
5161
  TwoDigitTable: array[0..99, 0..1] of Char =
5162
  (
5163
    '00', '01', '02', '03', '04', '05', '06', '07', '08', '09',
5164
    '10', '11', '12', '13', '14', '15', '16', '17', '18', '19',
5165
    '20', '21', '22', '23', '24', '25', '26', '27', '28', '29',
5166
    '30', '31', '32', '33', '34', '35', '36', '37', '38', '39',
5167
    '40', '41', '42', '43', '44', '45', '46', '47', '48', '49',
5168
    '50', '51', '52', '53', '54', '55', '56', '57', '58', '59',
5169
    '60', '61', '62', '63', '64', '65', '66', '67', '68', '69',
5170
    '70', '71', '72', '73', '74', '75', '76', '77', '78', '79',
5171
    '80', '81', '82', '83', '84', '85', '86', '87', '88', '89',
5172
    '90', '91', '92', '93', '94', '95', '96', '97', '98', '99'
5173
  );
5174

5175
{$IF DEFINED(WIN32)}
5176
  // Checked
5177
  Div100Const = UInt32(UInt64($1FFFFFFFFF) div 100 + 1);
5178
  Div100PostShift = 5;
5179
{$ELSEIF DEFINED(WIN64)}
5180
{$IFDEF LIBDIVIDE}
5181
  // Parameters calculated using
5182
  // https://github.com/ridiculousfish/libdivide/blob/master/divide_by_constants_codegen_reference.c
5183
  Div100Const = $47AE147AE147AE15;
5184
  Div100PostShift = 6;
5185
{$ELSE}
5186
  Div100Const = $A3D70A3D70A3D70B; // UInt64(UInt128($3F FFFF FFFF FFFF FFFF) div 100 + 1)
5187
  Div100PostShift = 6;
5188
{$ENDIF}
5189
{$IFEND}
5190

5191
{$IFNDEF PUREPASCAL}
5192

5193
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5194
///  The following calculates X div 100 using multiplication by a constant, taking the high part of the 64 bit  ///
5195
///  result and shifting right. The return value is the remainder, calculated as X - quotient * 100.            ///
5196
///                                                                                                             ///
5197
///  This was tested to work safely and quickly for all values of UInt32.                                       ///
5198
///                                                                                                             ///
5199
///  The 64 bit part is taken from: https://raw.github.com/ridiculousfish/libdivide/master/libdivide.h          ///
5200
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5201
///
5202
class function BigInteger.InternalDivMod100(var X: NativeUInt): NativeUInt;
5203
{$IFDEF WIN32}
5204
asm
5205
        PUSH    EBX
5206
        MOV     EDX,Div100Const
5207
        MOV     ECX,EAX
5208
        MOV     EAX,[ECX]
5209
        MOV     EBX,EAX
5210
        MUL     EDX
5211
        SHR     EDX,Div100PostShift
5212
        MOV     [ECX],EDX               // Quotient
5213

5214
        // Slightly faster than MUL
5215

5216
        LEA     EDX,[EDX + 4*EDX]       // EDX := EDX * 5;
5217
        LEA     EDX,[EDX + 4*EDX]       // EDX := EDX * 5;
5218
        SHL     EDX,2                   // EDX := EDX * 4; 5*5*4 = 100.
5219

5220
        MOV     EAX,EBX
5221
        SUB     EAX,EDX                 // Remainder
5222
        POP     EBX
5223
end;
5224
{$ELSE WIN64}
5225
asm
5226
        .NOFRAME
5227

5228
        // See libdivide.h: libdivide_u64_do() after a call to libdivide_u64_gen(100)
5229

5230
        MOV     RAX,[RCX]
5231
        MOV     R8,RAX
5232
        XOR     RDX,RDX
5233
        MOV     R9,Div100Const
5234
        MUL     R9              // RDX = Q
5235

5236
{$IFDEF LIBDIVIDE}
5237
        MOV     R9,R8           // Q := Q + (X - Q) shr 1;
5238
        SUB     R9,RDX
5239
        SHR     R9,1
5240
        ADD     RDX,R9
5241
{$ENDIF}
5242

5243
        SHR     RDX,Div100PostShift // Q := Q shr 6;
5244
        MOV     [RCX],RDX       // X := Q;
5245

5246
        // Faster than LEA and SHL
5247

5248
        MOV     RAX,RDX
5249
        MOV     R9D,100
5250
        MUL     R9
5251
        SUB     R8,RAX
5252
        MOV     RAX,R8         // Remainder
5253
end;
5254
{$ENDIF WIN32}
5255
{$ENDIF !PUREPASCAL}
5256

5257
{$IFNDEF PUREPASCAL}
5258
class procedure BigInteger.InternalIntToStrDecimal(const Value: NativeUInt; var WritePtr: PChar; MaxDigits: Integer);
5259
var
5260
  LRemainder, LDividend: NativeUInt;
5261
  LSectionStart: PChar;
5262
begin
5263
  LSectionStart := WritePtr - MaxDigits;
5264
  LDividend := Value;
5265
  if Odd(MaxDigits) and (LDividend <> 0) then
5266
  begin
5267
    DivModNativeUInts(LDividend, 10, LDividend, LRemainder);
5268
    Dec(WritePtr);
5269
    WritePtr^ := Char(LRemainder + Ord('0'));
5270
  end;
5271
  while LDividend > 0 do
5272
  begin
5273
    LRemainder := InternalDivMod100(LDividend);
5274
    Dec(WritePtr, 2);
5275
    WritePtr[0] := TwoDigitTable[LRemainder, 0];
5276
    WritePtr[1] := TwoDigitTable[LRemainder, 1];
5277
  end;
5278

5279
  while WritePtr > LSectionStart do
5280
  begin
5281
    Dec(WritePtr);
5282
    WritePtr^ := '0';
5283
  end;
5284
end;
5285
{$ENDIF}
5286

5287
// Simple version of IntToStr for any given base, for unsigned integers only.
5288
class procedure BigInteger.InternalIntToStrBase(const Value: NativeUInt; Base: Cardinal; var WritePtr: PChar;
5289
  MaxDigits: Integer);
5290
var
5291
{$IFDEF PUREPASCAL}
5292
  LRemainder: UInt64;
5293
  LDividend: UInt64;
5294
{$ELSE}
5295
  LRemainder: NativeUInt;
5296
  LDividend: NativeUInt;
5297
{$ENDIF PUREPASCAL}
5298
  LSectionStart: PChar;
5299
begin
5300
{$IFNDEF PUREPASCAL}
5301
  if Base = 10 then
5302
  begin
5303
    InternalIntToStrDecimal(Value, WritePtr, MaxDigits);
5304
    Exit;
5305
  end;
5306
{$ENDIF}
5307
  LSectionStart := WritePtr - MaxDigits;
5308
  LDividend := Value;
5309
  while LDividend > 0 do
5310
  begin
5311
  {$IFDEF PUREPASCAL}
5312
    System.Math.DivMod(LDividend, Base, LDividend, LRemainder);
5313
  {$ELSE}
5314
    DivModNativeUInts(LDividend, Base, LDividend, LRemainder);
5315
  {$ENDIF PUREPASCAL}
5316
    Dec(WritePtr);
5317
    WritePtr^ := CBaseChars[LRemainder];
5318
  end;
5319

5320
  while WritePtr > LSectionStart do
5321
  begin
5322
    Dec(WritePtr);
5323
    WritePtr^ := '0';
5324
  end;
5325
end;
5326

5327
// This should be easy. Simply shift (beginning from the back) and output. This can be done limb-wise.
5328
class procedure BigInteger.InternalShiftedToString(const Value: BigInteger; Base: Integer; var WritePtr: PChar);
5329
var
5330
  LMaxDigits: Integer;
5331
  LShift: Integer;
5332
  LMask, LLImb: TLimb;
5333
  LSectionStart: PChar;
5334
  I: Integer;
5335
begin
5336
  Assert(Base in [2, 4, 16]);
5337
  case Base of
5338
    2:
5339
      begin
5340
        LMaxDigits := 32;
5341
        LShift := 1;
5342
        LMask := $00000001;
5343
      end;
5344
    4:
5345
      begin
5346
        LMaxDigits := 16;
5347
        LShift := 2;
5348
        LMask := $00000003;
5349
      end;
5350
    else
5351
      begin
5352
        LMaxDigits := 8;
5353
        LShift := 4;
5354
        LMask := $0000000F;
5355
      end;
5356
  end;
5357
  Assert(Value.FSize >= 0);
5358
  for I := 0 to Value.FSize - 1 do
5359
  begin
5360
    LLimb := Value.FData[I];
5361
    LSectionStart := WritePtr - LMaxDigits;
5362
    while LLimb <> 0 do
5363
    begin
5364
      Dec(WritePtr);
5365
      WritePtr^ := CBaseChars[LLimb and LMask];
5366
      LLimb := LLimb shr LShift;
5367
    end;
5368
    while WritePtr > LSectionStart do
5369
    begin
5370
      Dec(WritePtr);
5371
      WritePtr^ := '0';
5372
    end;
5373
  end;
5374
end;
5375

5376
// This is pretty self-documenting, but also cf. Brent, Zimmermann [3], "Modern Computer Arithmetic", algorithm 1.24
5377
class procedure BigInteger.InternalPlainToString(const Value: BigInteger; Base: Integer;
5378
  const BaseInfo: TNumberBaseInfo; var WritePtr: PChar; SectionCount: Integer);
5379
var
5380
  LQuotient, LRemainder: BigInteger;
5381
  LSectionStart: PChar;
5382
begin
5383
  LQuotient := Value;
5384
  LSectionStart := WritePtr - SectionCount * BaseInfo.MaxDigits;
5385

5386
  while Assigned(LQuotient.FData) do
5387
  begin
5388
    BigInteger.DivMod(LQuotient, BaseInfo.MaxPower, LQuotient, LRemainder);
5389
{$IFDEF CPU32BITS}
5390
    if Assigned(LRemainder.FData) then
5391
      InternalIntToStrBase(LRemainder.FData[0], Base, WritePtr, BaseInfo.MaxDigits)
5392
    else
5393
      InternalIntToStrBase(0, Base, WritePtr, BaseInfo.MaxDigits);
5394
{$ELSE}
5395
    InternalIntToStrBase(UInt64(LRemainder), Base, WritePtr, BaseInfo.MaxDigits);
5396
{$ENDIF}
5397
  end;
5398

5399
  while WritePtr > LSectionStart do
5400
  begin
5401
    Dec(WritePtr);
5402
    WritePtr^ := '0';
5403
  end;
5404
end;
5405

5406
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5407
///  About sections: conversion is finally done in digit sections. A section is, depending on base, the number      ///
5408
///  of digits that corresponds to the maximum power of the given base that fits in a NativeUInt.                   ///
5409
///                                                                                                                 ///
5410
///  Example: the highest power of base 10 that fits in a UInt32 is 9 (so MaxPower for base 10 is 10^9 and the      ///
5411
///  number of digits that corresponds with it is 9: MaxDigits). These 9 digits form a section. Since these fit     ///
5412
///  in a UInt32, simple conversion can be done by dividing a UInt32 repeatedly by 10, which is considerably        ///
5413
///  faster than dividing a BigInteger by 10. That is why conversion is done in multiples of a section. FWIW, in    ///
5414
///  64 bit code, the maxium power of 10 that fits in a UInt64 is 19, so in that case, a section for base 10 is     ///
5415
///  19 digits.                                                                                                     ///
5416
///                                                                                                                 ///
5417
///  See bases.inc for MaxPower, MaxDigits and MaxFactor for each base and NativeUInt size.                         ///
5418
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5419

5420
function GetSectionCount(Size, Base: Integer): Integer;
5421
begin
5422
  Result := (UInt64(Size) * CBaseInfos[Base].MaxFactor) shr (CMaxFactorShift - 5) + 1;
5423
end;
5424

5425
// This makes InternalRecursiveToString approx. 27% faster (on huge strings, like the large prime 2^74207281 - 1).
5426
function GetBasePower(Base, Exponent: Integer; MaxPower: NativeUInt): BigInteger;
5427
begin
5428
  if Exponent > High(CBasePowers[Base]) then
5429
    SetLength(CBasePowers[Base], Exponent + 1);
5430
  Result := CBasePowers[Base, Exponent];
5431

5432
  // Note that "uninitialized" BigIntegers have an FData of nil, so they return True on IsZero.
5433
  if Result.IsZero then
5434
  begin
5435

5436
    //////////////////////////////////////////////////////////////////////////////////////////////////////
5437
    ///  Note: I tried using a LastExponent, and if the current exponent was above the last, it would  ///
5438
    ///  multiply the lastly found value with Pow(MaxPower, difference). But that did not provide any  ///
5439
    ///  improvement.                                                                                  ///
5440
    //////////////////////////////////////////////////////////////////////////////////////////////////////
5441

5442
    Result := BigInteger.Pow(MaxPower, Exponent);
5443
    CBasePowers[Base, Exponent] := Result;
5444
  end;
5445
end;
5446

5447
// cf. Brent, Zimmermann [3], "Modern Computer Arithmetic", algorithm 1.26
5448
class procedure BigInteger.InternalRecursiveToString(const Value: BigInteger; Base: Integer;
5449
  const BaseInfo: TNumberBaseInfo; var WritePtr: PChar; SectionCount: Integer);
5450
var
5451
  LHalfSectionCount: Integer;
5452
  LDivisor, LQuotient, LRemainder: BigInteger;
5453
  LSectionStart: PChar;
5454
begin
5455
  LSectionStart := WritePtr - SectionCount * BaseInfo.MaxDigits;
5456

5457
  if SectionCount < RecursiveToStringThreshold then
5458
  begin
5459
    InternalPlainToString(Value, Base, BaseInfo, WritePtr, SectionCount);
5460
    Exit;
5461
  end;
5462

5463
  LHalfSectionCount:= SectionCount shr 1;
5464

5465
  LDivisor := GetBasePower(Base, LHalfSectionCount, BaseInfo.MaxPower);
5466
  BigInteger.DivMod(Value, LDivisor, LQuotient, LRemainder);
5467

5468
  InternalRecursiveToString(LRemainder, Base, BaseInfo, WritePtr, LHalfSectionCount);
5469
  InternalRecursiveToString(LQuotient, Base, BaseInfo, WritePtr, SectionCount - LHalfSectionCount);
5470

5471
  while WritePtr > LSectionStart do
5472
  begin
5473
    Dec(WritePtr);
5474
    WritePtr^ := '0';
5475
  end;
5476

5477
end;
5478

5479
function BigInteger.ToString: string;
5480
begin
5481
  Result := ToString(FBase);
5482
end;
5483

5484
function BigInteger.ToString(Base: Integer): string;
5485
var
5486
  WritePtr: PChar;
5487
  LBuffer: PChar;
5488
  LAbsValue: BigInteger;
5489
  LSectionCount: Integer;       // Expected number of digit sections.
5490
  LBufLen: Integer;
5491
  LBaseInfo: TNumberBaseInfo;
5492
begin
5493
  if not Base in [2..36] then
5494
    Error(ecInvalidBase, []);
5495

5496
  if FData = nil then
5497
    Exit('0');
5498

5499
  if FSize < 0 then
5500
    LAbsValue := -Self
5501
  else
5502
    LAbsValue := Self;
5503

5504
  LBaseInfo := CBaseInfos[Base];
5505

5506
  LSectionCount := GetSectionCount(LAbsValue.Size, Base);
5507
  LBufLen := (LBaseInfo.MaxDigits + 1) * (LSectionCount) + 1;
5508
  GetMem(LBuffer, LBufLen * SizeOf(Char));
5509
  try
5510
    WritePtr := LBuffer + LBufLen - 1;
5511
    WritePtr^ := #0;
5512

5513
    if Base in [2, 4, 16] then
5514
      // 2, 4 and 16 are easy: just take each limb, shift and output, from bottom (could also start from top,
5515
      // but this should be compatible with the other methods).
5516
      InternalShiftedToString(LAbsValue, Base, WritePtr)
5517
    else if (FSize and SizeMask) < RecursiveToStringThreshold then
5518
      // "Small" BigIntegers take the simple approach.
5519
      InternalPlainToString(LAbsValue, Base, LBaseInfo, WritePtr, LSectionCount)
5520
    else
5521
      // Large BigIntegers take the recursive divide-and-conquer approach.
5522
      InternalRecursiveToString(LAbsValue, Base, LBaseInfo, WritePtr, LSectionCount);
5523

5524
    while WritePtr^ = '0' do
5525
      Inc(WritePtr);
5526
    if FSize < 0 then
5527
    begin
5528
      Dec(WritePtr);
5529
      WritePtr^ := '-';
5530
    end;
5531

5532
    Result := string(WritePtr);
5533

5534
  finally
5535
    FreeMem(LBuffer);
5536
  end;
5537
end;
5538

5539
// For debugging purposes. May be removed, so don't use it for regular purposes.
5540
function BigInteger.ToStringClassic(Base: Integer): string;
5541
var
5542
  P: PChar;
5543
  LBuffer: TArray<Char>;
5544
  LMagnitude: TMagnitude;
5545
  LSize: Integer;
5546
begin
5547
  if not Base in [2..36] then
5548
    Error(ecInvalidBase, []);
5549
  if FData = nil then
5550
  begin
5551
    Result := '0';
5552
    Exit;
5553
  end;
5554
  LSize := FSize and SizeMask;
5555
  SetLength(LBuffer, LSize * CStringMaxLengths[Base] + 1);
5556
  LMagnitude := System.Copy(FData);
5557
  P := PChar(LBuffer) + Length(LBuffer);
5558
  Dec(P);
5559
  P^ := #0;
5560
  while LSize > 0 do
5561
  begin
5562
    Dec(P);
5563
    P^ := CBaseChars[InternalDivideByBase(PLimb(LMagnitude), Base, LSize)];
5564
  end;
5565
  if FSize < 0 then
5566
  begin
5567
    Dec(P);
5568
    P^ := '-';
5569
  end;
5570
  Result := P;
5571
end;
5572

5573
// By default, uses FBase as numeric base, otherwise, if string "starts" with $, 0x, 0b or 0o, uses
5574
// 16, 16 (both hex), 2 (binary) and 8 (octal) respectively.
5575
class function BigInteger.TryParse(const S: string; var Value: BigInteger): Boolean;
5576
var
5577
  LTrimmed: string;
5578
  LIsNegative: Boolean;
5579
  P: PChar;
5580
  LBase, LBaseNew: Integer;
5581
begin
5582
  Result := False;
5583
  LTrimmed := UpperCase(Trim(S)); // Make string case insensitive.
5584
  if LTrimmed = '' then
5585
    Exit;
5586
  LIsNegative := False;
5587
  P := PChar(LTrimmed);
5588
  if (P^ = '-') or (P^ = '+') then
5589
  begin
5590
    LIsNegative := (P^ = '-');
5591
    Inc(P);
5592
  end;
5593
  LBase := FBase;               // By default, use global numeric base.
5594
  case P^ of
5595
    '$':                        // $ prefix indicates hexadecimal (equivalent to 0x and %16r)
5596
      begin
5597
        Inc(P);
5598
        LBase := 16;
5599
      end;
5600
    '0':
5601
      begin
5602
        Inc(P);
5603
        case P^ of
5604
          #0:
5605
            begin
5606
              Value := Zero;
5607
              Exit(True);
5608
            end;
5609
          'B':                  // 0b prefix indicates binary (equivalent to %2r)
5610
            LBase := 2;
5611
          'O', 'K':             // 0o17, 0k17 prefixes indicate octal (equivalent to %8r)
5612
            LBase := 8;
5613
          'X':                  // 0x prefix indicates hexadecimal (equivalent to $ and %16r)
5614
            LBase := 16;
5615
          'D':
5616
            LBase := 10;
5617
          else
5618
            Dec(P);
5619
        end;
5620
        Inc(P);
5621
      end;
5622
    '%':                        // %nnr prefix indicates base n (nn is always decimal)
5623
      begin
5624
        Inc(P);
5625
        LBaseNew := 0;
5626
        while P^ <> 'R' do
5627
        begin
5628
          if P^ = #0 then
5629
            Exit;
5630
          LBaseNew := LBaseNew * 10 + Ord(P^) - CNumBase;
5631
          Inc(P);
5632
        end;
5633
        Inc(P);
5634
        if not (LBaseNew in [2..36]) then
5635
          Exit;
5636
        LBase := LBaseNew;
5637
      end;
5638
  end;
5639
  Result := TryParse(P, LBase, Value);
5640
  if Result and LIsNegative then
5641
    Value := -Value;
5642
end;
5643

5644
// cf. Brent, Zimmermann, "Modern Computer Arithmetic", algorithm 1.23
5645
class function BigInteger.TryParse(const S: string; ABase: TNumberBase; var AValue: BigInteger): Boolean;
5646
var
5647
  LIsNegative: Boolean;
5648
  LTrimmed: string;
5649
  LVal: Integer;
5650
  P: PChar;
5651
begin
5652
  Result := False;
5653
  LTrimmed := Trim(S);
5654
  if LTrimmed = '' then
5655
    Exit;
5656
  LIsNegative := False;
5657

5658
  AValue.MakeSize(Length(S) div CStringMinLengths[ABase] + 1);
5659
  AValue.FSize := 0;
5660

5661
  P := PChar(LTrimmed);
5662
  if (P^ = '-') or (P^ = '+') then
5663
  begin
5664
    LIsNegative := (P^ = '-');
5665
    Inc(P);
5666
  end;
5667
  if ABase = 10 then
5668
    Result := InternalParseDecimal(P, AValue)
5669
  else if ABase = 16 then
5670
    Result := InternalParseHex(P, AValue)
5671
  else
5672
  begin
5673
    while P^ <> #0 do
5674
    begin
5675
      if (P^ = '_') or (P^ = ' ') or (P^ = ',') then
5676
      begin
5677
        Inc(P);
5678
        Continue;
5679
      end;
5680
      LVal := Ord(P^);
5681
      Inc(P);
5682
      if LVal in [Ord('0')..Ord('9')] then
5683
        Dec(LVal, CNumBase)
5684
      else if LVal >= CAlphaBase then
5685
      begin
5686
        if LVal >= Ord('a') then
5687
          Dec(LVal, 32);
5688
        Dec(LVal, CAlphaBase - 10);
5689
      end
5690
      else
5691
        Exit;
5692
      if LVal >= ABase then
5693
        Exit;
5694
      InternalMultiplyAndAdd16(PLimb(AValue.FData), ABase, LVal, AValue.FSize);
5695
    end;
5696
    Result := True;
5697
  end;
5698
  if not Result then
5699
  begin
5700
    AValue := BigInteger.Zero;
5701
    Exit;
5702
  end;
5703
{$IFDEF RESETSIZE}
5704
  AValue.Compact;     // FSize is already correct, but Compact also reallocates down, if RESETSIZE requires it.
5705
{$ENDIF}
5706
  if LIsNegative then
5707
    AValue := -AValue;
5708
end;
5709

5710
const
5711
  CIntPowersOfTen: array[1..9] of Integer =
5712
  (
5713
                10,
5714
               100,
5715
              1000,
5716
           10*1000,
5717
          100*1000,
5718
         1000*1000,
5719
      10*1000*1000,
5720
     100*1000*1000,
5721
    1000*1000*1000
5722
  );
5723

5724
class function BigInteger.InternalParseDecimal(P: PChar; var Value: BigInteger): Boolean;
5725
var
5726
  Cumulative: Cardinal;
5727
  N: Integer;
5728
begin
5729
  Value := BigInteger.Zero;
5730
  Result := False;
5731
  while P^ <> #0 do
5732
  begin
5733
    N := 0;
5734
    Cumulative := 0;
5735
    while N < 9 do
5736
    begin
5737
      case P^ of
5738
        '_', ' ', ',':
5739
          begin
5740
            Inc(P);     // Ignore!
5741
            Continue;
5742
          end;
5743
        #0:
5744
          Break;
5745
        '0'..'9':
5746
          Cumulative := Cumulative * 10 + Ord(P^) - Ord('0');
5747
        else
5748
          Exit;
5749
      end;
5750
      Inc(N);
5751
      Inc(P);
5752
    end;
5753
    Value := Value * CIntPowersOfTen[N] + Cumulative;
5754
  end;
5755
  Result := True;
5756
end;
5757

5758
class function BigInteger.InternalParseHex(P: PChar; var Value: BigInteger): Boolean;
5759
var
5760
  Cumulative: Cardinal;
5761
  N: Integer;
5762
begin
5763
  while P^ <> #0 do
5764
  begin
5765
    N := 0;
5766
    Cumulative := 0;
5767
    while N <= 7 do
5768
    begin
5769
      case P^ of
5770
        '_', ' ', ',':
5771
          begin
5772
            Inc(P);     // Ignore!
5773
            Continue;
5774
          end;
5775
        #0:
5776
          Break;
5777
        '0'..'9':
5778
          Cumulative := Cumulative shl 4 + Ord(P^) - Ord('0');
5779
        'A'..'F':
5780
          Cumulative := Cumulative shl 4 + Ord(P^) - Ord('A') + 10;
5781
        'a'..'f':
5782
          Cumulative := Cumulative shl 4 + Ord(P^) - Ord('a') + 10;
5783
        else
5784
          Exit(False);
5785
      end;
5786
      Inc(N);
5787
      Inc(P);
5788
    end;
5789
    Value := Value shl (4 * N) + Cumulative;
5790
  end;
5791
  Result := True;
5792
end;
5793

5794
class procedure BigInteger.Decimal;
5795
begin
5796
  FBase := 10;
5797
end;
5798

5799
class function BigInteger.Divide(const Left: BigInteger; Right: UInt16): BigInteger;
5800
var
5801
  LSign: Integer;
5802
begin
5803
  if Right = 0 then
5804
    Error(ecDivByZero, []);
5805
  if Left.FData = nil then
5806
  begin
5807
    ShallowCopy(Zero, Result);
5808
    Exit;
5809
  end;
5810
  LSign := Left.FSize and SignMask;
5811
  Result.MakeSize(Left.FSize and SizeMask);
5812
  InternalDivMod16(PLimb(Left.FData), Right, PLImb(Result.FData), nil, Left.FSize and SizeMask);
5813
  Result.Compact;
5814
  if Assigned(Result.FData) then
5815
    Result.FSize := (Result.FSize and SizeMask) or LSign;
5816
end;
5817

5818
class function BigInteger.Divide(const Left: BigInteger; Right: UInt32): BigInteger;
5819
var
5820
  LSign: Integer;
5821
begin
5822
  if Right = 0 then
5823
    Error(ecDivByZero, []);
5824
  if Left.FData = nil then
5825
  begin
5826
    ShallowCopy(Zero, Result);
5827
    Exit;
5828
  end;
5829
  LSign := Left.FSize and SignMask;
5830
  Result.MakeSize(Left.FSize and SizeMask);
5831
  InternalDivMod32(PLimb(Left.FData), Right, PLimb(Result.FData), nil, Left.FSize and SizeMask);
5832
  Result.Compact;
5833
  if Assigned(Result.FData) then
5834
    Result.FSize := (Result.FSize and SizeMask) or LSign;
5835
end;
5836

5837
class function BigInteger.Divide(const Left, Right: BigInteger): BigInteger;
5838
var
5839
  Sign, LSize, RSize: Integer;
5840
  Remainder: BigInteger;
5841
begin
5842
  if Right.FData = nil then
5843
    Error(ecDivByZero, []);
5844

5845
  if Left.FData = nil then
5846
    Exit(Zero);
5847

5848
  Sign := (Left.FSize and SignMask) xor (Right.FSize and SignMask);
5849
  LSize := Left.FSize and SizeMask;
5850
  RSize := Right.FSize and SizeMask;
5851

5852
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
5853
    -1:
5854
      begin
5855
        ShallowCopy(Zero, Result);
5856
      end;
5857
    0:
5858
      begin
5859
        if Sign = 0 then
5860
          ShallowCopy(One, Result)
5861
        else
5862
          ShallowCopy(MinusOne, Result);
5863
      end;
5864
    else
5865
      begin
5866
        if ShouldUseBurnikelZiegler(LSize, RSize) then
5867
          DivModBurnikelZiegler(Left, Right, Result, Remainder)
5868
        else
5869
          DivModKnuth(Left, Right, Result, Remainder);
5870

5871
        if Result.FSize <> 0 then
5872
          Result.FSize := (Result.FSize and SizeMask) or Sign;
5873
      end;
5874
  end;
5875
end;
5876

5877
{$IFNDEF BIGINTEGERIMMUTABLE}
5878
function BigInteger.Divide(const Other: BigInteger): PBigInteger;
5879
begin
5880
  Result := @Self;
5881
  Self := Self div Other;
5882
end;
5883
{$ENDIF}
5884

5885
class procedure BigInteger.DivMod(const Dividend, Divisor: BigInteger; var Quotient, Remainder: BigInteger);
5886
var
5887
  LSize, RSize: Integer;
5888
begin
5889
  if Divisor.FData = nil then
5890
    Error(ecDivByZero, []);
5891

5892
  LSize := Dividend.FSize and SizeMask;
5893
  RSize := Divisor.FSize and SizeMask;
5894

5895
  case InternalCompare(PLimb(Dividend.FData), PLimb(Divisor.FData), LSize, RSize) of
5896
    -1:
5897
      begin
5898
        ShallowCopy(Dividend, Remainder);
5899
        ShallowCopy(Zero, Quotient);
5900
        Exit;
5901
      end;
5902
    0:
5903
      begin
5904
        if (Dividend.FSize xor Divisor.FSize) and SignMask = 0 then
5905
          ShallowCopy(One, Quotient)
5906
        else
5907
          ShallowCopy(MinusOne, Quotient);
5908
        ShallowCopy(Zero, Remainder);
5909
        Exit;
5910
      end
5911
    else
5912
      begin
5913
        if ShouldUseBurnikelZiegler(LSize, RSize) then
5914
          DivModBurnikelZiegler(Dividend, Divisor, Quotient, Remainder)
5915
        else
5916
          UncheckedDivModKnuth(Dividend, Divisor, Quotient, Remainder);
5917
      end;
5918
  end;
5919
end;
5920

5921
class procedure BigInteger.UncheckedDivModKnuth(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
5922
var
5923
  LSign, RSign: Integer;
5924
  LSize, RSize: Integer;
5925
  Q, R: BigInteger;
5926
  Offset: Integer;              // Offset into left and right data when eliminating common trailing zero limbs.
5927

5928
  // Establish number of common trailing zero limbs.
5929
  function CommonTrailingZeros(const Left, Right: PLimb; LSize, RSize: Integer): Integer;
5930
  var
5931
    I: Integer;
5932
  begin
5933
    Result := 0;
5934
    for I := 0 to IntMin(LSize, RSize) - 1 do
5935
      if (Left[I] or Right[I]) <> 0 then
5936
        Exit(I);
5937
  end;
5938

5939
begin
5940
  if Right.FData = nil then
5941
    Error(ecDivByZero, []);
5942

5943
  LSign := Left.FSize and SignMask;
5944
  RSign := Right.FSize and SignMask;
5945
  LSize := Left.FSize and SizeMask;
5946
  RSize := Right.FSize and SizeMask;
5947

5948
  if (LSize and RSize) <> 0 then
5949
  begin
5950
    Offset := CommonTrailingZeros(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize);
5951
  end
5952
  else
5953
    Offset := 0;
5954

5955
  Q.MakeSize(LSize - RSize + 1);
5956
  R.MakeSize(RSize + 1); // RSize should be enough, but apparently in 64 mode asm, it overwrites one extra limb.
5957
  if not InternalDivMod(PLimb(Left.FData) + Offset, PLimb(Right.FData) + Offset, PLimb(Q.FData),
5958
           PLimb(R.FData) + Offset, LSize - Offset, RSize - Offset) then
5959
    Error(ecInvalidBase, []);
5960
  Q.Compact;
5961
  R.Compact;
5962

5963
  if Q.FSize <> 0 then
5964
    Q.FSize := (Q.FSize and SizeMask) or (LSign xor RSign);
5965
  if R.FSize <> 0 then
5966
    R.FSize := (R.FSize and SizeMask) or LSign;
5967
  ShallowCopy(Q, Quotient);
5968
  ShallowCopy(R, Remainder);
5969
end;
5970

5971
class procedure BigInteger.DivModKnuth(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
5972
var
5973
  LSign, RSign: Integer;
5974
  LSize, RSize: Integer;
5975
  Q, R: BigInteger;
5976
  Offset: Integer;              // Offset into left and right data when eliminating common trailing zero limbs.
5977

5978
  // Establish number of common trailing zero limbs.
5979
  function CommonTrailingZeros(const Left, Right: PLimb; LSize, RSize: Integer): Integer;
5980
  var
5981
    I: Integer;
5982
  begin
5983
    Result := 0;
5984
    for I := 0 to IntMin(LSize, RSize) - 1 do
5985
      if (Left[I] or Right[I]) <> 0 then
5986
        Exit(I);
5987
  end;
5988

5989
begin
5990
  if Right.FData = nil then
5991
    Error(ecDivByZero, []);
5992

5993
  LSign := Left.FSize and SignMask;
5994
  RSign := Right.FSize and SignMask;
5995
  LSize := Left.FSize and SizeMask;
5996
  RSize := Right.FSize and SizeMask;
5997

5998
  if (LSize and RSize) <> 0 then
5999
  begin
6000
    Offset := CommonTrailingZeros(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize);
6001
  end
6002
  else
6003
    Offset := 0;
6004

6005
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
6006
    -1:
6007
      begin
6008
        ShallowCopy(Left, Remainder);
6009
        ShallowCopy(Zero, Quotient);
6010
        Exit;
6011
      end;
6012
    0:
6013
      begin
6014
        ShallowCopy(Zero, Remainder);
6015
        if LSign = RSign then
6016
          ShallowCopy(One, Quotient)
6017
        else
6018
          ShallowCopy(MinusOne, Quotient);
6019
        Exit;
6020
      end
6021
    else
6022
      begin
6023
        Q.MakeSize(LSize - RSize + 1);
6024
        R.MakeSize(RSize + 1); // RSize should be enough, but apparently in 64 mode asm, it overwrites one extra limb.
6025
        if not InternalDivMod(PLimb(Left.FData) + Offset, PLimb(Right.FData) + Offset, PLimb(Q.FData),
6026
                 PLimb(R.FData) + Offset, LSize - Offset, RSize - Offset) then
6027
          Error(ecInvalidBase, []);
6028
        Q.Compact;
6029
        R.Compact;
6030
        if Q.FSize <> 0 then
6031
          Q.FSize := (Q.FSize and SizeMask) or (LSign xor RSign);
6032
        if R.FSize <> 0 then
6033
          R.FSize := (R.FSize and SizeMask) or LSign;
6034
        ShallowCopy(Q, Quotient);
6035
        ShallowCopy(R, Remainder);
6036
      end;
6037
  end;
6038
end;
6039

6040
class procedure BigInteger.InternalShiftLeft(Source, Dest: PLimb; Shift, Size: Integer);
6041
{$IF DEFINED(PUREPASCAL)}
6042
var
6043
  I: Integer;
6044
begin
6045
  Shift := Shift and 31;
6046
  if Shift = 0 then
6047
    CopyLimbs(Source, Dest, Size)
6048
  else
6049
  begin
6050
    Dest[Size] := Source[Size - 1] shr (CLimbBits - Shift);
6051
    for I := Size - 1 downto 1 do
6052
      Dest[I] := (Source[I] shl Shift) or (Source[I - 1] shr (CLimbBits - Shift));
6053
    Dest[0] := Source[0] shl Shift;
6054
  end;
6055
end;
6056
{$ELSEIF DEFINED(WIN32)}
6057
asm
6058
        PUSH    ESI
6059
        PUSH    EDI
6060
        PUSH    EBX
6061

6062
        MOV     ESI,EAX
6063
        MOV     EDI,EDX
6064
        XOR     EAX,EAX
6065

6066
        // No need to test for nil.
6067
        MOV     EBX,Size
6068

6069
        DEC     EBX
6070
        JS      @LoopEnd
6071

6072
@ShiftLoop:
6073

6074
        MOV     EDX,[ESI + CLimbSize*EBX]
6075
        SHLD    EAX,EDX,CL
6076
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
6077
        MOV     EAX,EDX
6078

6079
@ShiftStart:
6080

6081
        DEC     EBX
6082
        JNS     @ShiftLoop
6083

6084
@LoopEnd:
6085

6086
        SHL     EAX,CL
6087
        MOV     [EDI],EAX
6088

6089
@Exit:
6090

6091
        POP     EBX
6092
        POP     EDI
6093
        POP     ESI
6094
end;
6095
{$ELSE}
6096
asm
6097
        XCHG    RCX,R8
6098
        MOV     R10,RDX
6099

6100
        XOR     EAX,EAX
6101
        DEC     R9D
6102
        JS      @LoopEnd
6103

6104
@ShiftLoop:
6105

6106
        MOV     EDX,[R8 + CLimbSize*R9]
6107
        SHLD    EAX,EDX,CL
6108
        MOV     [R10 + CLimbSize*R9 + CLimbSize],EAX
6109
        MOV     EAX,EDX
6110

6111
@ShiftStart:
6112

6113
        DEC     R9D
6114
        JNS     @ShiftLoop
6115

6116
@LoopEnd:
6117

6118
        SHL     EAX,CL
6119
        MOV     [R10],EAX
6120

6121
@Exit:
6122
end;
6123
{$IFEND}
6124

6125
class procedure BigInteger.InternalShiftRight(Source, Dest: PLimb; Shift, Size: Integer);
6126
{$IF DEFINED(PUREPASCAL)}
6127
var
6128
  I: Integer;
6129
begin
6130
  Shift := Shift and 31;
6131
  if Shift = 0 then
6132
    CopyLimbs(Source, Dest, Size)
6133
  else
6134
  begin
6135
    for I := 0 to Size - 1 do
6136
      Dest[I] := (Source[I] shr Shift) or (Source[I + 1] shl (CLimbBits - Shift));
6137
    Dest[Size - 1] := Source[Size - 1] shr Shift;
6138
  end;
6139
end;
6140
{$ELSEIF DEFINED(WIN32)}
6141
asm
6142
        PUSH    ESI
6143
        PUSH    EDI
6144
        PUSH    EBX
6145

6146
        MOV     ESI,EAX
6147
        MOV     EDI,EDX
6148
        MOV     EBX,Size
6149
        MOV     EAX,[ESI]
6150
        LEA     ESI,[ESI + CLimbSize]
6151
        DEC     EBX
6152
        JE      @EndLoop
6153

6154
@ShiftLoop:
6155

6156
        MOV     EDX,[ESI]
6157
        SHRD    EAX,EDX,CL
6158
        MOV     [EDI],EAX
6159
        MOV     EAX,EDX
6160
        LEA     ESI,[ESI + CLimbSize]
6161
        LEA     EDI,[EDI + CLimbSize]
6162
        DEC     EBX
6163
        JNE     @ShiftLoop
6164

6165
@EndLoop:
6166

6167
        SHR     EAX,CL
6168
        MOV     [EDI],EAX
6169

6170
@Exit:
6171

6172
        POP     EBX
6173
        POP     EDI
6174
        POP     ESI
6175
end;
6176
{$ELSE}
6177
asm
6178
        XCHG    RCX,R8                        // R8 = source, ECX = shift
6179

6180
        MOV     EAX,[R8]
6181
        LEA     R8,[R8 + CLimbSize]
6182
        DEC     R9D
6183
        JE      @LoopEnd
6184

6185
@ShiftLoop:
6186

6187
        MOV     R10D,[R8]
6188
        SHRD    EAX,R10D,CL
6189
        MOV     [RDX],EAX
6190
        MOV     EAX,R10D
6191
        LEA     RDX,[RDX + CLimbSize]
6192
        LEA     R8,[R8 + CLimbSize]
6193
        DEC     R9D
6194
        JNE     @ShiftLoop
6195

6196
@LoopEnd:
6197

6198
        SHR     EAX,CL
6199
        MOV     [RDX],EAX
6200

6201
@Exit:
6202

6203
end;
6204
{$IFEND}
6205

6206
type
6207
{$IFDEF CPU64BITS}
6208
  TDivLimb = UInt32;
6209
  TDblLimb = UInt64;
6210
{$ELSE}
6211
  TDivLimb = UInt16;
6212
  TDblLimb = UInt32;
6213
{$ENDIF}
6214
  PDivLimb = ^TDivLimb;
6215
  PDblLimb = ^TDblLimb;
6216

6217
const
6218
  CDivLimbBase = TDblLimb(High(TDivLimb)) + 1;
6219
  CDivLimbBits = SizeOf(TDivLimb) * 8;
6220
  CDblLimbBits = SizeOf(TDblLimb) * 8;
6221

6222
class function BigInteger.InternalDivMod16(Dividend: PLimb; Divisor: UInt16; Quotient, Remainder: PLimb;
6223
  LSize: Integer): Boolean;
6224
{$IFDEF PUREPASCAL}
6225
// In PUREPASCAL, using 16-bit division with an intermediate 32-bit result turned out to be faster than
6226
// 32-bit division with an intermediate 64-bit result.
6227
type
6228
  PUInt16 = ^UInt16;
6229
var
6230
  J: Integer;
6231
  LRemainder: UInt16;
6232
begin
6233
  LSize := LSize + LSize;
6234

6235
  LRemainder := 0;
6236
  for J := LSize - 1 downto 0 do
6237
    System.Math.DivMod(Cardinal(LRemainder shl 16 + PUInt16(Dividend)[J]), Divisor, PUInt16(Quotient)[J], LRemainder);
6238

6239
  if Assigned(Remainder) then
6240
    Remainder[0] := LRemainder;
6241
  Exit(True);
6242
end;
6243
{$ELSE !PUREPASCAL}
6244
// In assembler, 32 bit division is faster, so promote divisor to 32 bit and use InternalDivMod32.
6245
begin
6246
  Result := InternalDivMod32(Dividend, UInt32(Divisor), Quotient, Remainder, LSize);
6247
end;
6248
{$ENDIF !PUREPASCAL}
6249

6250
class function BigInteger.InternalDivMod32(Dividend: PLimb; Divisor: UInt32; Quotient, Remainder: PLimb;
6251
  LSize: Integer): Boolean;
6252
{$IFDEF PUREPASCAL}
6253
{$IFDEF CPU32BITS}
6254
begin
6255
  // In 32PP, plain division using System.Math.DivMod(UInt64, ...) is much slower than this:
6256
  Result := InternalDivMod(Dividend, @Divisor, Quotient, Remainder, LSize, 1);
6257
end;
6258
{$ELSE CPU64BITS}
6259
var
6260
  J: Integer;
6261
  LQuotient, LRemainder: UInt64;
6262
begin
6263
  LRemainder := 0;
6264
  for J := LSize - 1 downto 0 do
6265
  begin
6266
    // DivMod(UInt64, UInt64, var UInt64, var UInt64)
6267
{$IFOPT R+}
6268
{$DEFINE RCHECKS}
6269
{$R-}
6270
{$ENDIF}
6271
    System.Math.DivMod((LRemainder shl 32) or Dividend[J], Divisor, LQuotient, LRemainder);
6272
{$IFDEF RCHECKS}
6273
{$R+}
6274
{$UNDEF RCHECKS}
6275
{$ENDIF}
6276
    Quotient[J] := TLimb(LQuotient);
6277
  end;
6278
  if Assigned(Remainder) then
6279
    Remainder[0] := TLimb(LRemainder);
6280
  Exit(True);
6281
end;
6282
{$ENDIF CPU64BITS}
6283
{$ELSE !PUREPASCAL}
6284
{$IFDEF WIN32}
6285
asm
6286

6287
// Note: in some versions of Delphi, DIV EBX generates the wrong opcode, while DIV EAX,EBX doesn't. The same for
6288
//       MUL EBX and MUL EAX,EBX.
6289

6290
        PUSH    ESI
6291
        PUSH    EDI
6292
        PUSH    EBX
6293

6294
        MOV     EBX,EDX
6295

6296
        MOV     EDI,LSize
6297
        LEA     ESI,[EAX + CLimbSize*EDI - CLimbSize]
6298
        LEA     ECX,[ECX + CLimbSize*EDI - CLimbSize]
6299
        XOR     EDX,EDX
6300

6301
        SHR     EDI,CUnrollShift
6302
        JE      @Tail
6303

6304
@DivLoop:
6305

6306
        MOV     EAX,[ESI]
6307
        DIV     EAX,EBX
6308
        MOV     [ECX],EAX
6309

6310
        MOV     EAX,[ESI - CLimbSize]
6311
        DIV     EAX,EBX
6312
        MOV     [ECX - CLimbSize],EAX
6313

6314
        MOV     EAX,[ESI - 2 * CLimbSize]
6315
        DIV     EAX,EBX
6316
        MOV     [ECX - 2 * CLimbSize],EAX
6317

6318
        MOV     EAX,[ESI - 3 * CLimbSize]
6319
        DIV     EAX,EBX
6320
        MOV     [ECX - 3 * CLimbSize],EAX
6321

6322
        LEA     ESI,[ESI - 4 * CLimbSize]
6323
        LEA     ECX,[ECX - 4 * CLimbSize]
6324
        DEC     EDI
6325
        JNE     @DivLoop
6326

6327
@Tail:
6328

6329
        MOV     EDI,LSize
6330
        AND     EDI,CUnrollMask
6331
        JE      @StoreRemainder
6332

6333
@TailLoop:
6334

6335
        MOV     EAX,[ESI]
6336
        DIV     EAX,EBX
6337
        MOV     [ECX],EAX
6338
        LEA     ESI,[ESI - CLimbSize]
6339
        LEA     ECX,[ECX - CLimbSize]
6340
        DEC     EDI
6341
        JNE     @TailLoop
6342

6343
@StoreRemainder:
6344

6345
        MOV     EBX,Remainder
6346
        OR      EBX,EBX
6347
        JE      @Exit
6348

6349
        MOV     [EBX],EDX
6350

6351
@Exit:
6352

6353
        MOV     EAX,1
6354

6355
        POP     EBX
6356
        POP     EDI
6357
        POP     ESI
6358

6359
end;
6360
{$ELSE WIN64}
6361
asm
6362
        MOV     R10D,EDX
6363

6364
        MOV     R11D,LSize
6365
        LEA     RCX,[RCX + R11*CLimbSize]
6366
        LEA     R8,[R8 + R11*CLimbSize]
6367
        XOR     EDX,EDX
6368

6369
        SHR     R11D,CUnrollShift
6370
        JE      @Tail
6371

6372
@DivLoop:
6373

6374
        // Note: 64 bit division turned out to be considerably slower!
6375

6376
        MOV     EAX,[RCX - CLimbSize]
6377
        DIV     EAX,R10D                        // Uses DIV EAX,R10D syntax because of bug in XE 64 bit assembler.
6378
        MOV     [R8 - CLimbSize],EAX
6379

6380
        MOV     EAX,[RCX - 2 * CLimbSize]
6381
        DIV     EAX,R10D
6382
        MOV     [R8 - 2 * CLimbSize],EAX
6383

6384
        MOV     EAX,[RCX - 3 * CLimbSize]
6385
        DIV     EAX,R10D
6386
        MOV     [R8 - 3 * CLimbSize],EAX
6387

6388
        MOV     EAX,[RCX - 4 * CLimbSize]
6389
        DIV     EAX,R10D
6390
        MOV     [R8 - 4 * CLimbSize],EAX
6391

6392
        LEA     RCX,[RCX - 4 * CLimbSize]
6393
        LEA     R8,[R8 - 4 * CLimbSize]
6394
        DEC     R11D
6395
        JNE     @DivLoop
6396

6397
@Tail:
6398

6399
        MOV     R11D,LSize
6400
        AND     R11D,CUnrollMask
6401
        JE      @StoreRemainder
6402

6403
@TailLoop:
6404

6405
        MOV     EAX,[RCX - ClimbSize]
6406
        DIV     EAX,R10D
6407
        MOV     [R8 - CLimbSize],EAX
6408
        LEA     RCX,[RCX - CLimbSize]
6409
        LEA     R8,[R8 - CLimbSize]
6410
        DEC     R11D
6411
        JNE     @TailLoop
6412

6413
@StoreRemainder:
6414

6415
        OR      R9,R9
6416
        JE      @Exit
6417
        MOV     [R9],EDX
6418

6419
@Exit:
6420

6421
        MOV     EAX,1
6422

6423
end;
6424
{$ENDIF}
6425
{$ENDIF PUREPASCAL}
6426

6427
class function BigInteger.InternalDivMod(Dividend, Divisor, Quotient, Remainder: PLimb; LSize, RSize: Integer): Boolean;
6428

6429
// Basecase division, see Knuth TAOCP, Vol. 2.
6430

6431
{$IF DEFINED(PUREPASCAL)}
6432
var
6433
  PDividend, PDivisor, PQuotient, PRemainder: PDivLimb;
6434
  NormDividend, NormDivisor: TArray<TDivLimb>;          // Normalized dividend and divisor
6435
  QHat: TDblLimb;                                       // Estimate quotient limb
6436
  RHat: TDblLimb;                                       // Remainder after calculating QHat
6437
  Product: TDblLimb;                                    // Product of limb and QHat
6438
  Shift, RevShift, I, J: Integer;                       // Help variables
6439
  NormDividendTop2, NormDivisorTop: TDblLimb;
6440
{$IF SizeOf(TDivLimb) = SizeOf(TLimb)}
6441
  Carry, Value: Int64;
6442
{$ELSE}
6443
  Carry, Value: Integer;
6444
{$IFEND}
6445
begin
6446
  Assert(SizeOf(TDblLimb) = 2 * SizeOf(TDivLimb));
6447
  PDividend := PDivLimb(Dividend);
6448
  PDivisor := PDivLimb(Divisor);
6449
  PQuotient := PDivLimb(Quotient);
6450
  PRemainder := PDivLimb(Remainder);
6451

6452
{$IF SizeOf(TLimb) > SizeOf(TDivLimb)}
6453
  LSize := LSize + LSize;
6454
  RSize := RSize + RSize;
6455

6456
  if PDivisor[RSize - 1] = 0 then
6457
    Dec(RSize);
6458
{$IFEND}
6459

6460
  ///////////////////////////////////////////////////////////////////////////////////////////////////////
6461
  ///  NOTE: In Win32, this uses 16-bit division (with 32-bit intermediate results) to avoid having   ///
6462
  ///        to use 64-bit unsigned integers. This turned out to be (approx. 17%) faster than using   ///
6463
  ///        32-bit limbs.                                                                            ///
6464
  ///        In Win64, this uses 32-bit division with 64-bit intermediate results.                    ///
6465
  ///////////////////////////////////////////////////////////////////////////////////////////////////////
6466

6467
  if (LSize < RSize) then
6468
    Exit(False);
6469

6470
  while (RSize > 0) and (PDivisor[RSize - 1] = 0) do
6471
    Dec(RSize);
6472
  if RSize = 0 then
6473
    Exit(False);
6474

6475
  while (LSize > 0) and (PDividend[LSize - 1] = 0) do
6476
    Dec(LSize);
6477

6478
  ///////////////////////////////////////////////////////////////////////////////////////////////////////
6479
  /// Perhaps it makes sense to shift away common trailing zero limbs, if divisor > certain size.     ///
6480
  /// Shifting should be pretty simple: simply remove any common zeroes in both dividend and divisor, ///
6481
  /// generate an offset to the lowest non-zero limb and shift accordingly (when normalizing).        ///
6482
  /// Note that the remainder must be amended accordingly.                                            ///
6483
  /// Note2: No need to amend the result: x / y == (x/n) / (y/n), when n is the trailing zero part.   ///
6484
  ///////////////////////////////////////////////////////////////////////////////////////////////////////
6485

6486
  if RSize = 1 then
6487
  begin
6488
    // Handle single-digit divisor.
6489

6490
  {$IF SizeOf(TDivLimb) = SizeOf(TLimb)}
6491
    Exit(InternalDivMod32(Dividend, PDivisor[0], Quotient, Remainder, LSize));
6492
  {$ELSE}
6493
    Exit(InternalDivMod16(Dividend, PDivisor[0], Quotient, Remainder, (LSize + 1) div 2));
6494
  {$IFEND}
6495
  end;
6496
  // Normalize by shifting divisor left just enough so that its high-order bit is set, and shift
6497
  // dividend left the same amount. A high-order digit is prepended to dividend unconditionally.
6498

6499
  // Get number of leading zeroes.
6500
  Shift := Velthuis.Numerics.NumberOfLeadingZeros(PDivisor[RSize - 1]); // 0 <= Shift < Bits.
6501
  RevShift := CDivLimbBits - Shift;
6502

6503
  // Normalize divisor and shift dividend left accordingly.
6504
  SetLength(NormDivisor, RSize);
6505
  SetLength(NormDividend, LSize + 1);
6506
  if Shift > 0 then
6507
  begin
6508
    for I := RSize - 1 downto 1 do
6509
      NormDivisor[I] := TDivLimb((TDblLimb(PDivisor[I]) shl Shift) or (TDblLimb(PDivisor[I - 1]) shr RevShift));
6510
    NormDivisor[0] := TDivLimb(TDblLimb(PDivisor[0]) shl Shift);
6511

6512
    NormDividend[LSize] := PDividend[LSize - 1] shr RevShift;
6513
    for I := LSize - 1 downto 1 do
6514
      NormDividend[I] := TDivLimb((TDblLimb(PDividend[I]) shl Shift) or (TDblLimb(PDividend[I - 1]) shr RevShift));
6515
    NormDividend[0] := TDivLimb(TDblLimb(PDividend[0]) shl Shift);
6516
  end
6517
  else
6518
  begin
6519
    // SizeOf(TDivLimb) is not always SizeOf(TLimb), so don't use MoveLimbs() here.
6520
    Move(PDivisor[0], NormDivisor[0], RSize * SizeOf(TDivLimb));
6521
    Move(PDividend[0], NormDividend[0], LSize * SizeOf(TDivLimb));
6522
  end;
6523

6524
  // Knuth's basecase algorithm.
6525

6526
  // Main loop.
6527
  for J := LSize - RSize downto 0 do
6528
  begin
6529
    NormDivisorTop := NormDivisor[RSize - 1];
6530
    NormDividendTop2 := PDblLimb(@NormDividend[J + RSize - 1])^;
6531

6532
    // QHat -- q^ in TAOCP -- is (first) estimate of Quotient[J]
6533
    QHat := NormDividendTop2 div NormDivisorTop;
6534

6535
    // RHat -- r^ in TAOCP -- is remainder belonging to q^.
6536
    RHat := NormDividendTop2 - QHat * NormDivisorTop;
6537

6538
    while (QHat * NormDivisor[RSize - 2] > RHat shl CDivLimbBits + NormDividend[J + RSize - 2]) or
6539
          (QHat >= CDivLimbBase) do
6540
    begin
6541
      Dec(QHat);
6542
      Inc(RHat, NormDivisorTop);
6543

6544
      if RHat >= CDivLimbBase then
6545
        Break;
6546
    end;
6547

6548
    // Multiply and subtract.
6549
    Carry := 0;
6550
    for I := 0 to RSize - 1 do
6551
    begin
6552
      Product := QHat * NormDivisor[I];
6553
      Value := NormDividend[I + J] - Carry - TDivLimb(Product);
6554
      NormDividend[I + J] := TDivLimb(Value);
6555
    {$IF SizeOf(TLimb) = SizeOf(TDivLimb)}
6556
      // Integer cast to force sign-extension of 'Value shr Bits'
6557
      Carry := Int64(Product) shr CDivLimbBits - Integer(Value shr CDivLimbBits);
6558
    {$ELSE}
6559
      // Smallint cast to force sign-extension of 'Value shr Bits'
6560
      Carry := Integer(Product) shr CDivLimbBits - Smallint(Value shr CDivLimbBits);
6561
    {$IFEND}
6562
    end;
6563
    Value := NormDividend[J + RSize] - Carry;
6564
    NormDividend[J + RSize] := TDivLimb(Value);
6565

6566
    if Value < 0 then
6567
    begin
6568

6569
      // If too much was subtracted, add back.
6570
      Dec(QHat);
6571
      Value := 0;
6572
      for I := 0 to RSize - 1 do
6573
      begin
6574

6575
        /////////////////////////////////////////////////////////////////////////////////////////////////
6576
        ///  Note: the original code was:                                                             ///
6577
        ///                                                                                           ///
6578
        ///    Value := NormDividend[I + J] + NormDivisor[I] + Value shr CDivLimbBits;                ///
6579
        ///                                                                                           ///
6580
        ///  That caused bad results in 64 bit, probably because the first two operands were          ///
6581
        ///  treated as 32 bit first, i.e.                                                            ///
6582
        ///                                                                                           ///
6583
        ///    UInt64 := UInt64(UInt32 + UInt32) + UInt64;                                            ///
6584
        ///                                                                                           ///
6585
        ///  instead of                                                                               ///
6586
        ///                                                                                           ///
6587
        ///    UInt64 := UInt64 + UInt64 + UInt64;                                                    ///
6588
        /////////////////////////////////////////////////////////////////////////////////////////////////
6589

6590
        Value := Value shr CDivLimbBits + NormDividend[I + J] + NormDivisor[I];
6591
        NormDividend[I + J] := TDivLimb(Value);
6592
      end;
6593
      Inc(NormDividend[J + RSize], Value shr CDivLimbBits);
6594
    end;
6595

6596
    PQuotient[J] := QHat;
6597
  end;
6598

6599
  // If the caller wants the remainder, unnormalize it and pass it back.
6600
  if Assigned(PRemainder) then
6601
    if Shift <> 0 then
6602
      for I := 0 to RSize - 1 do
6603
        PRemainder[I] := TDivLimb((TDblLimb(NormDividend[I]) shr Shift) or (TDblLimb(NormDividend[I + 1]) shl RevShift))
6604
    else
6605
      for I := 0 to RSize - 1 do
6606
        PRemainder[I] := NormDividend[I];
6607

6608
  Result := True;
6609
end;
6610
{$ELSEIF DEFINED(WIN32)}
6611
var
6612
  LDividend, LDivisor, LQuotient: PLimb;                // Local copies of passed registers
6613
  NormDividend, NormDivisor: PLimb;                     // Manually managed dynamic arrays
6614
  QHat, RHat, Product: TUInt64;                         // 64 bit intermediate results
6615
  Overflow: TLimb;                                      // "Carry" between multiplications
6616
  Shift: Integer;                                       // Normalization shift
6617
asm
6618
        PUSH    ESI
6619
        PUSH    EDI
6620
        PUSH    EBX
6621

6622
        // To avoid reference count problems with Delphi's dynamic array types, we do our own,
6623
        // "old school" dynarrays, using GetMem and FreeMem.
6624

6625
        XOR     EBX,EBX                         // Set "dynarrays" to nil, so the FreeMem calls won't fail.
6626
        MOV     NormDividend,EBX
6627
        MOV     NormDivisor,EBX
6628

6629
        MOV     LDividend,EAX
6630
        MOV     LDivisor,EDX
6631
        MOV     LQuotient,ECX
6632

6633
        MOV     ESI,LSize
6634
        MOV     EDI,RSize
6635
        CMP     ESI,EDI
6636
        JL      @ExitFalse
6637

6638
        DEC     EDI
6639
        JS      @ExitFalse
6640
        JNE     @MultiLimbDivisor
6641

6642
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6643
///  Simple division                                                                                  ///
6644
///    Divisor only contains one single limb: simple division and exit.                               ///
6645
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6646

6647
@SingleLimbDivisor:
6648

6649
        MOV     EBX,[EDX]
6650
        DEC     ESI
6651
        MOV     EDI,EAX
6652
        XOR     EDX,EDX
6653

6654
@SingleDivLoop:
6655

6656
        MOV     EAX,[EDI + CLimbSize*ESI]
6657
        DIV     EAX,EBX
6658
        MOV     [ECX + CLimbSize*ESI],EAX
6659
        DEC     ESI
6660
        JNS     @SingleDivLoop
6661
        MOV     EAX,Remainder
6662
        TEST    EAX,EAX
6663
        JZ      @ExitTrue
6664
        MOV     [EAX],EDX
6665
        JMP     @ExitTrue
6666

6667
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6668
/// Multilimb division                                                                                ///
6669
///   Divisor contains more than one limb: basecase division as described in Knuth's TAoCP.           ///
6670
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6671

6672
@MultiLimbDivisor:
6673

6674
        MOV     EAX,RSize               // GetMem(NormDivisor, (RSize + LSize + 1) * CLimbSize;
6675
        ADD     EAX,LSize
6676
        LEA     EAX,[EAX*CLimbSize + CLimbSize]
6677
        CALL    System.AllocMem
6678
        MOV     NormDivisor,EAX
6679
        MOV     EDX,RSize
6680
        LEA     EAX,[EAX + EDX*CLimbSize]
6681
        MOV     NormDividend,EAX
6682

6683
// First: normalize Divisor by shifting left to eliminate leading zeroes
6684
//        and shift Dividend left by same number of bits.
6685

6686
        // Get number of leading Divisor zeros (into ECX).
6687

6688
        MOV     ESI,LDivisor
6689
        MOV     EBX,[ESI+CLimbSize*EDI]
6690
        BSR     EBX,EBX
6691
        MOV     ECX,31
6692
        SUB     ECX,EBX
6693
        MOV     Shift,ECX
6694

6695
        // Shift Divisor to NormDivisor by CL.
6696

6697
        MOV     EBX,EDI
6698
        MOV     EDI,NormDivisor
6699
        MOV     EAX,[ESI + CLimbSize*EBX]
6700
        JMP     @ShiftDivisor
6701

6702
@ShiftDivisorLoop:
6703

6704
        MOV     EDX,[ESI + CLimbSize*EBX]
6705
        SHLD    EAX,EDX,CL
6706
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
6707
        MOV     EAX,EDX
6708

6709
@ShiftDivisor:
6710

6711
        DEC     EBX
6712
        JNS     @ShiftDivisorLoop
6713

6714
        // Handle lowest limb.
6715

6716
        SHL     EAX,CL
6717
        MOV     [EDI],EAX
6718

6719
        // Shift Dividend to NormDividend by CL.
6720

6721
        MOV     EBX,LSize
6722
        MOV     ESI,LDividend
6723
        MOV     EDI,NormDividend
6724
        XOR     EAX,EAX
6725
        JMP     @ShiftDividend
6726

6727
@ShiftDividendLoop:
6728

6729
        MOV     EDX,[ESI + CLimbSize*EBX]
6730
        SHLD    EAX,EDX,CL
6731
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
6732
        MOV     EAX,EDX
6733

6734
@ShiftDividend:
6735

6736
        DEC     EBX
6737
        JNS     @ShiftDividendLoop
6738

6739
        // Handle lowest limb.
6740

6741
        SHL     EAX,CL
6742
        MOV     [EDI],EAX
6743

6744
        MOV     EBX,LSize
6745
        MOV     ECX,RSize
6746

6747
        MOV     ESI,NormDividend
6748
        MOV     EDI,NormDivisor
6749
        LEA     EDI,[EDI + CLimbSize*ECX - CLimbSize]
6750

6751
@MainLoop:
6752

6753
        XOR     EDX,EDX
6754
        MOV     EAX,[ESI + CLimbSize*EBX]
6755
        DIV     EAX,[EDI]
6756
        MOV     QHat.Hi,EAX
6757
        MOV     EAX,[ESI + CLimbSize*EBX - CLimbSize]
6758
        DIV     EAX,[EDI]
6759
        MOV     QHat.Lo,EAX
6760
        MOV     RHat.Lo,EDX
6761
        XOR     EDX,EDX
6762
        MOV     RHat.Hi,EDX
6763

6764
@CheckAdjust:
6765

6766
        CMP     QHat.Hi,0
6767
        JNE     @DoAdjust
6768
        MOV     EAX,QHat.Lo
6769
        MUL     EAX,[EDI - CLimbSize]
6770

6771
        CMP     EDX,RHat.Lo
6772
        JA      @DoAdjust
6773
        JB      @AdjustEnd
6774
        CMP     EAX,[ESI + CLimbSize*EBX - 2*CLimbSize]
6775
        JBE     @AdjustEnd
6776

6777
@DoAdjust:
6778

6779
        SUB     QHat.Lo,1
6780
        SBB     QHat.Hi,0
6781
        MOV     EAX,[EDI]
6782
        ADD     RHat.Lo,EAX
6783
        ADC     RHat.Hi,0
6784
        JZ      @CheckAdjust
6785

6786
@AdjustEnd:
6787

6788
        // Now multiply NormDivisor by QHat and subtract the product from NormDividend[J].
6789

6790
        // Save a few registers.
6791

6792
        PUSH    EDI
6793
        PUSH    EBX
6794
        PUSH    ECX
6795

6796
        MOV     ECX,EBX
6797
        SUB     ECX,RSize
6798
        LEA     EDI,[ESI + CLimbSize*ECX]
6799
        MOV     EAX,LQuotient
6800
        MOV     EDX,QHat.Lo
6801
        MOV     [EAX + CLimbSize*ECX],EDX
6802
        XOR     EBX,EBX
6803
        MOV     Overflow,EBX
6804

6805
@SubtractProduct:
6806

6807
        MOV     EAX,NormDivisor
6808
        MOV     EAX,[EAX + CLimbSize*EBX]
6809
        MUL     EAX,QHat.Lo
6810
        MOV     Product.Lo,EAX
6811
        MOV     Product.Hi,EDX
6812
        XOR     EDX,EDX
6813
        MOV     EAX,[EDI + CLimbSize*EBX]
6814
        SUB     EAX,Overflow
6815
        SBB     EDX,0
6816
        SUB     EAX,Product.Lo
6817
        SBB     EDX,0
6818
        MOV     [EDI + CLimbSize*EBX],EAX
6819
        MOV     EAX,Product.Hi
6820
        SUB     EAX,EDX
6821
        MOV     Overflow,EAX
6822
        INC     EBX
6823
        CMP     EBX,RSize
6824
        JL      @SubtractProduct
6825

6826
@SubtractProductEnd:
6827

6828
        MOV     EBX,[ESP + 4]
6829
        MOV     EDX,[ESI + CLimbSize*EBX]
6830
        SUB     EDX,Overflow
6831
        MOV     [ESI + CLimbSize*EBX],EDX
6832
        JNC     @SkipAddBack
6833

6834
        // Add normalized divisor back, if necessary:
6835

6836
        MOV     EAX,LQuotient
6837
        DEC     [EAX + CLimbSize*ECX]
6838
        XOR     EBX,EBX
6839
        MOV     Overflow,EBX
6840

6841
@AddBackLoop:
6842

6843
        CMP     EBX,RSize
6844
        JE      @AddBackLoopEnd
6845

6846
        XOR     EDX,EDX
6847
        MOV     EAX,NormDivisor
6848
        MOV     EAX,[EAX + CLimbSize*EBX]
6849
        ADD     EAX,Overflow
6850

6851
        ADC     EDX,0   // Note: forgetting this caused errors that only exhibited when I started testing ModPow.
6852

6853
        ADD     [EDI + CLimbSize*EBX],EAX
6854
        ADC     EDX,0
6855
        MOV     Overflow,EDX
6856
        INC     EBX
6857
        JMP     @AddBackLoop
6858

6859
@AddBackLoopEnd:
6860

6861
        ADD     [EDI + CLimbSize*EBX],EDX
6862

6863
@SkipAddBack:
6864

6865
        POP     ECX
6866
        POP     EBX
6867
        POP     EDI
6868

6869
        // End of main loop; loop if required.
6870

6871
        DEC     EBX
6872
        CMP     EBX,ECX
6873
        JGE      @MainLoop
6874

6875
        // NormDividend now contains remainder, scaled by Shift.
6876
        // If Assigned(Remainder), then shift NormDividend down into Remainder.
6877

6878
        MOV     EAX,Remainder
6879
        TEST    EAX,EAX
6880
        JE      @ExitTrue
6881
        XOR     EBX,EBX
6882
        MOV     ESI,NormDividend
6883
        MOV     EDI,EAX
6884
        MOV     ECX,Shift
6885
        MOV     EAX,[ESI + CLimbSize*EBX]
6886

6887
@RemainderLoop:
6888

6889
        MOV     EDX,[ESI + CLimbSize*EBX + CLimbSize]
6890
        SHRD    EAX,EDX,CL
6891
        MOV     [EDI + CLimbSize*EBX],EAX
6892
        MOV     EAX,EDX
6893
        INC     EBX
6894
        CMP     EBX,RSize
6895
        JL      @RemainderLoop
6896
        SHR     EDX,CL
6897
        MOV     [EDI + CLimbSize*EBX],EDX
6898
        JMP     @ExitTrue
6899

6900
@ExitFalse:
6901

6902
        MOV     BL,0
6903
        JMP     @Exit
6904

6905
@ExitTrue:
6906

6907
        MOV     BL,1
6908

6909
@Exit:
6910

6911
        // Clear dynamic arrays.
6912

6913
        MOV     EAX,NormDivisor
6914
        CALL    System.@FreeMem
6915

6916
        MOV     EAX,EBX
6917

6918
        POP     EBX
6919
        POP     EDI
6920
        POP     ESI
6921
end;
6922
{$ELSE}
6923
var
6924
  LDividend, LDivisor, LQuotient, LRemainder: PLimb;
6925
  NormDividend, NormDivisor: PLimb;
6926
  QHat, RHat, Product: TUInt64;
6927
  Overflow: TLimb;
6928
  Shift: Integer;
6929
  SaveRDI, SaveRBX, SaveRCX: NativeUInt;
6930
asm
6931
        .PUSHNV RSI
6932
        .PUSHNV RDI
6933
        .PUSHNV RBX
6934

6935
        // To avoid reference count problems with Delphi's dynamic array types, we do our own,
6936
        // "old school" dynarrays, using GetMem and FreeMem.
6937

6938
        XOR     EBX,EBX                 // Set "dynarrays" to nil, so FreeMem calls won't fail.
6939
        MOV     NormDividend,RBX
6940
        MOV     NormDivisor,RBX
6941

6942
        MOV     LDividend,RCX
6943
        MOV     LDivisor,RDX
6944
        MOV     LQuotient,R8
6945
        MOV     LRemainder,R9
6946

6947
        MOV     ESI,LSize
6948
        MOV     EDI,RSize
6949
        CMP     ESI,EDI
6950
        JL      @ExitFalse
6951

6952
        DEC     EDI
6953
        JS      @ExitFalse
6954
        JNE     @MultiLimbDivisor
6955

6956
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6957
/// Simple division                                                                                   ///
6958
///   Divisor only contains one single limb: simple division and exit.                                ///
6959
///                                                                                                   ///
6960
///   NOTE: 32 bit division is easier and probably faster than 64 bit, even in 64 bit mode.           ///
6961
///         This was tested for Decimals.pas.                                                         ///
6962
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6963

6964
@SingleLimbDivisor:
6965

6966
        MOV     EBX,[RDX]
6967

6968
        DEC     ESI
6969
        MOV     RDI,RCX
6970
        XOR     EDX,EDX
6971

6972
@SingleDivLoop:
6973

6974
        MOV     EAX,[RDI + CLimbSize*RSI]
6975

6976
        // ------------------------------------------------------------------------------------------- //
6977
        // NOTE: In XE2, in 64 bit asm, "DIV <r/m32>" is generated as "DIV <r/m64>",                   //
6978
        //       but "DIV EAX,<r/m32>" is generated correctly.                                         //
6979
        //       The same applies to "MUL <r/m32>".                                                    //
6980
        // ------------------------------------------------------------------------------------------- //
6981

6982
        DIV     EAX,EBX
6983
        MOV     [R8 + CLimbSize*RSI],EAX
6984
        DEC     ESI
6985
        JNS     @SingleDivLoop
6986
        MOV     RAX,LRemainder
6987
        TEST    RAX,RAX
6988
        JZ      @ExitTrue
6989
        MOV     [RAX],EDX
6990
        JMP     @ExitTrue
6991

6992
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6993
/// MultiLimb division                                                                                ///
6994
///   Divisor contains more than one limb: basecase division as described in Knuth's TAoCP Vol. 2.    ///
6995
/////////////////////////////////////////////////////////////////////////////////////////////////////////
6996

6997
@MultiLimbDivisor:
6998

6999
        MOV     ECX,RSize
7000
        ADD     ECX,ECX
7001
        ADD     ECX,ECX
7002
        CALL    System.AllocMem
7003
        MOV     NormDivisor,RAX
7004

7005
        MOV     ECX,LSize
7006
        INC     ECX
7007
        ADD     ECX,ECX
7008
        ADD     ECX,ECX
7009
        CALL    System.AllocMem
7010
        MOV     NormDividend,RAX
7011

7012
// First: normalize Divisor by shifting left to eliminate leading zeroes
7013
//        and shift Dividend left by same nubmer of bits.
7014

7015
        // Get number of leading Divisor zeroes (into ECX).
7016

7017
        MOV     RSI,LDivisor
7018
        MOV     EBX,[RSI + CLimbSize*RDI]
7019
        BSR     EBX,EBX
7020
        MOV     ECX,31
7021
        SUB     ECX,EBX
7022
        MOV     Shift,ECX
7023

7024
        // Shift Divisor to NormDivisor by CL.
7025

7026
        MOV     EBX,EDI
7027
        MOV     RDI,NormDivisor
7028
        MOV     EAX,[RSI + CLimbSize*RBX]
7029
        JMP     @ShiftDivisor
7030

7031
@ShiftDivisorLoop:
7032

7033
        MOV     EDX,[RSI + CLimbSize*RBX]
7034
        SHLD    EAX,EDX,CL
7035
        MOV     [RDI + CLimbSize*RBX + CLimbSize],EAX
7036
        MOV     EAX,EDX
7037

7038
@ShiftDivisor:
7039

7040
        DEC     EBX
7041
        JNS     @ShiftDivisorLoop
7042

7043
        // Handle lowest limb.
7044

7045
        SHL     EAX,CL
7046
        MOV     [RDI],EAX
7047

7048
        // Shift Dividend to NormDividend by CL.
7049

7050
        MOV     EBX,LSize
7051
        MOV     RSI,LDividend
7052
        MOV     RDI,NormDividend
7053
        XOR     EAX,EAX
7054
        JMP     @ShiftDividend
7055

7056
@ShiftDividendLoop:
7057

7058
        MOV     EDX,[RSI + CLimbSize*RBX]
7059
        SHLD    EAX,EDX,CL
7060
        MOV     [RDI + CLimbSize*RBX + CLimbSize],EAX
7061
        MOV     EAX,EDX
7062

7063
@ShiftDividend:
7064

7065
        DEC     EBX
7066
        JNS     @ShiftDividendLoop
7067

7068
        // Handle lowest limb.
7069

7070
        SHL     EAX,CL
7071
        MOV     [RDI],EAX
7072

7073
        MOV     EBX,LSize
7074
        MOV     ECX,RSize
7075

7076
        MOV     RSI,NormDividend
7077
        MOV     RDI,NormDivisor
7078
        LEA     RDI,[RDI + CLimbSize*RCX - CLimbSize]
7079

7080
@MainLoop:
7081

7082
        XOR     EDX,EDX
7083
        MOV     EAX,[RSI + CLimbSize*RBX]
7084
        DIV     EAX,[RDI]
7085
        MOV     QHat.Hi,EAX
7086
        MOV     EAX,[RSI + CLimbSize*RBX - CLimbSize]
7087
        DIV     EAX,[RDI]
7088
        MOV     QHat.Lo,EAX
7089
        MOV     RHat.Lo,EDX
7090
        XOR     EDX,EDX
7091
        MOV     RHat.Hi,EDX
7092

7093
@CheckAdjust:
7094

7095
        CMP     QHat.Hi,0
7096
        JNE     @DoAdjust
7097
        MOV     EAX,QHat.Lo
7098
        MUL     EAX,[RDI - CLimbSize]
7099

7100
        CMP     EDX,RHat.Lo
7101
        JA      @DoAdjust
7102
        JB      @AdjustEnd
7103
        CMP     EAX,[RSI + CLimbSize*RBX - 2*CLimbSize]
7104
        JBE     @AdjustEnd
7105

7106
@DoAdjust:
7107

7108
        SUB     QHat.Lo,1
7109
        SBB     QHat.Hi,0
7110
        MOV     EAX,[RDI]
7111
        ADD     RHat.Lo,EAX
7112
        ADC     RHat.Hi,0
7113
        JZ      @CheckAdjust
7114

7115
@AdjustEnd:
7116

7117
        MOV     SaveRDI,RDI
7118
        MOV     SaveRBX,RBX
7119
        MOV     SaveRCX,RCX
7120

7121
        MOV     ECX,EBX
7122
        SUB     ECX,RSize
7123
        LEA     RDI,[RSI + CLimbSize*RCX]
7124
        MOV     RAX,LQuotient
7125
        MOV     EDX,QHat.Lo
7126
        MOV     [RAX + CLimbSize*RCX],EDX
7127
        XOR     EBX,EBX
7128
        MOV     Overflow,EBX
7129

7130
@SubtractProduct:
7131

7132
        MOV     RAX,NormDivisor
7133
        MOV     EAX,[RAX + CLimbSize*RBX]
7134
        MUL     EAX,QHat.Lo
7135
        MOV     Product.Lo,EAX
7136
        MOV     Product.Hi,EDX
7137
        XOR     EDX,EDX
7138
        MOV     EAX,[RDI + CLimbSize*RBX]
7139
        SUB     EAX,Overflow
7140
        SBB     EDX,0
7141
        SUB     EAX,Product.Lo
7142
        SBB     EDX,0
7143
        MOV     [RDI + CLimbSize*RBX],EAX
7144
        MOV     EAX,Product.Hi
7145
        SUB     EAX,EDX
7146
        MOV     Overflow,EAX
7147
        INC     EBX
7148
        CMP     EBX,RSize
7149
        JL      @SubtractProduct
7150

7151
@SubtractProductEnd:
7152

7153
        MOV     RBX,SaveRBX
7154
        MOV     EDX,[RSI + CLimbSize*RBX]
7155
        SUB     EDX,Overflow
7156
        MOV     [RSI + CLimbSize*RBX],EDX
7157
        JNC     @SkipAddBack
7158

7159
        // Add normalized divisor back, if necessary:
7160

7161
        MOV     RAX,LQuotient
7162
        DEC     DWORD PTR [RAX + ClimbSize*RCX]
7163
        XOR     EBX,EBX
7164
        MOV     Overflow,EBX
7165

7166
@AddBackLoop:
7167

7168
        CMP     EBX,RSize
7169
        JE      @AddBackLoopEnd
7170
        XOR     EDX,EDX
7171
        MOV     RAX,NormDivisor
7172
        MOV     EAX,[RAX + CLimbSize*RBX]
7173
        ADD     EAX,Overflow
7174
        ADC     EDX,0
7175
        ADD     [RDI + CLimbSize*RBX],EAX
7176
        ADC     EDX,0
7177
        MOV     Overflow,EDX
7178
        INC     EBX
7179
        JMP     @AddBackLoop
7180

7181
@AddBackLoopEnd:
7182

7183
        ADD     [RDI + CLimbSize*RBX],EDX
7184

7185
@SkipAddBack:
7186

7187
        MOV     RCX,SaveRCX
7188
        MOV     RBX,SaveRBX
7189
        MOV     RDI,SaveRDI
7190

7191
        // End of main loop; loop if required
7192

7193
        DEC     EBX
7194
        CMP     EBX,ECX
7195
        JGE     @MainLoop
7196

7197
        // NormDividend now contains remainder, scaled by Shift.
7198
        // If Assigned(Remainder), then shift NormDividend down into Remainder
7199

7200
        MOV     RAX,LRemainder
7201
        TEST    RAX,RAX
7202
        JE      @ExitTrue
7203
        XOR     EBX,EBX
7204
        MOV     RSI,NormDividend
7205
        MOV     RDI,RAX
7206
        MOV     ECX,Shift
7207
        MOV     EAX,[RSI + CLimbSize*RBX]
7208

7209
@RemainderLoop:
7210

7211
        MOV     EDX,[RSI + CLimbSize*RBX + CLimbSize]
7212
        SHRD    EAX,EDX,CL
7213
        MOV     [RDI + CLimbSize*RBX],EAX
7214
        MOV     EAX,EDX
7215
        INC     EBX
7216
        CMP     EBX,RSize
7217
        JL      @RemainderLoop
7218
        SHR     EDX,CL
7219
        MOV     [RDI + CLimbSize*RBX],EDX
7220
        JMP     @ExitTrue
7221

7222
@ExitFalse:
7223

7224
        MOV     BL,False
7225
        JMP     @Exit
7226

7227
@ExitTrue:
7228

7229
        MOV     BL,True
7230

7231
@Exit:
7232

7233
        // Clear dynamic arrays.
7234

7235
        MOV     RCX,NormDividend
7236
        CALL    System.@FreeMem
7237

7238
        MOV     RCX,NormDivisor
7239
        CALL    System.@FreeMem
7240

7241
        MOV     EAX,EBX
7242

7243
end;
7244
{$IFEND}
7245

7246
// Note: only handles Abs(Self) > 0.
7247
class procedure BigInteger.InternalIncrement(Limbs: PLimb; Size: Integer);
7248
{$IFDEF PUREPASCAL}
7249
var
7250
  N: TLimb;
7251
begin
7252
  N := MaxInt;
7253
  while Size > 0 do
7254
  begin
7255
    N := Limbs^;
7256
    Inc(N);
7257
    Limbs^ := N;
7258
    if N <> 0 then
7259
      Break;
7260
    Inc(Limbs);
7261
    Dec(Size);
7262
  end;
7263
  if N = 0 then
7264
  begin
7265
    Limbs^ := 1;
7266
  end;
7267
end;
7268
{$ELSE !PUREPASCAL}
7269
{$IFDEF WIN32}
7270
asm
7271

7272
        TEST    EDX,EDX
7273
        JE      @Exit
7274

7275
@Loop:
7276

7277
        MOV     ECX,[EAX]
7278
        INC     ECX
7279
        MOV     [EAX],ECX
7280
        TEST    ECX,ECX
7281
        JNE     @Exit
7282
        LEA     EAX,[EAX + CLimbSize]
7283
        DEC     EDX
7284
        JNE     @Loop
7285

7286
@Last:
7287

7288
        TEST    ECX,ECX
7289
        JNE     @Exit
7290
        MOV     TLimb PTR [EAX],1
7291

7292
@Exit:
7293

7294
end;
7295
{$ELSE !WIN32}
7296
asm
7297

7298
        TEST    EDX,EDX
7299
        JE      @Exit
7300

7301
@Loop:
7302

7303
        MOV     EAX,[RCX]
7304
        INC     EAX
7305
        MOV     [RCX],EAX
7306
        TEST    EAX,EAX
7307
        JNE     @Exit
7308
        LEA     RCX,[RCX + CLimbSize]
7309
        DEC     EDX
7310
        JNE     @Loop
7311

7312
@Last:
7313

7314
        TEST    EAX,EAX
7315
        JNE     @Exit
7316
        MOV     TLimb PTR [RCX],1
7317

7318
@Exit:
7319

7320
end;
7321
{$ENDIF !WIN32}
7322
{$ENDIF !PUREPASCAL}
7323

7324
// Note: only handles Abs(Self) > 1
7325
class procedure BigInteger.InternalDecrement(Limbs: PLimb; Size: Integer);
7326
{$IFDEF PUREPASCAL}
7327
begin
7328
  repeat
7329
    Dec(Limbs^);
7330
    if Limbs^ <> TLimb(-1) then
7331
      Break;
7332
    Inc(Limbs);
7333
    Dec(Size);
7334
  until Size = 0;
7335
end;
7336
{$ELSE !PUREPASCAL}
7337
{$IFDEF WIN32}
7338
asm
7339

7340
@Loop:
7341

7342
        MOV     ECX,[EAX]
7343
        DEC     ECX
7344
        MOV     [EAX],ECX
7345
        CMP     ECX,-1
7346
        JNE     @Exit
7347
        LEA     EAX,[EAX + CLimbSize]
7348
        DEC     EDX
7349
        JNE     @Loop
7350

7351
@Exit:
7352

7353
end;
7354
{$ELSE !WIN32}
7355
asm
7356

7357
@Loop:
7358

7359
        MOV     EAX,[RCX]
7360
        DEC     EAX
7361
        MOV     [RCX],EAX
7362
        CMP     EAX,-1
7363
        JNE     @Exit
7364
        LEA     RCX,[RCX + CLimbSize]
7365
        DEC     EDX
7366
        JNE     @Loop
7367

7368
@Exit:
7369

7370
end;
7371
{$ENDIF !WIN32}
7372
{$ENDIF !PUREPASCAL}
7373

7374
// Divides a magnitude (usually the FData of a TBigInteger) by Base and returns the remainder.
7375
class function BigInteger.InternalDivideByBase(Mag: PLimb; Base: Integer; var Size: Integer): UInt32;
7376
{$IF DEFINED(PUREPASCAL)}
7377

7378
// This routine uses DivMod(Cardinal, Word, Word, Word).
7379
// In Win32, that is 14 times faster than the previous version using the DivMod with UInt64 parameters.
7380
// In Win64, it is only a little bit slower.
7381

7382
type
7383
  UInt32Rec = record
7384
    Lo, Hi: UInt16;
7385
  end;
7386
  PUInt16 = ^UInt16;
7387

7388
var
7389
  P, PMag: PUInt16;
7390
  Remainder: UInt16;
7391
  CurrentWord: UInt32;
7392
begin
7393
  Result := 0;
7394
  if Size = 0 then
7395
    Exit;
7396
  PMag := PUInt16(Mag);
7397
  P := PMag + Size * 2;
7398
  Remainder := 0;
7399
  while P > PMag do
7400
  begin
7401
    Dec(P);
7402
    UInt32Rec(CurrentWord).Lo := P^;
7403
    UInt32Rec(CurrentWord).Hi := Remainder;
7404
    System.Math.DivMod(CurrentWord, Base, P^, Remainder);
7405
  end;
7406
  Result := Remainder;
7407
  if Mag[Size - 1] = 0 then
7408
    Dec(Size);
7409
end;
7410
{$ELSEIF DEFINED(WIN32)}
7411
asm
7412
        PUSH    ESI
7413
        PUSH    EDI
7414
        PUSH    EBX
7415
        MOV     EBX,ECX                         // var Size
7416
        MOV     ECX,EDX
7417
        MOV     ESI,EAX                         // PBase (= Mag)
7418
        MOV     EDX,[EBX]
7419
        XOR     EAX,EAX                         // Result
7420
        TEST    EDX,EDX
7421
        JE      @Exit
7422
        LEA     EDI,[ESI + CLimbSize*EDX]       // P
7423
        XOR     EDX,EDX                         // Remainder := 0;
7424
        CMP     EDI,ESI                         // while P > PBase do
7425
        JBE     @CheckSize
7426
@Loop:
7427
        SUB     EDI,4                           // Dec(P);
7428
        MOV     EAX,[EDI]                       // DivMod(P^ or (Remainder shl 32), 10, P^, Remainder);
7429
        DIV     EAX,ECX
7430
        MOV     [EDI],EAX
7431
        CMP     EDI,ESI                         // while P > PBase do
7432
        JA      @Loop
7433
@CheckSize:
7434
        MOV     EAX,EDX                         // if (PBase + Size - 1)^ = 0 then
7435
        MOV     EDX,[EBX]
7436
        LEA     ESI,[ESI + CLimbSize*EDX - CLimbSize]
7437
        CMP     [ESI],0
7438
        JNE     @Exit
7439
        DEC     DWORD PTR [EBX]                 //   Dec(Size);
7440
@Exit:
7441
        POP     EBX
7442
        POP     EDI
7443
        POP     ESI
7444
end;
7445
{$ELSE}
7446
asm
7447
        .NOFRAME
7448

7449
        MOV     R11,R8                          // var Size
7450
        MOV     R9,RCX                          // PBase := Mag;
7451
        MOV     ECX,EDX
7452
        XOR     EAX,EAX                         // Result := 0;
7453
        MOV     EDX,[R11]                       // if Size = 0 then Exit;
7454
        OR      EDX,EDX
7455
        JE      @Exit
7456
        LEA     R10,[R9 + CLimbSize*RDX]        // P
7457
        XOR     EDX,EDX                         // Remainder := 0;
7458
        CMP     R10,R9                          // while P > PBase do
7459
        JBE     @CheckSize
7460
@Loop:
7461
        SUB     R10,4                           // Dec(P)
7462
        MOV     EAX,[R10]                       // DivMod(P^ or (Remainder shl 32), 10, P^, Remainder);
7463
        DIV     EAX,ECX
7464
        MOV     [R10],EAX
7465
        CMP     R10,R9                          // while P > PBase do
7466
        JA      @Loop
7467
@CheckSize:
7468
        MOV     EAX,EDX
7469
        MOV     EDX,[R11]
7470
        CMP     [R9 + CLimbSize*RDX - CLimbSize],0   // if (PBase + Size - 1)^ = 0 then
7471
        JNE     @Exit
7472
        DEC     DWORD PTR [R11]                 //   Dec(Size);
7473
@Exit:
7474
end;
7475
{$IFEND}
7476

7477
class operator BigInteger.Equal(const Left, Right: BigInteger): Boolean;
7478
begin
7479
  Result := Compare(Left, Right) = 0;
7480
end;
7481

7482
class procedure BigInteger.Error(ErrorCode: TErrorCode; const ErrorInfo: array of const);
7483
begin
7484
  case ErrorCode of
7485
    ecParse:
7486
      raise EConvertError.CreateFmt(SErrorParsingFmt, ErrorInfo);
7487
    ecDivbyZero:
7488
      raise EZeroDivide.Create(SDivisionByZero);
7489
    ecConversion:
7490
      raise EConvertError.CreateFmt(SConversionFailedFmt, ErrorInfo);
7491
    ecOverflow:
7492
      raise EOverflow.Create(SOverflow);
7493
    ecInvalidArgFloat:
7494
      raise EInvalidArgument.CreateFmt(SInvalidArgumentFloatFmt, ErrorInfo);
7495
    ecInvalidBase:
7496
      raise EInvalidArgument.Create(SInvalidArgumentBase);
7497
    ecInvalidArg:
7498
      raise EInvalidArgument.CreateFmt(SInvalidArgumentFmt, ErrorInfo);
7499
    ecNoInverse:
7500
      raise EInvalidArgument.Create(SNoInverse);
7501
    ecNegativeExponent:
7502
      raise EInvalidArgument.CreateFmt(SNegativeExponent, ErrorInfo);
7503
    ecNegativeRadicand:
7504
      raise EInvalidArgument.CreateFmt(SNegativeRadicand, ErrorInfo);
7505
  else
7506
    raise EInvalidOp.Create(SInvalidOperation);
7507
  end;
7508
end;
7509

7510
class operator BigInteger.Explicit(const Value: BigInteger): Int32;
7511
begin
7512
  if Value.FData = nil then
7513
    Result := 0
7514
  else
7515
  begin
7516
    Result := Int32(Value.FData[0]);
7517
    if Value.FSize < 0 then
7518
      Result := -Result;
7519
  end;
7520
end;
7521

7522
class operator BigInteger.Explicit(const Value: BigInteger): UInt32;
7523
begin
7524
  if Value.FData = nil then
7525
    Result := 0
7526
  else
7527
    Result := Value.FData[0];
7528
  if Value.FSize < 0 then
7529
    Result := UInt32(-Int32(Result));
7530
end;
7531

7532
class operator BigInteger.Explicit(const Value: BigInteger): Int64;
7533
begin
7534
  if Value.FData = nil then
7535
    Result := 0
7536
  else
7537
  begin
7538
    TUInt64(Result).Lo := Value.FData[0];
7539
    if (Value.FSize and SizeMask) > 1 then
7540
      TUInt64(Result).Hi := Value.FData[1]
7541
    else
7542
      TUInt64(Result).Hi := 0;
7543
    if Value.FSize < 0 then
7544
      Result := -Result;
7545
  end;
7546
end;
7547

7548
class operator BigInteger.Explicit(const Value: BigInteger): UInt64;
7549
begin
7550
  if Value.FData = nil then
7551
    Result := 0
7552
  else
7553
  begin
7554
    TUInt64(Result).Lo := Value.FData[0];
7555
    if (Value.FSize and SizeMask) > 1 then
7556
      TUInt64(Result).Hi := Value.FData[1]
7557
    else
7558
      TUInt64(Result).Hi := 0;
7559
  end;
7560
  if Value.FSize < 0 then
7561
    Result := UInt64(-Int64(Result));
7562
end;
7563

7564
function BigInteger.AsCardinal: Cardinal;
7565
begin
7566
  Result := 0;
7567
  if not IsNegative and (BitLength <= CCardinalBits) then
7568
    Result := Cardinal(Self)
7569
  else
7570
    Error(ecConversion, ['BigInteger', 'Cardinal']);
7571
end;
7572

7573
function GetBitAt(FData: PLimb; BitNum: Integer): Boolean;
7574
begin
7575
  Result := (FData[BitNum div 32] and (1 shl (BitNum and 31))) <> 0
7576
end;
7577

7578
class procedure BigInteger.ConvertToFloatComponents(const Value: BigInteger; SignificandSize: Integer;
7579
  var Sign: Integer; var Significand: UInt64; var Exponent: Integer);
7580
var
7581
  LRemainder, LLowBit, LSignificand: BigInteger;
7582
  LBitLen: Integer;
7583
begin
7584
  if Value.IsNegative then
7585
    Sign := -1
7586
  else
7587
    Sign := 1;
7588

7589
  Exponent := 0;
7590
  LSignificand := BigInteger.Abs(Value);
7591

7592
  LBitLen := LSignificand.BitLength;
7593
  if LBitLen > SignificandSize then
7594
  begin
7595
    // --- Shift down and adjust exponent.
7596

7597
    // Get lowest bit.
7598
    LLowBit := BigInteger.One shl (LBitLen - SignificandSize);
7599

7600
    // Mask out bits being shifted out and save them for later.
7601
    LRemainder := (LSignificand and (LLowBit - BigInteger.One)) shl 1;
7602

7603
    // Shift significand until it fits in SignificandSize (in bits).
7604
    LSignificand := LSignificand shr (LBitLen - SignificandSize);
7605
    Inc(Exponent, LBitLen - 1);
7606

7607
    // --- Round
7608
    if (LRemainder > LLowBit) or ((LRemainder = LLowBit) and not LSignificand.IsEven) then
7609
    begin
7610
      LSignificand := LSignificand + BigInteger.One;
7611
      if LSignificand.BitLength > SignificandSize then
7612
      begin
7613
        LSignificand := LSignificand shr 1;
7614
        Inc(Exponent);
7615
      end;
7616
    end;
7617
  end
7618
  else
7619
  begin
7620
    LSignificand := LSignificand shl (SignificandSize - LBitLen);
7621
    Inc(Exponent, LBitLen - 1);
7622
  end;
7623
  Significand := LSignificand.AsUInt64;
7624
end;
7625

7626
const
7627
  // Number of bits in full significand (including hidden bit, if any)
7628
  // of IEEE-754 floating point types.
7629
  KSingleSignificandBits          = 24;
7630
  KDoubleSignificandBits          = 53;
7631
  KExtendedSignificandBits        = 64;
7632

7633
  // Maximum possible exponents for IEEE-754 floating point types.
7634
  KSingleMaxExponent              = 127;
7635
  KDoubleMaxExponent              = 1023;
7636
  KExtendedMaxExponent            = 16383;
7637

7638
function BigInteger.AsSingle: Single;
7639
var
7640
  LSign, LExponent: Integer;
7641
  LMantissa: UInt64;
7642
begin
7643
  if Self.IsZero then
7644
    Exit(0.0);
7645

7646
  ConvertToFloatComponents(Self, KSingleSignificandBits, LSign, LMantissa, LExponent);
7647

7648
  // Handle overflow.
7649
  if LExponent > KSingleMaxExponent then
7650
    if LSign < 0 then
7651
      Result := NegInfinity
7652
    else
7653
      Result := Infinity
7654
    // No need to check for denormals.
7655
  else
7656
    Result := Velthuis.FloatUtils.MakeSingle(LSign, LMantissa, LExponent);
7657
end;
7658

7659
function BigInteger.AsDouble: Double;
7660
var
7661
  LSign, LExponent: Integer;
7662
  LMantissa: UInt64;
7663
begin
7664
  if Self.IsZero then
7665
    Exit(0.0);
7666

7667
  ConvertToFloatComponents(Self, KDoubleSignificandBits, LSign, LMantissa, LExponent);
7668

7669
  // Handle overflow.
7670
  if LExponent > KDoubleMaxExponent then
7671
    if LSign < 0 then
7672
      Result := NegInfinity
7673
    else
7674
      Result := Infinity
7675
    // No need to check for denormals.
7676
  else
7677
    Result := Velthuis.FloatUtils.MakeDouble(LSign, LMantissa, LExponent);
7678
end;
7679

7680
{$IFDEF HasExtended}
7681
function BigInteger.AsExtended: Extended;
7682
var
7683
  LSign, LExponent: Integer;
7684
  LMantissa: UInt64;
7685
begin
7686
  if Self.IsZero then
7687
    Exit(0.0);
7688

7689
  ConvertToFloatComponents(Self, KExtendedSignificandBits, LSign, LMantissa, LExponent);
7690

7691
  // Handle overflow.
7692
  if LExponent > KExtendedMaxExponent then
7693
    if LSign < 0 then
7694
      Result := NegInfinity
7695
    else
7696
      Result := Infinity
7697
    // No need to check for denormals.
7698
  else
7699
    Result := Velthuis.FloatUtils.MakeExtended(LSign, LMantissa, LExponent);
7700
end;
7701
{$ENDIF}
7702

7703
function BigInteger.AsInt64: Int64;
7704
begin
7705
  Result := 0;
7706
  if BitLength <= CInt64Bits then
7707
    Result := Int64(Self)
7708
  else
7709
    Error(ecConversion, ['BigInteger', 'Int64']);
7710
end;
7711

7712
function BigInteger.AsInteger: Integer;
7713
begin
7714
  Result := 0;
7715
  if BitLength <= CIntegerBits then
7716
    Result := Integer(Self)
7717
  else
7718
    Error(ecConversion, ['BigInteger', 'Integer']);
7719
end;
7720

7721
function BigInteger.AsUInt64: UInt64;
7722
begin
7723
  Result := 0;
7724
  if not IsNegative and (BitLength <= CUInt64Bits) then
7725
    Result := UInt64(Self)
7726
  else
7727
    Error(ecConversion, ['BigInteger', 'UInt64']);
7728
end;
7729

7730
class function BigInteger.InternalCompare(Left, Right: PLimb; LSize, RSize: Integer): Integer;
7731
{$IFDEF PUREPASCAL}
7732
var
7733
  L, R: PLimb;
7734
begin
7735
  if (LSize or RSize) = 0 then
7736
    Exit(0);
7737
  if LSize > RSize then
7738
    Result := 1
7739
  else if LSize < RSize then
7740
    Result := -1
7741
  else
7742

7743
  // Same size, so compare limbs. Start at the "top" (most significant limb).
7744
  begin
7745
    L := Left + LSize - 1;
7746
    R := Right + LSize - 1;
7747
    while L >= Left do
7748
    begin
7749
      if L^ <> R^ then
7750
      begin
7751
        if L^ > R^ then
7752
          Exit(1)
7753
        else if L^ < R^ then
7754
          Exit(-1);
7755
      end;
7756
      Dec(L);
7757
      Dec(R);
7758
    end;
7759
    Exit(0);
7760
  end;
7761
end;
7762
{$ELSE !PUREPASCAL}
7763
{$IFDEF WIN32}
7764
asm
7765
        PUSH    ESI
7766

7767
        TEST    EAX,EAX
7768
        JNE     @LeftNotNil
7769
        TEST    EDX,EDX
7770
        JZ      @ExitZero
7771
        JMP     @ExitNeg
7772

7773
@LeftNotNil:
7774

7775
        TEST    EDX,EDX
7776
        JZ      @ExitPos
7777

7778
        CMP     ECX,RSize
7779
        JA      @ExitPos
7780
        JB      @ExitNeg
7781

7782
        MOV     ESI,EAX
7783

7784
@Loop:
7785

7786
        MOV     EAX,[ESI + ECX*CLimbSize - CLimbSize]
7787
        CMP     EAX,[EDX + ECX*CLimbSize - CLimbSize]
7788
        JA      @ExitPos
7789
        JB      @ExitNeg
7790
        DEC     ECX
7791
        JNE     @Loop
7792

7793
@ExitZero:
7794

7795
        XOR     EAX,EAX
7796
        JMP     @Exit
7797

7798
@ExitPos:
7799

7800
        MOV     EAX,1
7801
        JMP     @Exit
7802

7803
@ExitNeg:
7804

7805
        MOV     EAX,-1
7806

7807
@Exit:
7808

7809
        POP     ESI
7810
end;
7811
{$ELSE WIN64}
7812
asm
7813
        TEST    RCX,RCX
7814
        JNZ     @LeftNotNil
7815

7816
        // Left is nil
7817
        TEST    RDX,RDX
7818
        JZ      @ExitZero                       // if Right nil too, then equal
7819
        JMP     @ExitNeg                        // Otherwise, Left < Right
7820

7821
@LeftNotNil:
7822

7823
        TEST    RDX,RDX
7824
        JZ      @ExitPos
7825

7826
        CMP     R8D,R9D
7827
        JA      @ExitPos
7828
        JB      @ExitNeg
7829

7830
        // R8D and R9D are same.
7831

7832
        LEA     RCX,[RCX + R8*CLimbSize]
7833
        LEA     RDX,[RDX + R8*CLimbSize]
7834

7835
        TEST    R8D,1
7836
        JZ      @NotOdd
7837

7838
        LEA     RCX,[RCX - CLimbSize]
7839
        LEA     RDX,[RDX - CLimbSize]
7840
        MOV     EAX,[RCX]
7841
        CMP     EAX,[RDX]
7842
        JA      @ExitPos
7843
        JB      @ExitNeg
7844
        DEC     R8D
7845

7846
@NotOdd:
7847

7848
        SHR     R8D,1
7849
        JZ      @ExitZero
7850

7851
@Loop:
7852

7853
        LEA     RCX,[RCX - DLimbSize]
7854
        LEA     RDX,[RDX - DLimbSize]
7855
        MOV     RAX,[RCX]
7856
        CMP     RAX,[RDX]
7857
        JA      @ExitPos
7858
        JB      @ExitNeg
7859
        DEC     R8D
7860
        JNE     @Loop
7861

7862
@ExitZero:
7863

7864
        XOR     EAX,EAX
7865
        JMP     @Exit
7866

7867
@ExitPos:
7868

7869
        MOV     EAX,1
7870
        JMP     @Exit
7871

7872
@ExitNeg:
7873

7874
        MOV     EAX,-1
7875

7876
@Exit:
7877

7878
end;
7879
{$ENDIF WIN64}
7880
{$ENDIF !PUREPASCAL}
7881

7882
{$IFNDEF PUREPASCAL}
7883
class procedure BigInteger.InternalSubtractModified(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
7884
{$IFDEF WIN32}
7885
asm
7886
        PUSH    ESI
7887
        PUSH    EDI
7888
        PUSH    EBX
7889

7890
        MOV     ESI,EAX                         // Left
7891
        MOV     EDI,EDX                         // Right
7892
        MOV     EBX,ECX                         // Result
7893

7894
        MOV     ECX,SSize
7895
        MOV     EDX,LSize
7896

7897
        SUB     EDX,ECX
7898
        PUSH    EDX
7899
        XOR     EDX,EDX
7900

7901
        XOR     EAX,EAX
7902

7903
        MOV     EDX,ECX
7904
        AND     EDX,CUnrollMask
7905
        SHR     ECX,CUnrollShift
7906

7907
        CLC
7908
        JE      @MainTail
7909

7910
@MainLoop:
7911

7912
        MOV     EAX,[ESI]
7913
        SBB     EAX,[EDI]
7914
        MOV     [EBX],EAX
7915

7916
        MOV     EAX,[ESI + CLimbSize]
7917
        SBB     EAX,[EDI + CLimbSize]
7918
        MOV     [EBX + CLimbSize],EAX
7919

7920
        MOV     EAX,[ESI + 2*CLimbSize]
7921
        SBB     EAX,[EDI + 2*CLimbSize]
7922
        MOV     [EBX + 2*CLimbSize],EAX
7923

7924
        MOV     EAX,[ESI + 3*CLimbSize]
7925
        SBB     EAX,[EDI + 3*CLimbSize]
7926
        MOV     [EBX + 3*CLimbSize],EAX
7927

7928
        LEA     ESI,[ESI + 4*CLimbSize]
7929
        LEA     EDI,[EDI + 4*CLimbSize]
7930
        LEA     EBX,[EBX + 4*CLimbSize]
7931

7932
        LEA     ECX,[ECX - 1]
7933
        JECXZ   @MainTail
7934
        JMP     @Mainloop
7935

7936
@MainTail:
7937

7938
        LEA     ESI,[ESI + EDX*CLimbSize]
7939
        LEA     EDI,[EDI + EDX*CLimbSize]
7940
        LEA     EBX,[EBX + EDX*CLimbSize]
7941

7942
        LEA     ECX,[@JumpsMain]
7943
        JMP     [ECX + EDX*TYPE Pointer]
7944

7945
        .ALIGN  16
7946

7947
@JumpsMain:
7948

7949
        DD      @DoRestLoop
7950
        DD      @Main1
7951
        DD      @Main2
7952
        DD      @Main3
7953

7954
@Main3:
7955

7956
        MOV     EAX,[ESI - 3*CLimbSize]
7957
        SBB     EAX,[EDI - 3*CLimbSize]
7958
        MOV     [EBX - 3*CLimbSize],EAX
7959

7960
@Main2:
7961

7962
        MOV     EAX,[ESI - 2*CLimbSize]
7963
        SBB     EAX,[EDI - 2*CLimbSize]
7964
        MOV     [EBX - 2*CLimbSize],EAX
7965

7966
@Main1:
7967

7968
        MOV     EAX,[ESI - CLimbSize]
7969
        SBB     EAX,[EDI - CLimbSize]
7970
        MOV     [EBX - CLimbSize],EAX
7971

7972
@DoRestLoop:
7973

7974
        SETC    AL                      // Save Carry Flag
7975

7976
        XOR     EDI,EDI
7977

7978
        POP     ECX
7979
        MOV     EDX,ECX
7980
        AND     EDX,CUnrollMask
7981
        SHR     ECX,CUnrollShift
7982

7983
        ADD     AL,255                  // Restore Carry Flag.
7984

7985
        JECXZ   @RestLast3
7986

7987
@RestLoop:
7988

7989
        MOV     EAX,[ESI]
7990
        SBB     EAX,EDI
7991
        MOV     [EBX],EAX
7992

7993
        MOV     EAX,[ESI + CLimbSize]
7994
        SBB     EAX,EDI
7995
        MOV     [EBX + CLimbSize],EAX
7996

7997
        MOV     EAX,[ESI + 2*CLimbSize]
7998
        SBB     EAX,EDI
7999
        MOV     [EBX + 2*CLimbSize],EAX
8000

8001
        MOV     EAX,[ESI + 3*CLimbSize]
8002
        SBB     EAX,EDI
8003
        MOV     [EBX + 3*CLimbSize],EAX
8004

8005
        LEA     ESI,[ESI + 4*CLimbSize]
8006
        LEA     EBX,[EBX + 4*CLimbSize]
8007

8008
        LEA     ECX,[ECX - 1]
8009
        JECXZ   @RestLast3
8010
        JMP     @RestLoop
8011

8012
@RestLast3:
8013

8014
        LEA     ESI,[ESI + EDX*CLimbSize]
8015
        LEA     EBX,[EBX + EDX*CLimbSize]
8016

8017
        LEA     ECX,[@RestJumps]
8018
        JMP     [ECX + EDX*TYPE Pointer]
8019

8020
        .ALIGN  16
8021

8022
@RestJumps:
8023

8024
        DD      @Exit
8025
        DD      @Rest1
8026
        DD      @Rest2
8027
        DD      @Rest3
8028

8029
@Rest3:
8030

8031
        MOV     EAX,[ESI - 3*CLimbSize]
8032
        SBB     EAX,EDI
8033
        MOV     [EBX - 3*CLimbSize],EAX
8034

8035
@Rest2:
8036

8037
        MOV     EAX,[ESI - 2*CLimbSize]
8038
        SBB     EAX,EDI
8039
        MOV     [EBX - 2*CLimbSize],EAX
8040

8041
@Rest1:
8042

8043
        MOV     EAX,[ESI - CLimbSize]
8044
        SBB     EAX,EDI
8045
        MOV     [EBX - CLimbSize],EAX
8046

8047
@Exit:
8048

8049
        POP     EBX
8050
        POP     EDI
8051
        POP     ESI
8052
end;
8053
{$ELSE WIN32/WIN64}
8054
asm
8055
        MOV     R10,RCX
8056
        MOV     ECX,SSize
8057

8058
        // R10 = Left, RDX = Right, R8 = Result, R9D = LSize, ECX = SSize
8059

8060
        CMP     R9D,ECX
8061
        JAE     @SkipSwap
8062
        XCHG    ECX,R9D
8063
        XCHG    R10,RDX
8064

8065
@SkipSwap:
8066

8067
        SUB     R9D,ECX
8068
        PUSH    R9
8069

8070
        MOV     R9D,ECX
8071
        AND     R9D,CUnrollMask
8072
        SHR     ECX,CUnrollShift
8073

8074
        CLC
8075
        JE      @MainTail
8076

8077
@MainLoop:
8078

8079
        MOV     RAX,[R10]
8080
        SBB     RAX,[RDX]
8081
        MOV     [R8],RAX
8082

8083
        MOV     RAX,[R10 + DLimbSize]
8084
        SBB     RAX,[RDX + DLimbSize]
8085
        MOV     [R8 + DLimbSize],RAX
8086

8087
        LEA     R10,[R10 + 2*DLimbSize]
8088
        LEA     RDX,[RDX + 2*DLimbSize]
8089
        LEA     R8,[R8 + 2*DLimbSize]
8090

8091
        LEA     RCX,[RCX - 1]
8092
        JRCXZ   @MainTail
8093
        JMP     @MainLoop
8094

8095
@MainTail:
8096

8097
// Here, code does not add index*CLimbSize and then use negative offsets, because that would take away
8098
// the advantage of using 64 bit registers.
8099
// Each block is separate, no fall through.
8100

8101
        LEA     RCX,[@MainJumps]
8102
        JMP     [RCX + R9*TYPE Pointer]
8103

8104
        // Align jump table. Update if necessary!
8105

8106
        DB      $90,$90,$90,$90,$90
8107

8108
@MainJumps:
8109

8110
        DQ      @DoRestLoop
8111
        DQ      @Main1
8112
        DQ      @Main2
8113
        DQ      @Main3
8114

8115
@Main3:
8116

8117
        MOV     RAX,[R10]
8118
        SBB     RAX,[RDX]
8119
        MOV     [R8],RAX
8120

8121
        MOV     EAX,[R10 + 2*CLimbSize]
8122
        SBB     EAX,[RDX + 2*CLimbSize]
8123
        MOV     [R8 + 2*CLimbSize],EAX
8124

8125
        LEA     R10,[R10 + 3*CLimbSize]
8126
        LEA     RDX,[RDX + 3*CLimbSize]
8127
        LEA     R8,[R8 + 3*CLimbSize]
8128

8129
        JMP     @DoRestLoop
8130

8131
@Main2:
8132

8133
        MOV     RAX,[R10]
8134
        SBB     RAX,[RDX]
8135
        MOV     [R8],RAX
8136

8137
        LEA     R10,[R10 + 2*CLimbSize]
8138
        LEA     RDX,[RDX + 2*CLimbSize]
8139
        LEA     R8,[R8 + 2*CLimbSize]
8140

8141
        JMP     @DoRestLoop
8142

8143
@Main1:
8144

8145
        MOV     EAX,[R10]
8146
        SBB     EAX,[RDX]
8147
        MOV     [R8],EAX
8148

8149
        LEA     R10,[R10 + CLimbSize]
8150
        LEA     RDX,[RDX + CLimbSize]
8151
        LEA     R8,[R8 + CLimbSize]
8152

8153
@DoRestLoop:
8154

8155
        SETC    AL                      // Save Carry Flag
8156

8157
        XOR     EDX,EDX
8158

8159
        POP     RCX
8160
        MOV     R9D,ECX
8161
        AND     R9D,CUnrollMask
8162
        SHR     ECX,CUnrollShift
8163

8164
        ADD     AL,255                  // Restore Carry Flag.
8165

8166
        JECXZ   @RestLast3
8167

8168
@RestLoop:
8169

8170
        MOV     RAX,[R10]
8171
        SBB     RAX,RDX
8172
        MOV     [R8],RAX
8173

8174
        MOV     RAX,[R10 + DLimbSize]
8175
        SBB     RAX,RDX
8176
        MOV     [R8 + DLimbSize],RAX
8177

8178
        LEA     R10,[R10 + 2*DLimbSize]
8179
        LEA     R8,[R8 + 2*DLimbSize]
8180

8181
        LEA     RCX,[RCX - 1]
8182
        JRCXZ   @RestLast3
8183
        JMP     @RestLoop
8184

8185
@RestLast3:
8186

8187
        LEA     RCX,[@RestJumps]
8188
        JMP     [RCX + R9*TYPE Pointer]
8189

8190
        // If necessary, align second jump table with NOPs
8191

8192
        DB      $90,$90,$90,$90,$90,$90,$90
8193

8194
@RestJumps:
8195

8196
        DQ      @Exit
8197
        DQ      @Rest1
8198
        DQ      @Rest2
8199
        DQ      @Rest3
8200

8201
@Rest3:
8202

8203
        MOV     RAX,[R10]
8204
        SBB     RAX,RDX
8205
        MOV     [R8],RAX
8206

8207
        MOV     EAX,[R10 + DLimbSize]
8208
        SBB     EAX,EDX
8209
        MOV     [R8 + DLimbSize],EAX
8210

8211
        JMP     @Exit
8212

8213
@Rest2:
8214

8215
        MOV     RAX,[R10]
8216
        SBB     RAX,RDX
8217
        MOV     [R8],RAX
8218

8219
        JMP     @Exit
8220

8221
@Rest1:
8222

8223
        MOV     EAX,[R10]
8224
        SBB     EAX,EDX
8225
        MOV     [R8],EAX
8226

8227
@Exit:
8228

8229
end;
8230
{$ENDIF}
8231

8232
class procedure BigInteger.InternalSubtractPlain(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
8233
{$IFDEF WIN32}
8234
asm
8235
        PUSH    ESI
8236
        PUSH    EDI
8237
        PUSH    EBX
8238

8239
        MOV     ESI,EAX                         // Left
8240
        MOV     EDI,EDX                         // Right
8241
        MOV     EBX,ECX                         // Result
8242

8243
        MOV     ECX,SSize
8244
        MOV     EDX,LSize
8245

8246
        SUB     EDX,ECX
8247
        PUSH    EDX
8248
        XOR     EDX,EDX
8249

8250
        XOR     EAX,EAX
8251

8252
        MOV     EDX,ECX
8253
        AND     EDX,CUnrollMask
8254
        SHR     ECX,CUnrollShift
8255

8256
        CLC
8257
        JE      @MainTail
8258

8259
@MainLoop:
8260

8261
        // Unrolled 4 times. More times will not improve speed anymore.
8262

8263
        MOV     EAX,[ESI]
8264
        SBB     EAX,[EDI]
8265
        MOV     [EBX],EAX
8266

8267
        MOV     EAX,[ESI + CLimbSize]
8268
        SBB     EAX,[EDI + CLimbSize]
8269
        MOV     [EBX + CLimbSize],EAX
8270

8271
        MOV     EAX,[ESI + 2*CLimbSize]
8272
        SBB     EAX,[EDI + 2*CLimbSize]
8273
        MOV     [EBX + 2*CLimbSize],EAX
8274

8275
        MOV     EAX,[ESI + 3*CLimbSize]
8276
        SBB     EAX,[EDI + 3*CLimbSize]
8277
        MOV     [EBX + 3*CLimbSize],EAX
8278

8279
        // Update pointers.
8280

8281
        LEA     ESI,[ESI + 4*CLimbSize]
8282
        LEA     EDI,[EDI + 4*CLimbSize]
8283
        LEA     EBX,[EBX + 4*CLimbSize]
8284

8285
        // Update counter and loop if required.
8286

8287
        DEC     ECX                             // Note: if INC/DEC must be emulated:
8288
        JNE     @MainLoop                       //         LEA ECX,[ECX - 1]; JECXZ @MainTail; JMP @MainLoop
8289

8290
@MainTail:
8291

8292
        // Add index*CLimbSize so @MainX branches can fall through.
8293

8294
        LEA     ESI,[ESI + EDX*CLimbSize]
8295
        LEA     EDI,[EDI + EDX*CLimbSize]
8296
        LEA     EBX,[EBX + EDX*CLimbSize]
8297

8298
        // Indexed jump.
8299

8300
        LEA     ECX,[@JumpsMain]
8301
        JMP     [ECX + EDX*TYPE Pointer]
8302

8303
        .ALIGN  16
8304

8305

8306
@JumpsMain:
8307

8308
        DD      @DoRestLoop
8309
        DD      @Main1
8310
        DD      @Main2
8311
        DD      @Main3
8312

8313
@Main3:
8314

8315
        MOV     EAX,[ESI - 3*CLimbSize]         // negative offset, because index*CLimbSize was already added.
8316
        SBB     EAX,[EDI - 3*CLimbSize]
8317
        MOV     [EBX - 3*CLimbSize],EAX
8318

8319
@Main2:
8320

8321
        MOV     EAX,[ESI - 2*CLimbSize]
8322
        SBB     EAX,[EDI - 2*CLimbSize]
8323
        MOV     [EBX - 2*CLimbSize],EAX
8324

8325
@Main1:
8326

8327
        MOV     EAX,[ESI - CLimbSize]
8328
        SBB     EAX,[EDI - CLimbSize]
8329
        MOV     [EBX - CLimbSize],EAX
8330

8331
@DoRestLoop:
8332

8333
        SETC    AL                      // Save Carry Flag
8334

8335
        XOR     EDI,EDI
8336

8337
        POP     ECX
8338
        MOV     EDX,ECX
8339
        AND     EDX,CUnrollMask
8340
        SHR     ECX,CUnrollShift
8341

8342
        ADD     AL,255                  // Restore Carry Flag.
8343

8344
        INC     ECX
8345
        DEC     ECX
8346
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
8347

8348
@RestLoop:
8349

8350
        MOV     EAX,[ESI]
8351
        SBB     EAX,EDI
8352
        MOV     [EBX],EAX
8353

8354
        MOV     EAX,[ESI + CLimbSize]
8355
        SBB     EAX,EDI
8356
        MOV     [EBX + CLimbSize],EAX
8357

8358
        MOV     EAX,[ESI + 2*CLimbSize]
8359
        SBB     EAX,EDI
8360
        MOV     [EBX + 2*CLimbSize],EAX
8361

8362
        MOV     EAX,[ESI + 3*CLimbSize]
8363
        SBB     EAX,EDI
8364
        MOV     [EBX + 3*CLimbSize],EAX
8365

8366
        LEA     ESI,[ESI + 4*CLimbSize] // LEA does not affect the flags, so carry will not be changed.
8367
        LEA     EBX,[EBX + 4*CLimbSize]
8368

8369
        DEC     ECX                     // DEC does not affect carry flag, but causes partial-flags stall
8370
        JNE     @RestLoop               //   (e.g. when using SBB) on older CPUs.
8371

8372
@RestLast3:
8373

8374
        LEA     ESI,[ESI + EDX*CLimbSize]
8375
        LEA     EBX,[EBX + EDX*CLimbSize]
8376

8377
        LEA     ECX,[@RestJumps]
8378
        JMP     [ECX + EDX*TYPE Pointer]
8379

8380
        .ALIGN  16
8381

8382
@RestJumps:
8383

8384
        DD      @Exit
8385
        DD      @Rest1
8386
        DD      @Rest2
8387
        DD      @Rest3
8388

8389
@Rest3:
8390

8391
        MOV     EAX,[ESI - 3*CLimbSize]
8392
        SBB     EAX,EDI
8393
        MOV     [EBX - 3*CLimbSize],EAX
8394

8395
@Rest2:
8396

8397
        MOV     EAX,[ESI - 2*CLimbSize]
8398
        SBB     EAX,EDI
8399
        MOV     [EBX - 2*CLimbSize],EAX
8400

8401
@Rest1:
8402

8403
        MOV     EAX,[ESI - CLimbSize]
8404
        SBB     EAX,EDI
8405
        MOV     [EBX - CLimbSize],EAX
8406

8407
@Exit:
8408

8409
        POP     EBX
8410
        POP     EDI
8411
        POP     ESI
8412
end;
8413
{$ELSE WIN32/WIN64}
8414
asm
8415
        MOV     R10,RCX         // in emulating code, ECX must be used as loop counter! So do not exchange
8416
        MOV     ECX,SSize       //   RCX and R10 in the editor.
8417

8418
        // R10 = Left, RDX = Right, R8 = Result, R9D = LSize, ECX = SSize
8419

8420
        CMP     R9D,ECX
8421
        JAE     @SkipSwap
8422
        XCHG    ECX,R9D
8423
        XCHG    R10,RDX
8424

8425
@SkipSwap:
8426

8427
        SUB     R9D,ECX
8428
        PUSH    R9
8429

8430
        MOV     R9D,ECX
8431
        AND     R9D,CUnrollMask
8432
        SHR     ECX,CUnrollShift
8433

8434
        CLC
8435
        JE      @MainTail               // ECX = 0, so fewer than 3 limbs to be processed in main
8436

8437
@MainLoop:
8438

8439
        MOV     RAX,[R10]               // Add two limbs at once, taking advantage of 64 bit registers.
8440
        SBB     RAX,[RDX]
8441
        MOV     [R8],RAX
8442

8443
        MOV     RAX,[R10 + DLimbSize]   // And next two limbs too.
8444
        SBB     RAX,[RDX + DLimbSize]
8445
        MOV     [R8 + DLimbSize],RAX
8446

8447
        LEA     R10,[R10 + 2*DLimbSize]
8448
        LEA     RDX,[RDX + 2*DLimbSize]
8449
        LEA     R8,[R8 + 2*DLimbSize]
8450

8451
        DEC     ECX                     // if INC/DEC must be emulated:
8452
                                        //   LEA ECX,[ECX - 1]; JECXZ @MainTail; JMP @MainLoop
8453
        JNE     @MainLoop
8454

8455
@MainTail:
8456

8457
// Here, code does not add index*CLimbSize and then use negative offsets, because that would take away the
8458
// advantage of using 64 bit registers.
8459
// Each block is separate, no fall through.
8460

8461
        LEA     RCX,[@MainJumps]
8462
        JMP     [RCX + R9*TYPE Pointer]
8463

8464
        .ALIGN  16
8465

8466
@MainJumps:
8467

8468
        DQ      @DoRestLoop
8469
        DQ      @Main1
8470
        DQ      @Main2
8471
        DQ      @Main3
8472

8473
@Main3:
8474

8475
        MOV     RAX,[R10]
8476
        SBB     RAX,[RDX]
8477
        MOV     [R8],RAX
8478

8479
        MOV     EAX,[R10 + DLimbSize]
8480
        SBB     EAX,[RDX + DLimbSize]
8481
        MOV     [R8 + 2*CLimbSize],EAX
8482

8483
        LEA     R10,[R10 + 3*CLimbSize]
8484
        LEA     RDX,[RDX + 3*CLimbSize]
8485
        LEA     R8,[R8 + 3*CLimbSize]
8486

8487
        JMP     @DoRestLoop
8488

8489
@Main2:
8490

8491
        MOV     RAX,[R10]
8492
        SBB     RAX,[RDX]
8493
        MOV     [R8],RAX
8494

8495
        LEA     R10,[R10 + DLimbSize]
8496
        LEA     RDX,[RDX + DLimbSize]
8497
        LEA     R8,[R8 + DLimbSize]
8498

8499
        JMP     @DoRestLoop
8500

8501
@Main1:
8502

8503
        MOV     EAX,[R10]
8504
        SBB     EAX,[RDX]
8505
        MOV     [R8],EAX
8506

8507
        LEA     R10,[R10 + CLimbSize]
8508
        LEA     RDX,[RDX + CLimbSize]
8509
        LEA     R8,[R8 + CLimbSize]
8510

8511
@DoRestLoop:
8512

8513
        SETC    AL                      // Save Carry Flag
8514

8515
        XOR     EDX,EDX
8516

8517
        POP     RCX
8518
        MOV     R9D,ECX
8519
        AND     R9D,CUnrollMask
8520
        SHR     ECX,CUnrollShift
8521

8522
        ADD     AL,255                  // Restore Carry Flag.
8523

8524
        INC     ECX
8525
        DEC     ECX
8526
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
8527

8528
@RestLoop:
8529

8530
        MOV     RAX,[R10]               // Do two limbs at once.
8531
        SBB     RAX,RDX
8532
        MOV     [R8],RAX
8533

8534
        MOV     RAX,[R10 + DLimbSize] // And the next two limbs.
8535
        SBB     RAX,RDX
8536
        MOV     [R8 + DLimbSize],RAX
8537

8538
        LEA     R10,[R10 + 2*DLimbSize]
8539
        LEA     R8,[R8 + 2*DLimbSize]
8540

8541
        DEC     ECX
8542
        JNE     @RestLoop
8543

8544
@RestLast3:
8545

8546
        LEA     RCX,[@RestJumps]
8547
        JMP     [RCX + R9*TYPE Pointer]
8548

8549
        // If necessary, align second jump table with NOPs
8550

8551
@RestJumps:
8552

8553
        DQ      @Exit
8554
        DQ      @Rest1
8555
        DQ      @Rest2
8556
        DQ      @Rest3
8557

8558
@Rest3:
8559

8560
        MOV     RAX,[R10]
8561
        SBB     RAX,RDX
8562
        MOV     [R8],RAX
8563

8564
        MOV     EAX,[R10 + 2*CLimbSize]
8565
        SBB     EAX,EDX
8566
        MOV     [R8 + 2*CLimbSize],EAX
8567

8568
        LEA     R8,[R8 + 3*CLimbSize]
8569

8570
        JMP     @Exit
8571

8572
@Rest2:
8573

8574
        MOV     RAX,[R10]
8575
        SBB     RAX,RDX
8576
        MOV     [R8],RAX
8577

8578
        LEA     R8,[R8 + 2*CLimbSize]
8579

8580
        JMP     @Exit
8581

8582
@Rest1:
8583

8584
        MOV     EAX,[R10]
8585
        SBB     EAX,EDX
8586
        MOV     [R8],EAX
8587

8588
        LEA     R8,[R8 + CLimbSize]
8589

8590
@Exit:
8591

8592
end;
8593
{$ENDIF !WIN32}
8594
{$ENDIF !PUREPASCAL}
8595

8596
{$IFDEF PUREPASCAL}
8597
class procedure BigInteger.InternalSubtractPurePascal(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
8598
{$IFDEF CPU64BITS}
8599
var
8600
  LDiff: NativeInt;
8601
  LTail, LCount: Integer;
8602
begin
8603
  Dec(LSize, SSize);
8604

8605
  LTail := SSize and CUnrollMask;
8606
  LCount := SSize shr CUnrollShift;
8607
  LDiff := 0;
8608

8609
  while LCount > 0 do
8610
  begin
8611
    LDiff := Int64(Larger[0]) - Smaller[0] + Int32(LDiff shr 32);
8612
    Result[0] := TLimb(LDiff);
8613

8614
    LDiff := Int64(Larger[1]) - Smaller[1] + Int32(LDiff shr 32);
8615
    Result[1] := TLimb(LDiff);
8616

8617
    LDiff := Int64(Larger[2]) - Smaller[2] + Int32(LDiff shr 32);
8618
    Result[2] := TLimb(LDiff);
8619

8620
    LDiff := Int64(Larger[3]) - Smaller[3] + Int32(LDiff shr 32);
8621
    Result[3] := TLimb(LDiff);
8622

8623
    Inc(Larger, CUnrollIncrement);
8624
    Inc(Smaller, CUnrollIncrement);
8625
    Inc(Result, CUnrollIncrement);
8626
    Dec(LCount);
8627
  end;
8628

8629
  while LTail > 0 do
8630
  begin
8631
    LDiff := Int64(Larger[0]) - Smaller[0] + Int32(LDiff shr 32);
8632
    Result[0] := TLimb(LDiff);
8633

8634
    Inc(Larger);
8635
    Inc(Smaller);
8636
    Inc(Result);
8637
    Dec(LTail);
8638
  end;
8639

8640
  LTail := LSize and CUnrollMask;
8641
  LCount := LSize shr CUnrollShift;
8642

8643
  while LCount > 0 do
8644
  begin
8645
    LDiff := Int64(Larger[0]) + Int32(LDiff shr 32);
8646
    Result[0] := TLimb(LDiff);
8647

8648
    LDiff := Int64(Larger[1]) + Int32(LDiff shr 32);
8649
    Result[1] := TLimb(LDiff);
8650

8651
    LDiff := Int64(Larger[2]) + Int32(LDiff shr 32);
8652
    Result[2] := TLimb(LDiff);
8653

8654
    LDiff := Int64(Larger[3]) + Int32(LDiff shr 32);
8655
    Result[3] := TLimb(LDiff);
8656

8657
    Inc(Larger, CUnrollIncrement);
8658
    Inc(Result, CUnrollIncrement);
8659
    Dec(LCount);
8660
  end;
8661

8662
  while LTail > 0 do
8663
  begin
8664
    LDiff := Int64(Larger[0]) + Int32(LDiff shr 32);
8665
    Result[0] := TLimb(LDiff);
8666

8667
    Inc(Larger);
8668
    Inc(Result);
8669
    Dec(LTail);
8670
  end;
8671
end;
8672
{$ELSE}
8673
var
8674
  LDiff: NativeInt;
8675
  LCount, LTail: Integer;
8676
begin
8677
  Dec(LSize, SSize);
8678
  LDiff := 0;
8679

8680
  LTail := SSize and CUnrollMask;
8681
  LCount := SSize shr CUnrollShift;
8682

8683
  while LCount > 0 do
8684
  begin
8685
    LDiff := Int32(PUInt16(Larger)[0]) - PUInt16(Smaller)[0] + Int16(LDiff shr 16);
8686
    PUInt16(Result)[0] := UInt16(LDiff);
8687

8688
    LDiff := Int32(PUInt16(Larger)[1]) - PUInt16(Smaller)[1] + Int16(LDiff shr 16);
8689
    PUInt16(Result)[1] := UInt16(LDiff);
8690

8691
    LDiff := Int32(PUInt16(Larger)[2]) - PUInt16(Smaller)[2] + Int16(LDiff shr 16);
8692
    PUInt16(Result)[2] := UInt16(LDiff);
8693

8694
    LDiff := Int32(PUInt16(Larger)[3]) - PUInt16(Smaller)[3] + Int16(LDiff shr 16);
8695
    PUInt16(Result)[3] := UInt16(LDiff);
8696

8697
    LDiff := Int32(PUInt16(Larger)[4]) - PUInt16(Smaller)[4] + Int16(LDiff shr 16);
8698
    PUInt16(Result)[4] := UInt16(LDiff);
8699

8700
    LDiff := Int32(PUInt16(Larger)[5]) - PUInt16(Smaller)[5] + Int16(LDiff shr 16);
8701
    PUInt16(Result)[5] := UInt16(LDiff);
8702

8703
    LDiff := Int32(PUInt16(Larger)[6]) - PUInt16(Smaller)[6] + Int16(LDiff shr 16);
8704
    PUInt16(Result)[6] := UInt16(LDiff);
8705

8706
    LDiff := Int32(PUInt16(Larger)[7]) - PUInt16(Smaller)[7] + Int16(LDiff shr 16);
8707
    PUInt16(Result)[7] := UInt16(LDiff);
8708

8709
    Inc(Larger, CUnrollIncrement);
8710
    Inc(Smaller, CUnrollIncrement);
8711
    Inc(Result, CUnrollIncrement);
8712
    Dec(LCount);
8713
  end;
8714

8715
  while LTail > 0 do
8716
  begin
8717
    LDiff := Int32(PUInt16(Larger)[0]) - PUInt16(Smaller)[0] + Int16(LDiff shr 16);
8718
    PUInt16(Result)[0] := UInt16(LDiff);
8719

8720
    LDiff := Int32(PUInt16(Larger)[1]) - PUInt16(Smaller)[1] + Int16(LDiff shr 16);
8721
    PUInt16(Result)[1] := UInt16(LDiff);
8722

8723
    Inc(Larger);
8724
    Inc(Smaller);
8725
    Inc(Result);
8726
    Dec(LTail);
8727
  end;
8728

8729
  LTail := LSize and CUnrollMask;
8730
  LCount := LSize shr CUnrollShift;
8731

8732
  while LCount > 0 do
8733
  begin
8734
    LDiff := Int32(PUInt16(Larger)[0]) + Int16(LDiff shr 16);
8735
    PUInt16(Result)[0] := UInt16(LDiff);
8736

8737
    LDiff := Int32(PUInt16(Larger)[1]) + Int16(LDiff shr 16);
8738
    PUInt16(Result)[1] := UInt16(LDiff);
8739

8740
    LDiff := Int32(PUInt16(Larger)[2]) + Int16(LDiff shr 16);
8741
    PUInt16(Result)[2] := UInt16(LDiff);
8742

8743
    LDiff := Int32(PUInt16(Larger)[3]) + Int16(LDiff shr 16);
8744
    PUInt16(Result)[3] := UInt16(LDiff);
8745

8746
    LDiff := Int32(PUInt16(Larger)[4]) + Int16(LDiff shr 16);
8747
    PUInt16(Result)[4] := UInt16(LDiff);
8748

8749
    LDiff := Int32(PUInt16(Larger)[5]) + Int16(LDiff shr 16);
8750
    PUInt16(Result)[5] := UInt16(LDiff);
8751

8752
    LDiff := Int32(PUInt16(Larger)[6]) + Int16(LDiff shr 16);
8753
    PUInt16(Result)[6] := UInt16(LDiff);
8754

8755
    LDiff := Int32(PUInt16(Larger)[7]) + Int16(LDiff shr 16);
8756
    PUInt16(Result)[7] := UInt16(LDiff);
8757

8758
    Inc(Larger, CUnrollIncrement);
8759
    Inc(Result, CUnrollIncrement);
8760
    Dec(LCount);
8761
  end;
8762

8763
  while LTail > 0 do
8764
  begin
8765
    LDiff := Int32(PUInt16(Larger)[0]) + Int16(LDiff shr 16);
8766
    PUInt16(Result)[0] := UInt16(LDiff);
8767

8768
    LDiff := Int32(PUInt16(Larger)[1]) + Int16(LDiff shr 16);
8769
    PUInt16(Result)[1] := UInt16(LDiff);
8770

8771
    Inc(Larger);
8772
    Inc(Result);
8773
    Dec(LTail);
8774
  end;
8775
end;
8776
{$ENDIF}
8777
{$ENDIF}
8778

8779
function BigInteger.IsZero: Boolean;
8780
begin
8781
  Result := FData = nil;
8782
end;
8783

8784
class procedure BigInteger.ShiftLeft(const Value: BigInteger; Shift: Integer; var Result: BigInteger);
8785
var
8786
  LimbShift: Integer;
8787
  LSign: Integer;
8788
begin
8789
  if Value.FData = nil then
8790
  begin
8791
    Result := Zero;
8792
    Exit;
8793
  end;
8794
  LSign := SignBitOf(Value.FSize);
8795
  LimbShift := Shift div CLimbBits;
8796
  Shift := Shift mod CLimbBits;
8797
  if Shift > 0 then
8798
  begin
8799
    Result.MakeSize((Value.FSize and SizeMask) + LimbShift + 1);
8800
    InternalShiftLeft(PLimb(Value.FData), PLimb(Result.FData) + LimbShift, Shift, (Value.FSize and SizeMask));
8801
  end
8802
  else
8803
  begin
8804
    Result.MakeSize((Value.FSize and SizeMask) + LimbShift);
8805
    CopyLimbs(PLimb(Value.FData), PLimb(Result.FData) + LimbShift, (Value.FSize and SizeMask));
8806
  end;
8807
  Result.FSize := (Result.FSize and SizeMask) or Integer(LSign);
8808
  Result.Compact;
8809
end;
8810

8811
class function BigInteger.ShiftLeft(const Value: BigInteger; Shift: Integer): BigInteger;
8812
begin
8813
  ShiftLeft(Value, Shift, Result);
8814
end;
8815

8816
class operator BigInteger.LeftShift(const Value: BigInteger; Shift: Integer): BigInteger;
8817
begin
8818
  ShiftLeft(Value, Shift, Result);
8819
end;
8820

8821
class operator BigInteger.LessThan(const Left, Right: BigInteger): Boolean;
8822
begin
8823
  Result := Compare(Left, Right) < 0;
8824
end;
8825

8826
class operator BigInteger.LessThanOrEqual(const Left, Right: BigInteger): Boolean;
8827
begin
8828
  Result := Compare(left, Right) <= 0;
8829
end;
8830

8831
function BigInteger.Ln: Double;
8832
begin
8833
  Result := Ln(Self);
8834
end;
8835

8836
function BigInteger.BitLength: Integer;
8837
begin
8838
  if Self.FData = nil then
8839
    Result := 0
8840
  else
8841
  begin
8842
    Result := CLimbBits * (Size - 1) + Velthuis.Numerics.BitLength(FData[Size - 1]);
8843

8844
    // IsPowerOfTwo is expensive, but probably less expensive than a copy and
8845
    // subsequent decrement, like in BitCount.
8846
    if (FSize < 0) and Self.IsPowerOfTwo then
8847
      Dec(Result);
8848
  end;
8849
end;
8850

8851
function BigInteger.BitCount: Integer;
8852
var
8853
  Mag: TMagnitude;
8854
  I: Integer;
8855
begin
8856
  if FData = nil then
8857
    Exit(0);
8858

8859
  if FSize > 0 then
8860
    Mag := FData
8861
  else
8862
  begin
8863
    Mag := Copy(FData);
8864
    InternalDecrement(PLimb(Mag), FSize and SizeMask);
8865
  end;
8866

8867
  Result := 0;
8868
  for I := 0 to Size - 1 do
8869
    Result := Result + Velthuis.Numerics.BitCount(Mag[I]);
8870
end;
8871

8872
// http://stackoverflow.com/a/7982137/95954
8873
// Or: ln(a) = ln(a / 2^k) + k * ln(2)
8874
class function BigInteger.Ln(const Value: BigInteger): Double;
8875
var
8876
  ExtraBits: Integer;
8877
  NewInt: BigInteger;
8878
begin
8879
  if Value.IsNegative then
8880
    Exit(System.Math.NaN)
8881
  else if Value.IsZero then
8882
    Exit(System.Math.NegInfinity);
8883
  ExtraBits := Value.BitLength - 1022;
8884
  if ExtraBits > 0 then
8885
    NewInt := Value shr ExtraBits
8886
  else
8887
    NewInt := Value;
8888
  Result := System.Ln(NewInt.AsDouble);
8889
  if ExtraBits > 0 then
8890
    Result := Result + ExtraBits * FLog2;
8891
end;
8892

8893
class function BigInteger.Log(const Value: BigInteger; Base: Double): Double;
8894
begin
8895
  Result := BigInteger.Ln(Value) / System.Ln(Base);
8896
end;
8897

8898
class function BigInteger.Log10(const Value: BigInteger): Double;
8899
begin
8900
  Result := Log(Value, 10.0);
8901
end;
8902

8903
class function BigInteger.Log2(const Value: BigInteger): Double;
8904
begin
8905
  Result := Log(Value, 2.0);
8906
end;
8907

8908
function BigInteger.Log(Base: Double): Double;
8909
begin
8910
  Result := Log(Self, Base);
8911
end;
8912

8913
function BigInteger.Log10: Double;
8914
begin
8915
  Result := Log(Self, 10.0);
8916
end;
8917

8918
function BigInteger.Log2: Double;
8919
begin
8920
  Result := Log(Self, 2.0);
8921
end;
8922

8923
// https://stackoverflow.com/a/7982137/95954
8924
class function BigInteger.Exp(const b: Double): BigInteger;
8925
var
8926
  bc, b2, c: Double;
8927
  t: Integer;
8928
begin
8929
  if IsNan(b) or IsInfinite(b) then
8930
    Error(ecInvalidArgFloat, ['Double']);
8931
  bc := 680.0;
8932
  if b < bc then
8933
    Exit(BigInteger(System.Exp(b)));
8934
  // I think this can be simplified:
8935
  c := b - bc;
8936
  t := System.Math.Ceil(c / FLog2);
8937
  c := t * FLog2;
8938
  b2 := b - c;
8939
  Result := BigInteger(System.Exp(b2)) shl t;
8940
end;
8941

8942
class operator BigInteger.LogicalNot(const Value: BigInteger): BigInteger;
8943
begin
8944
  Result := Value;
8945
  Inc(Result);
8946
  if Result.FSize <> 0 then
8947
    Result.FSize := Result.FSize xor SignMask;
8948
  Result.Compact;
8949
end;
8950

8951
function BigInteger.LowestSetBit: Integer;
8952
var
8953
  I: Integer;
8954
begin
8955
  if FData = nil then
8956
    Exit(-1);
8957
  I := 0;
8958
  Result := 0;
8959
  while FData[I] = 0 do
8960
  begin
8961
    Inc(Result, CLimbBits);
8962
    Inc(I);
8963
  end;
8964
  Inc(Result, NumberOfTrailingZeros(FData[I]));
8965
end;
8966

8967
class function BigInteger.Max(const Left, Right: BigInteger): BigInteger;
8968
begin
8969
  if Left > Right then
8970
    ShallowCopy(Left, Result)
8971
  else
8972
    ShallowCopy(Right, Result);
8973
end;
8974

8975
class function BigInteger.Min(const Left, Right: BigInteger): BigInteger;
8976
begin
8977
  if Left < Right then
8978
    ShallowCopy(Left, Result)
8979
  else
8980
    ShallowCopy(Right, Result);
8981
end;
8982

8983
// https://www.di-mgt.com.au/euclidean.html#code-modinv
8984
class function BigInteger.ModInverse(const Value, Modulus: BigInteger): BigInteger;
8985
var
8986
  u1, u3, v1, v3, temp1, temp3, q: BigInteger;
8987
  iter: Integer;
8988
begin
8989
  // Step X1. Initialise
8990
  u1 := One;
8991
  u3 := Abs(Value);
8992
  v1 := Zero;
8993
  v3 := Abs(Modulus);
8994
  // X mod 1 is nonsense (always 0), but it might still be passed.
8995
  if (Compare(v3, One) = 0) or Modulus.IsZero then
8996
    Error(ecNoInverse, []);
8997
  // Remember odd/even iterations
8998
  iter := 0;
8999
  // Step X2. Loop while v3 <> 0
9000
  while not v3.IsZero do
9001
  begin
9002
    // Step X3. Divide and Subtract
9003
    DivMod(u3, v3, q, temp3);
9004
    temp1 := Add(u1, BigInteger.Multiply(q, v1));
9005
    // Swap
9006
    u1 := v1;
9007
    v1 := temp1;
9008
    u3 := v3;
9009
    v3 := temp3;
9010
    Inc(iter);
9011
  end;
9012
  // Ensure u3, i.e. gcd(Value, Modulus) = 1
9013
  if u3 <> One then
9014
    Error(ecNoInverse, []);
9015
  if Odd(iter) then
9016
    Result := Subtract(Abs(Modulus), u1)
9017
  else
9018
    Result := u1;
9019
  if Value < 0 then
9020
    Result := -Result;
9021
end;
9022

9023
// http://stackoverflow.com/questions/8496182/calculating-powa-b-mod-n
9024
class function BigInteger.ModPow(const ABase, AExponent, AModulus: BigInteger): BigInteger;
9025
var
9026
  Base: BigInteger;
9027
  Exp: BigInteger;
9028
begin
9029
  if not AModulus.IsPositive  then
9030
    Error(ecDivByZero, []);
9031
  if AModulus.IsOne then
9032
    Exit(BigInteger.Zero);
9033
  Result := BigInteger.One;
9034
  Exp := AExponent;
9035
  Base := ABase mod AModulus;
9036
  while Exp > Zero do
9037
  begin
9038
    if not Exp.IsEven then
9039
      Result := (Result * Base) mod AModulus;
9040
    Exp := Exp shr 1;
9041
    Base := Sqr(Base) mod AModulus;
9042
  end;
9043
end;
9044

9045
class operator BigInteger.Modulus(const Left, Right: BigInteger): BigInteger;
9046
begin
9047
  Result := Remainder(Left, Right);
9048
end;
9049

9050
class operator BigInteger.Modulus(const Left: BigInteger; Right: UInt32): BigInteger;
9051
begin
9052
  Result := Remainder(Left, Right);
9053
end;
9054

9055
class operator BigInteger.Modulus(const Left: BigInteger; Right: UInt16): BigInteger;
9056
begin
9057
  Result := Remainder(Left, Right);
9058
end;
9059

9060
// Note: this can only be used to multiply by a base and add a digit, i.e. ADigit must be < ABase!
9061
class procedure BigInteger.InternalMultiplyAndAdd16(Value: PLimb; ABase, ADigit: Word; var Size: Integer);
9062
{$IFDEF PUREPASCAL}
9063
type
9064
  TUInt32 = packed record
9065
    Lo, Hi: UInt16;
9066
  end;
9067
var
9068
  I: Integer;
9069
  LProduct: UInt32;
9070
  LSize: Integer;
9071
begin
9072
  LSize := Size shl 1;
9073
  I := 0;
9074
  LProduct := 0;
9075
  while I < LSize do
9076
  begin
9077
    LProduct := UInt32(PUInt16(Value)[I]) * ABase + TUInt32(LProduct).Hi;
9078
    PUInt16(Value)[I] := TUInt32(LProduct).Lo;
9079
    Inc(I);
9080
  end;
9081
  if TUInt32(LProduct).Hi <> 0 then
9082
  begin
9083
    PUInt16(Value)[I] := TUInt32(LProduct).Hi;
9084
    Inc(Size);
9085
  end;
9086
  if ADigit > 0 then
9087
  begin
9088
    Inc(Value[0], ADigit);
9089
    if Size = 0 then
9090
      Size := 1;
9091
  end;
9092
end;
9093
{$ELSEIF DEFINED(Win32)}
9094
var
9095
  LValue: PLimb;
9096
  LDigit: UInt16;
9097
asm
9098
        PUSH    ESI
9099
        PUSH    EDI
9100
        PUSH    EBX
9101

9102
        MOV     ESI,EAX
9103
        MOV     LValue,EAX
9104
        MOVZX   EDI,DX
9105
        MOV     LDigit,CX
9106
        MOV     ECX,Size
9107
        MOV     ECX,[ECX]
9108
        JECXZ   @DoAdd
9109
        XOR     EBX,EBX
9110

9111
@MultLoop:
9112

9113
        MOV     EAX,[ESI]
9114
        MUL     EAX,EDI
9115
        ADD     EAX,EBX
9116
        ADC     EDX,0
9117
        MOV     [ESI],EAX
9118
        MOV     EBX,EDX
9119
        LEA     ESI,[ESI + CLimbSize]
9120
        LEA     ECX,[ECX - 1]
9121
        JECXZ   @CheckLastLimb
9122
        JMP     @MultLoop
9123

9124
@CheckLastLimb:
9125

9126
        OR      EBX,EBX
9127
        JE      @DoAdd
9128
        MOV     [ESI],EBX               // Carry not zero, so increment size and store carry
9129
        MOV     ECX,Size
9130
        INC     DWORD PTR [ECX]
9131

9132
@DoAdd:
9133

9134
        MOVZX   EAX,LDigit
9135
        OR      EAX,EAX
9136
        JZ      @Exit                   // Skip if ADigit is 0 anyway.
9137
        MOV     ECX,Size
9138
        CMP     DWORD PTR [ECX],0       // If Size = 0 and ADigit <> 0, must add 1 to size
9139
        JNZ     @SkipInc
9140
        INC     DWORD PTR [ECX]
9141

9142
@SkipInc:
9143

9144
        MOV     ESI,LValue
9145
        ADD     [ESI],EAX               // Note that allocated size is always > 1.
9146

9147
@Exit:
9148

9149
        POP     EBX
9150
        POP     EDI
9151
        POP     ESI
9152
end;
9153
{$ELSE WIN64}
9154
asm
9155
        .PUSHNV RSI
9156

9157
        PUSH    RCX                     // Save Value
9158
        MOV     RSI,RCX                 // RSI = Value
9159
        MOV     R10D,EDX                // R10D = ABase
9160
        XOR     R11D,R11D               // Multiplication "carry"
9161
        MOV     RCX,R9                  // Size
9162
        MOV     ECX,[RCX]               // Size^
9163
        JECXZ   @DoAdd
9164

9165
@MultLoop:
9166

9167
        MOV     EAX,[RSI]
9168
        MUL     EAX,R10D
9169
        ADD     EAX,R11D
9170
        ADC     EDX,0
9171
        MOV     [RSI],EAX
9172
        MOV     R11D,EDX
9173
        LEA     RSI,[RSI + CLimbSize]
9174
        LEA     ECX,[ECX - 1]
9175
        JECXZ   @CheckLastLimb
9176
        JMP     @MultLoop
9177

9178
@CheckLastLimb:
9179

9180
        OR      EDX,EDX
9181
        JE      @DoAdd
9182
        MOV     [RSI],EDX
9183
        INC     DWORD PTR [R9]
9184

9185
@DoAdd:
9186

9187
        POP     RCX                     // Restore Value
9188
        OR      R8D,R8D                 // If ADigit is 0 then we are finished
9189
        JZ      @Exit
9190
        CMP     [R9],0                  // If Size = 0, and ADigit isn't, then increment size
9191
        JNE     @SkipInc
9192
        INC     DWORD PTR [R9]
9193

9194
@SkipInc:
9195

9196
        ADD     [RCX],R8D               // Add ADigit
9197

9198
@Exit:
9199

9200
end;
9201
{$IFEND}
9202

9203

9204
{ TODO: It dawned to me that if you multiply by Base, and then add a number that is < Base, there can *never* be a
9205
        carry. Even $FFFFFFFF x 36, the lowest limb will be $FFFFFFFF - 35 ($FFFFFFDC), so adding 35 ($23) can not
9206
        cause a carry. Tried that with other multiplicators too.
9207

9208
        This can be applied to MultiplyAndAdd32 too.
9209

9210
        So just call it InternalMultiplyBaseAndAdd. Addend must be < Base, and there will never be a carry.
9211
        This means it is possible to pre-allocate and pass the size. This routine must update size if it sets the top
9212
        limb. So there can be a Size and it must be a var parameter. Just add the addend to the lowest limb. No need
9213
        to carry.
9214
}
9215
class procedure BigInteger.InternalMultiply16(const Left: TMagnitude; var Result: TMagnitude; LSize: Integer; Right: Word);
9216
{$IF DEFINED(PUREPASCAL)}
9217
type
9218
  TUInt32 = packed record
9219
    Lo, Hi: UInt16;
9220
  end;
9221
var
9222
  I: Integer;
9223
  LProduct: UInt32;
9224
  LHi16: UInt16;
9225
begin
9226
  LSize := LSize * 2;
9227
  LHi16 := 0;
9228
  I := 0;
9229
  while I < LSize do
9230
  begin
9231
    LProduct := UInt32(PUInt16(Left)[I]) * Right + LHi16;
9232
    PUInt16(Result)[I] := TUInt32(LProduct).Lo;
9233
    LHi16 := TUInt32(LProduct).Hi;
9234
    Inc(I);
9235
  end;
9236
  if LHi16 <> 0 then
9237
  begin
9238
    PUInt16(Result)[I] := LHi16;
9239
    // var parameter Size := I;
9240
    // Size should be the fifth parameter, so it can easily be set from 64 bit code.
9241
  end;
9242
end;
9243
{$ELSEIF DEFINED(WIN32)}
9244
asm
9245
        PUSH    EBX
9246
        PUSH    ESI
9247
        PUSH    EDI
9248

9249
        JECXZ   @Exit
9250
        MOV     ESI,EAX
9251
        MOV     EDI,[EDX]
9252
        XOR     EBX,EBX
9253
        CMP     Right,0
9254
        JE      @Exit
9255

9256
@MultLoop:
9257

9258
        MOV     EAX,[ESI]
9259
        MOVZX   EDX,Right
9260
        MUL     EDX
9261
        ADD     EAX,EBX
9262
        ADC     EDX,0
9263
        MOV     EBX,EDX
9264
        MOV     [EDI],EAX
9265
        LEA     ESI,[ESI + CLimbSize]
9266
        LEA     EDI,[EDI + CLimbSize]
9267
        LEA     ECX,[ECX - 1]
9268
        JECXZ   @EndMultLoop
9269
        JMP     @MultLoop
9270

9271
@EndMultLoop:
9272

9273
        MOV     [EDI],EBX
9274

9275
@Exit:
9276

9277
        POP     EDI
9278
        POP     ESI
9279
        POP     EBX
9280
end;
9281
{$ELSE WIN64}
9282
asm
9283
        .PUSHNV RBX
9284
        .PUSHNV RDI
9285
        .PUSHNV RSI
9286

9287
        OR      R8D,R8D
9288
        JE      @Exit
9289
        OR      R9D,R9D
9290
        JE      @Exit
9291
        MOV     R11,[RDX]               // R11 = SaveResult
9292
        MOV     RDI,R11                 // RDI = Result
9293
        MOV     RSI,RCX                 // RSI = Left
9294
        MOV     ECX,R8D                 // ECX = MSize
9295
        XOR     EBX,EBX                 // EBX = Carry
9296

9297
@MultLoop:
9298

9299
        MOV     EAX,[RSI]
9300
        MUL     EAX,R9D                 // Unusual syntax, but XE2 otherwise generates MUL R9 instead of MUL R9D
9301
        ADD     EAX,EBX
9302
        ADC     EDX,0
9303
        MOV     [RDI],EAX
9304
        MOV     EBX,EDX
9305
        LEA     RSI,[RSI + CLimbSize]
9306
        LEA     RDI,[RDI + CLimbSize]
9307
        LEA     ECX,[ECX - 1]
9308
        JECXZ   @EndMultLoop
9309
        JMP     @MultLoop
9310

9311
@EndMultLoop:
9312

9313
        MOV     [RDI],EBX
9314

9315
@Exit:
9316
end;
9317
{$IFEND}
9318

9319
class operator BigInteger.Multiply(const Left: BigInteger; Right: Word): BigInteger;
9320
var
9321
  ResData: TMagnitude;
9322
  ResSize: Integer;
9323
begin
9324
  if (Right = 0) or ((Left.FSize and SizeMask) = 0) then
9325
    Exit(Zero);
9326
  ResSize := (Left.FSize and SizeMask) + 2;
9327
  SetLength(ResData, ResSize);
9328
  InternalMultiply16(Left.FData, ResData, (Left.FSize and SizeMask), Right);
9329
  Assert(Result.FData <> ResData);
9330
  Result.FData := ResData;
9331
  Result.FSize := (Left.FSize and SignMask) or ResSize;
9332
  Result.Compact;
9333
end;
9334

9335
class operator BigInteger.Multiply(Left: Word; const Right: BigInteger): BigInteger;
9336
begin
9337
  Result := Multiply(Right, Left);
9338
end;
9339

9340
class procedure BigInteger.MultiplyKaratsuba(const Left, Right: BigInteger; var Result: BigInteger);
9341
var
9342
  k, LSign: Integer;
9343
  z0, z1, z2: BigInteger;
9344
  x, y: TArray<BigInteger>;
9345
  Shift: Integer;
9346
begin
9347
  if ((Left.FSize and SizeMask) < KaratsubaThreshold) or ((Right.FSize and SizeMask) < KaratsubaThreshold) then
9348
  begin
9349
    MultiplyBaseCase(Left, Right, Result);
9350
    Exit;
9351
  end;
9352

9353
  //////////////////////////////////////////////////////////////////////////////////////////////////
9354
  ///  This is a so called divide and conquer algorithm, solving a big task by dividing it up    ///
9355
  ///  into easier (and hopefully faster, in total) smaller tasks.                               ///
9356
  ///                                                                                            ///
9357
  ///  Let's treat a BigInteger as a polynomial, i.e. x = x1 * B + x0, where B is chosen thus,   ///
9358
  ///  that the top and the low part of the BigInteger are almost the same in size.              ///
9359
  ///  The result R of the multiplication of two such polynomials can be seen as:                ///
9360
  ///                                                                                            ///
9361
  ///  R = (x1 * B + x0) * (y1 * B + y0) = x1 * y1 * B^2 + (x1 * y0 + x0 * y1) * B + x0 * y0     ///
9362
  ///                                                                                            ///
9363
  ///  say, z0 = x0 * y0                                                                         ///
9364
  ///       z1 = x1 * y0 + x0 * y1                                                               ///
9365
  ///       z2 = x1 * y1                                                                         ///
9366
  ///                                                                                            ///
9367
  ///  then                                                                                      ///
9368
  ///  R = z2 * B^2 + z1 * B + z0                                                                ///
9369
  ///                                                                                            ///
9370
  ///  Karatsuba noted that:                                                                     ///
9371
  ///                                                                                            ///
9372
  ///  (x1 + x0) * (y1 + y0) = z2 + z1 + z0, so z1 = (x1 + x0) * (y1 + y0) - (z2 + z0)           ///
9373
  ///                                                                                            ///
9374
  ///  That reduced four multiplications and a few additions to three multiplications, a few     ///
9375
  ///  additions and a subtraction. Surely the parts will be multilimb, but this is called       ///
9376
  ///  recursively down until the sizes are under a threshold, and then simple base case         ///
9377
  ///  (a.k.a. "schoolbook") multiplication is performed.                                        ///
9378
  //////////////////////////////////////////////////////////////////////////////////////////////////
9379

9380
  //////////////////////////////////////////////////////////////////////////////////////////////////
9381
  ///  Note: it may look tempting to use pointers into the original operands, to use one large   ///
9382
  ///  buffer for all results, and to use InternalMultiply directly, but remember that           ///
9383
  ///  InternalMultiply performs a basecase multiplication and it does NOT resurse into a        ///
9384
  ///  deeper level of MultiplyKaratsuba, so after one level, the advantage gained by reducing   ///
9385
  ///  the number of multiplications would be minimal.                                           ///
9386
  ///                                                                                            ///
9387
  ///  There is an overhead caused by using complete BigIntegers, but it is not as high as it    ///
9388
  ///  may look.                                                                                 ///
9389
  //////////////////////////////////////////////////////////////////////////////////////////////////
9390

9391
  LSign := (Left.FSize xor Right.FSize) and SignMask;
9392

9393
  k := (IntMax(Left.FSize and SizeMask, Right.FSize and SizeMask) + 1) shr 1;
9394

9395
  x := Left.Split(k, 2);
9396
  y := Right.Split(k, 2);
9397

9398
  // Recursion further reduces the number of multiplications!
9399
  MultiplyKaratsuba(x[1], y[1], z2);
9400
  MultiplyKaratsuba(x[0], y[0], z0);
9401
  MultiplyKaratsuba(x[1] - x[0], y[0] - y[1], z1);
9402
  Add(z1, z2 + z0, z1);
9403

9404
  Shift := k * CLimbBits;
9405

9406
  Result := z0 + ((z1 + z2 shl Shift) shl Shift);
9407
  Result.FSize := (Result.FSize and SizeMask) or LSign;
9408
end;
9409

9410
// Used by Karatsuba, Toom-Cook and Burnikel-Ziegler algorithms.
9411
// Splits Self into BlockCount pieces of (at most) BlockSize limbs, starting with the least significant part.
9412
function BigInteger.Split(BlockSize, BlockCount: Integer): TArray<BigInteger>;
9413
var
9414
  I: Integer;
9415
begin
9416
  SetLength(Result, BlockCount);
9417
  for I := 0 to BlockCount - 1 do
9418
  begin
9419
    if (Self.FSize and BigInteger.SizeMask) > I * BlockSize then
9420
    begin
9421
      Result[I].MakeSize(IntMin(BlockSize, (Self.FSize and SizeMask) - I * BlockSize));
9422
      CopyLimbs(PLimb(Self.FData) + I * BlockSize, PLimb(Result[I].FData), IntMin(BlockSize, (Self.FSize and SizeMask) - I * BlockSize));
9423
      Result[I].Compact;
9424
    end
9425
    else
9426
      ShallowCopy(Zero, Result[I]);
9427
  end;
9428
end;
9429

9430
{$IFNDEF PUREPASCAL}
9431
class procedure BigInteger.InternalDivideBy3(Value, Result: PLimb; ASize: Integer);
9432
const
9433
  MultConst = $AAAAAAAB;
9434
  MultConst2 = $55555556;
9435
{$IFDEF WIN32}
9436
asm
9437
        PUSH    ESI
9438
        PUSH    EDI
9439
        PUSH    EBX
9440

9441
        MOV     ESI,EAX                 // Value
9442
        MOV     EDI,EDX                 // Result
9443
        XOR     EBX,EBX                 // borrow
9444

9445
@Loop:
9446

9447
        MOV     EAX,[ESI]
9448
        SUB     EAX,EBX
9449
        SETC    BL
9450

9451
        MOV     EDX,MultConst
9452
        MUL     EAX,EDX
9453
        MOV     [EDI],EAX
9454

9455
        CMP     EAX,MultConst2
9456
        JB      @SkipInc
9457
        INC     EBX
9458
        CMP     EAX,MultConst
9459
        JB      @SkipInc
9460
        INC     EBX
9461

9462
@SkipInc:
9463

9464
        LEA     ESI,[ESI + CLimbSize]
9465
        LEA     EDI,[EDI + CLimbSize]
9466
        DEC     ECX
9467
        JNE     @Loop
9468

9469
@Exit:
9470

9471
        POP     EBX
9472
        POP     EDI
9473
        POP     ESI
9474
end;
9475
{$ELSE WIN64}
9476
asm
9477
        XOR     R9D,R9D                 // borrow
9478
        MOV     R10,RDX                 // Result
9479
        MOV     R11D,MultConst
9480

9481
@Loop:
9482

9483
        MOV     EAX,[RCX]
9484
        SUB     EAX,R9D
9485
        SETC    R9B
9486

9487
        MUL     EAX,R11D                // MultConst
9488
        MOV     [R10],EAX
9489

9490
        CMP     EAX,MultConst2
9491
        JB      @SkipInc
9492
        INC     R9D
9493
        CMP     EAX,R11D                // MultConst
9494
        JB      @SkipInc
9495
        INC     R9D
9496

9497
@SkipInc:
9498

9499
        LEA     RCX,[RCX + CLimbSize]
9500
        LEA     R10,[R10 + CLimbSize]
9501
        DEC     R8D
9502
        JNE     @Loop
9503
end;
9504
{$ENDIF WIN64}
9505
{$ENDIF !PUREPASCAL}
9506

9507
// Only works if it is known that there is no remainder and A is positive.
9508
class function BigInteger.DivideBy3Exactly(const A: BigInteger): BigInteger;
9509
const
9510
  ModInverse3 = $AAAAAAAB; // Modular inverse of 3 modulo $100000000.
9511
  ModInverse3t2 = $55555556; // ModInverse3 / 2
9512
{$IFDEF PUREPASCAL}
9513
var
9514
  i: Integer;
9515
  ai, w, qi, borrow: Int64;
9516
begin
9517
  if A.FData = nil then
9518
    Exit(Zero);
9519

9520
  Result.MakeSize(A.FSize and SizeMask);
9521
  borrow := 0;
9522
  for i := 0 to (A.FSize and SizeMask) - 1 do
9523
  begin
9524
    ai := A.FData[i];
9525
    w := ai - borrow;
9526
    if borrow > ai then
9527
      borrow := 1
9528
    else
9529
      borrow := 0;
9530

9531
    qi := (w * ModInverse3) and $FFFFFFFF;
9532
    Result.FData[i] := UInt32(qi);
9533

9534
    if qi >= ModInverse3t2 then
9535
    begin
9536
      Inc(borrow);
9537
      if qi >= ModInverse3 then
9538
        Inc(borrow);
9539
    end;
9540
  end;
9541

9542
  Result.Compact;
9543
end;
9544
{$ELSE !PUREPASCAL}
9545
begin
9546
  if A.FData = nil then
9547
  begin
9548
    ShallowCopy(Zero, Result);
9549
    Exit;
9550
  end;
9551

9552
  Result.MakeSize(A.FSize and SizeMask);
9553
  InternalDivideBy3(PLimb(A.FData), PLimb(Result.FData), A.FSize and SizeMask);
9554
  Result.Compact;
9555
end;
9556
{$ENDIF !PUREPASCAL}
9557

9558
class function BigInteger.MultiplyToomCook3(const Left, Right: BigInteger): BigInteger;
9559
var
9560
  k, Shift: Integer;
9561
  a, b: TArray<BigInteger>;
9562
  a02, b02: BigInteger;
9563
  v0, v1, vm1, v2, vinf: BigInteger;
9564
  t1, t2: BigInteger;
9565
  Sign: Integer;
9566
begin
9567
  // Step 1: if n < threshold then return MultiplyKaratsuba(A, B)
9568
  if ((Left.FSize and SizeMask) < ToomCook3Threshold) and ((Right.FSize and SizeMask) < ToomCook3Threshold) then
9569
  begin
9570
    MultiplyKaratsuba(Left, Right, Result);
9571
    Exit;
9572
  end;
9573

9574
  Sign := (Left.FSize xor Right.FSize) and SignMask;
9575

9576
  // Richard P. Brent and Paul Zimmermann,
9577
  // "Modern Computer Arithmetic", version 0.5.1 of April 28, 2010
9578
  // http://arxiv.org/pdf/1004.4710v1.pdf
9579
  // Algorithm 1.4
9580

9581
  // Step 2: write A = a0 + a1*x + a2*x^2, B = b0 + b1*x + b2*x^2, with x = ß^k.
9582
  k := (IntMax(Left.FSize and SizeMask, Right.FSize and SizeMask) + 2) div 3; // = Ceil(IntMax(...) div 3)
9583

9584
  a := Left.Split(k, 3);
9585
  b := Right.Split(k, 3);
9586

9587
  // Evaluation at x = -1, 0, 1, 2 and +inf.
9588

9589
  // Step 3: v0 <- ToomCook3(a0, b0)
9590
  v0 := MultiplyToomCook3(a[0], b[0]);
9591

9592
  // Step 4a: a02 <- a0 + a2, b02 <- b0 + b2
9593
  a02 := a[0] + a[2];
9594
  b02 := b[0] + b[2];
9595

9596
  // Step 5: v(-1) <- ToomCook3(a02 - a1, b02 - b1) = ToomCook3(a0 + a2 - a1, b0 + b2 - b1)
9597
  vm1 := MultiplyToomCook3(a02 - a[1], b02 - b[1]);
9598

9599
  // Intermediate step: a'02 = a02 + a1, b'02 = b02 + b1
9600
  a02 := a02 + a[1];
9601
  b02 := b02 + b[1];
9602

9603
  // Step 4b: v1 <- ToomCook3(a02 + a1, b02 + b1) = ToomCook3(a'02, b'02)
9604
  v1 := MultiplyToomCook3(a02, b02);
9605

9606
  // Step 6: v2 <- ToomCook3(a0 + 2*a1 + 4*a2, b0 + 2*b1 + 4*b2)
9607
  // Note: first operand is a0 + a1 + a1 + a2 + a2 + a2 + a2 = 2*(a0 + a1 + a2 + a2) - a0 = 2*(a'02 + a2) - a0
9608
  v2 := MultiplyToomCook3((a02 + a[2]) shl 1 - a[0], (b02 + b[2]) shl 1 - b[0]);
9609

9610
  // Step 7: v(inf) <- ToomCook3(a2, b2)
9611
  vinf := MultiplyToomCook3(a[2], b[2]);
9612

9613
  // Step 8: t1 <- (3*v0 + 2*v(−1) + v2)/6 − 2 * v(inf), t2 <- (v1 + v(−1))/2
9614
  t1 := DivideBy3Exactly(((v0 + vm1) shl 1 + v0 + v2) shr 1) - (vinf shl 1);
9615
  t2 := (v1 + vm1) shr 1;
9616

9617
  // Step 9: c0 <- v0, c1 <- v1 - t1, c2 <- t2 - v0 - vinf, c3 <- t1 - t2, c4 <- vinf
9618
  Shift := k * CLimbBits;
9619

9620
  Result := (((((((vinf shl Shift) + t1 - t2) shl Shift) + t2 - v0 - vinf) shl Shift) + v1 - t1) shl Shift) + v0;
9621
  Result.FSize := (Result.FSize and SizeMask) or Sign;
9622
end;
9623

9624
class function BigInteger.SqrKaratsuba(const Value: BigInteger): BigInteger;
9625
var
9626
  NDiv2Shift, NDiv2: Integer;
9627
  ValueUpper: BigInteger;
9628
  ValueLower: BigInteger;
9629
  Upper, Middle, Lower: BigInteger;
9630
  LSize: Integer;
9631
begin
9632
  LSize := (Value.FSize and SizeMask);
9633
  NDiv2Shift := (LSize and $FFFFFFFE) shl 4; // := LSize div 2 * SizeOf(TLimb);
9634
  NDiv2 := LSize div 2;
9635

9636
  ValueLower.MakeSize(NDiv2);
9637
  CopyLimbs(PLimb(Value.FData), PLimb(ValueLower.FData), NDiv2);
9638
  ValueUpper.MakeSize((Value.FSize and SizeMask) - NDiv2);
9639
  CopyLimbs(PLimb(Value.FData) + NDiv2, PLimb(ValueUpper.FData), (Value.FSize and SizeMask) - NDiv2);
9640
  ValueLower.Compact;
9641

9642
  Upper := Sqr(ValueUpper);
9643
  Lower := Sqr(ValueLower);
9644
  Middle := (ValueUpper * ValueLower) shl 1;
9645

9646
  // Can't simply move these values into place, because they still overlap when shifted.
9647
  Result := Upper shl (NDiv2Shift + NDiv2Shift) + Middle shl NDiv2Shift + Lower;
9648
  Result.FSize := Result.FSize and SizeMask;
9649
end;
9650

9651
class function BigInteger.Multiply(const Left, Right: BigInteger): BigInteger;
9652
begin
9653
  Multiply(Left, Right, Result);
9654
end;
9655

9656
class procedure BigInteger.Multiply(const Left, Right: BigInteger; var Result: BigInteger);
9657
var
9658
  LResult: BigInteger; // Avoid prematurely overwriting result when it is same as one of the operands.
9659
begin
9660
  if (Left.FData = nil) or (Right.FData = nil) then
9661
  begin
9662
    ShallowCopy(BigInteger.Zero, Result);
9663
    Exit;
9664
  end;
9665

9666
  if ((Left.FSize and SizeMask) < KaratsubaThreshold) or ((Right.FSize and SizeMask) < KaratsubaThreshold) then
9667
  begin
9668
    // The following block is "Result := MultiplyBaseCase(Left, Right);" written out in full.
9669
    LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 1);
9670
    InternalMultiply(PLimb(Left.FData), PLimb(Right.FData), PLimb(LResult.FData), Left.FSize and SizeMask,
9671
      Right.FSize and SizeMask);
9672
    LResult.Compact;
9673
    LResult.FSize := (LResult.FSize and SizeMask) or ((Left.FSize xor Right.FSize) and SignMask);
9674
    ShallowCopy(LResult, Result);
9675
  end
9676
  else
9677
  begin
9678
    if ((Left.FSize and SizeMask) < ToomCook3Threshold) and ((Right.FSize and SizeMask) < ToomCook3Threshold) then
9679
      MultiplyKaratsuba(Left, Right, Result)
9680
    else
9681
      Result := MultiplyToomCook3(Left, Right);
9682
  end;
9683
end;
9684

9685
class procedure BigInteger.MultiplyBaseCase(const Left, Right: BigInteger; var Result: BigInteger);
9686
var
9687
  LResult: BigInteger; // Avoid prematurely overwriting result when it is same as one of the operands.
9688
begin
9689
  if (Left.FData = nil) or (Right.FData = nil) then
9690
  begin
9691
    ShallowCopy(Zero, Result);
9692
    Exit;
9693
  end;
9694

9695
//$$RV  LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 1);
9696
  LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 256);
9697
  InternalMultiply(PLimb(Left.FData), PLimb(Right.FData), PLimb(LResult.FData), Left.FSize and SizeMask,
9698
    Right.FSize and SizeMask);
9699
  LResult.Compact;
9700
  LResult.SetSign(SignBitOf(Left.FSize) xor SignBitOf(Right.FSize));
9701
  ShallowCopy(LResult, Result);
9702
end;
9703

9704
class operator BigInteger.Multiply(const Left, Right: BigInteger): BigInteger;
9705
begin
9706
  Result := Multiply(Left, Right);
9707
end;
9708

9709
class procedure BigInteger.SetBase(const Value: TNumberBase);
9710
begin
9711
  FBase := Value;
9712
end;
9713

9714
procedure BigInteger.SetSign(Value: Integer);
9715
begin
9716
  FSize := (FSize and SizeMask) or (Ord(Value < 0) * SignMask);
9717
end;
9718

9719
{$IFNDEF BIGINTEGERIMMUTABLE}
9720
function BigInteger.Subtract(const Other: BigInteger): PBigInteger;
9721
var
9722
  MinusOther: BigInteger;
9723
begin
9724
  ShallowCopy(Other, MinusOther);
9725
  MinusOther.FSize := MinusOther.FSize xor SignMask;
9726
  Result := Add(MinusOther);
9727
end;
9728
{$ENDIF}
9729

9730
class function BigInteger.Subtract(const Left, Right: BigInteger): BigInteger;
9731
begin
9732
  Subtract(Left, Right, Result);
9733
end;
9734

9735
class procedure BigInteger.Subtract(const Left, Right: BigInteger; var Result: BigInteger);
9736
const
9737
  BoolMasks: array[Boolean] of Integer = (SignMask, 0);
9738
var
9739
  Largest, Smallest: PBigInteger;
9740
  LSize, SSize: Integer;
9741
  ResData: TMagnitude;
9742
  ResSize: Integer;
9743
  NewSize: Integer;
9744
  Comparison: Integer;
9745
begin
9746
  if Left.FData = nil then
9747
  begin
9748
    Result := Right;
9749
    if Result.FSize <> 0 then
9750
      Result.FSize := Result.FSize xor SignMask;
9751
    Exit;
9752
  end;
9753
  if Right.FData = nil then
9754
  begin
9755
    Result := Left;
9756
    Exit;
9757
  end;
9758

9759
  Comparison := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), Left.FSize and SizeMask,
9760
                  Right.FSize and SizeMask);
9761
  if (Comparison = 0) and (Left.Sign = Right.Sign) then
9762
  begin
9763
    Result := Zero;
9764
    Exit;
9765
  end;
9766

9767
  if Comparison > 0 then
9768
  begin
9769
    Largest := @Left;
9770
    Smallest := @Right;
9771
  end
9772
  else
9773
  begin
9774
    Largest := @Right;
9775
    Smallest := @Left;
9776
  end;
9777

9778
  SSize := Smallest^.FSize and SizeMask;
9779
  LSize := Largest^.FSize and SizeMask;
9780
  ResSize := LSize + 1;
9781
  SetLength(ResData, (ResSize + 3) and CapacityMask);
9782

9783
  if Largest^.Sign = Smallest^.Sign then
9784
    // Same sign: subtract magnitudes.
9785
    FInternalSubtract(PLimb(Largest^.FData), PLimb(Smallest^.FData), PLimb(ResData), LSize, SSize)
9786
  else
9787
    // Different sign: add magnitudes.
9788
    FInternalAdd(PLimb(Largest^.FData), PLimb(Smallest^.FData), PLimb(ResData), LSize, SSize);
9789

9790
  // Compact and set sign.
9791
  NewSize := ActualSize(PLimb(ResData), ResSize);
9792
  if NewSize = 0 then
9793
  begin
9794
    Result := Zero;
9795
    Exit;
9796
  end
9797
  else
9798
  begin
9799
    {$IFDEF RESETSIZE}
9800
    if NewSize < (ResSize + 3) and CapacityMask then
9801
      SetLength(ResData, (NewSize + 3) and CapacityMask);
9802
    {$ENDIF}
9803
    // Set sign and size.
9804
    Result.FSize := NewSize or BoolMasks[(Largest^.FSize < 0) xor (Largest = @Left)];
9805
    Result.FData := ResData;
9806
  end;
9807
end;
9808

9809
class operator BigInteger.Subtract(const Left, Right: BigInteger): BigInteger;
9810
begin
9811
  Subtract(Left, Right, Result);
9812
end;
9813

9814
procedure BigInteger.EnsureSize(RequiredSize: Integer);
9815
begin
9816
  RequiredSize := RequiredSize and SizeMask;
9817
  if RequiredSize > Length(FData) then
9818
    SetLength(FData, (RequiredSize + 4) and CapacityMask);
9819
  FSize := (FSize and SignMask) or RequiredSize;
9820
end;
9821

9822
procedure BigInteger.MakeSize(RequiredSize: Integer);
9823
begin
9824
  FData := nil;
9825
  AllocNewMagnitude(FData, RequiredSize);
9826
  FSize := RequiredSize;
9827
end;
9828

9829
// In Win32, we keep what we have. In Win64, we switch, depending on Size. At 25 limbs or above,
9830
// the unrolled loop version is faster.
9831
class procedure BigInteger.InternalNegate(Source, Dest: PLimb; Size: Integer);
9832
{$IFDEF PUREPASCAL}
9833
var
9834
  R: TLimb;
9835
begin
9836
  repeat
9837
    R := (not Source^) + 1;
9838
    Dest^ := R;
9839
    Inc(Source);
9840
    Inc(Dest);
9841
    Dec(Size);
9842
    if Size = 0 then
9843
      Exit;
9844
  until R <> 0;
9845
  while Size > 0 do
9846
  begin
9847
    Dest^ := not Source^;
9848
    Inc(Source);
9849
    Inc(Dest);
9850
    Dec(Size);
9851
  end;
9852
end;
9853
{$ELSE}
9854
{$IFDEF WIN32}
9855

9856
// This is faster than an unrolled loop with NOT and ADC, especially for smaller BigIntegers.
9857

9858
asm
9859
        PUSH    ESI
9860

9861
@Loop:
9862

9863
        MOV     ESI,[EAX]
9864
        NOT     ESI
9865
        INC     ESI
9866
        MOV     [EDX],ESI
9867
        LEA     EAX,[EAX + CLimbSize]
9868
        LEA     EDX,[EDX + CLimbSize]
9869
        DEC     ECX
9870
        JE      @Exit
9871
        TEST    ESI,ESI                 // Only if ESI is 0, a carry occurred.
9872
        JE      @Loop
9873

9874
@RestLoop:                              // No more carry. We can stop incrementing.
9875

9876
        MOV     ESI,[EAX]
9877
        NOT     ESI
9878
        MOV     [EDX],ESI
9879
        LEA     EAX,[EAX + CLimbSize]
9880
        LEA     EDX,[EDX + CLimbSize]
9881
        DEC     ECX
9882
        JNE     @RestLoop
9883

9884
@Exit:
9885

9886
        POP     ESI
9887
end;
9888
{$ELSE WIN64}
9889
asm
9890

9891
        CMP     R8D,25
9892
        JA      @Unrolled
9893

9894
// Plain version. Faster for small BigIntegers (<= 25 limbs).
9895

9896
@Loop:
9897

9898
        MOV     EAX,[RCX]
9899
        NOT     EAX
9900
        INC     EAX
9901
        MOV     [RDX],EAX
9902
        LEA     RCX,[RCX + CLimbSize]
9903
        LEA     RDX,[RDX + CLimbSize]
9904
        DEC     R8D
9905
        JE      @Exit
9906
        TEST    EAX,EAX
9907
        JE      @Loop
9908

9909
@RestLoop:
9910

9911
        MOV     EAX,[RCX]
9912
        NOT     EAX
9913
        MOV     [RDX],EAX
9914
        LEA     RCX,[RCX + CLimbSize]
9915
        LEA     RDX,[RDX + CLimbSize]
9916
        DEC     R8D
9917
        JNE     @RestLoop
9918
        JMP     @Exit
9919

9920
// Unrolled version. Faster for larger BigIntegers.
9921

9922
@Unrolled:
9923

9924
        TEST    RCX,RCX
9925
        JE      @Exit
9926
        XCHG    R8,RCX
9927
        MOV     R9,RDX
9928
        XOR     EDX,EDX
9929
        MOV     R10D,ECX
9930
        AND     R10D,CUnrollMask
9931
        SHR     ECX,CUnrollShift
9932
        STC
9933
        JE      @Rest
9934

9935
@LoopU:
9936

9937
        MOV     RAX,[R8]
9938
        NOT     RAX
9939
        ADC     RAX,RDX
9940
        MOV     [R9],RAX
9941

9942
        MOV     RAX,[R8 + DLimbSize]
9943
        NOT     RAX
9944
        ADC     RAX,RDX
9945
        MOV     [R9 + DLimbSize],RAX
9946

9947
        LEA     R8,[R8 + 2*DLimbSize]
9948
        LEA     R9,[R9 + 2*DLimbSize]
9949
        LEA     ECX,[ECX - 1]
9950
        JECXZ   @Rest
9951
        JMP     @LoopU
9952

9953
@Rest:
9954

9955
        LEA     RAX,[@JumpTable]
9956
        JMP     [RAX + R10*TYPE Pointer]
9957

9958
        .ALIGN  16
9959

9960
@JumpTable:
9961

9962
        DQ      @Exit
9963
        DQ      @Rest1
9964
        DQ      @Rest2
9965
        DQ      @Rest3
9966

9967
@Rest3:
9968

9969
        MOV     RAX,[R8]
9970
        NOT     RAX
9971
        ADC     RAX,RDX
9972
        MOV     [R9],RAX
9973

9974
        MOV     EAX,[R8 + DLimbSize]
9975
        NOT     EAX
9976
        ADC     EAX,EDX
9977
        MOV     [R9 + DLimbSize],EAX
9978

9979
        JMP     @Exit
9980

9981
@Rest2:
9982

9983
        MOV     RAX,[R8]
9984
        NOT     RAX
9985
        ADC     RAX,RDX
9986
        MOV     [R9],RAX
9987

9988
        JMP     @Exit
9989

9990
@Rest1:
9991

9992
        MOV     EAX,[R8]
9993
        NOT     EAX
9994
        ADC     EAX,EDX
9995
        MOV     [R9],EAX
9996

9997
@Exit:
9998
end;
9999
{$ENDIF WIN64}
10000
{$ENDIF !PUREPASCAL}
10001

10002
class procedure BigInteger.InternalBitwise(const Left, Right: BigInteger;
10003
  var Result: BigInteger; PlainOp, OppositeOp, InversionOp: TBinaryOperator);
10004

10005
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10006
///  The code for the bitwise operators AND, OR and XOR does not differ much.                                     ///
10007
///  Since the results should be the results for two's complement, two's complement semantics are emulated.       ///
10008
///  Originally, this meant that the magnitudes of negative bigintegers were negated, then the                    ///
10009
///  operation was performed and if the result had to be negative, the magnitude of the result was negated.       ///
10010
///  These negation steps were slow, so now this code uses some logical shortcuts.                                ///
10011
///                                                                                                               ///
10012
///  The rules used are like follows.                                                                             ///
10013
///                                                                                                               ///
10014
///  In the following, A and B represent positive integer values, so -A and -B represent negative values.         ///
10015
///  Note that, to keep this simple, 0 -- i.e. FData = nil -- is not handled at all. That is handled              ///
10016
///  by the caller and then this routine is not called.                                                           ///
10017
///                                                                                                               ///
10018
///  Relation between negation and inversion of an integer/magnitude:                                             ///
10019
///  -A = not A + 1    => not A = -A - 1                                                                          ///
10020
///  -A = not (A - 1)                                                                                             ///
10021
///                                                                                                               ///
10022
///  Note: A and B are magnitudes here. Negating a BigInteger is as simple as flipping the sign bit. That         ///
10023
///  does not work for magnitudes.                                                                                ///
10024
///                                                                                                               ///
10025
///  Boolean (and bitwise) rules followed:                                                                        ///
10026
///  not not A       = A                                                                                          ///
10027
///  not (A and B)   = not A or not B                                                                             ///
10028
///  not (A or B)    = not A and not B                                                                            ///
10029
///  not (A xor B)   = not A xor B = A xor not B                                                                  ///
10030
///  not A xor not B = A xor B                                                                                    ///
10031
///                                                                                                               ///
10032
///  Expressions used here:                                                                                       ///
10033
///                                                                                                               ///
10034
///  A and B      = A and B                               ; both positive, plain operation                        ///
10035
///  A and -B     = A and not (B - 1)                     ; one positive, one negative, result positive           ///
10036
///  -(-A and -B) = -(not (A - 1) and not (B - 1))        ; both negative, result is negative too                 ///
10037
///               = - not ((A - 1) or (B - 1)))                                                                   ///
10038
///               = (A - 1) or (B - 1) + 1                                                                        ///
10039
///                                                                                                               ///
10040
///  A or B       = A or B                                ; both positive                                         ///
10041
///  -(A or -B)   = -(A or not (B - 1))                   ; one positive, one negative, result is negative too    ///
10042
///               = - not (not A and (B - 1))                                                                     ///
10043
///               = ((B - 1) and not A) + 1                                                                       ///
10044
///  -(-A or -B)  = -(not (A - 1) or not (B - 1))         ; both negative, result is negative too                 ///
10045
///               = not (not (A - 1) or not (B - 1) + 1                                                           ///
10046
///               = (A - 1) and (B - 1) + 1                                                                       ///
10047
///                                                                                                               ///
10048
///  A xor B      = A xor B                               ; both positive                                         ///
10049
///  -(A xor -B)  = -(A xor not (B - 1))                  ; one positive, one negative, result is negative too    ///
10050
///               = not (A xor not (B - 1)) + 1                                                                   ///
10051
///               = A xor (B - 1) + 1                                                                             ///
10052
///  -A xor -B    = not (A - 1) xor not (B - 1)           ; both negative, result is positive                     ///
10053
///               = (A - 1) xor (B - 1)                                                                           ///
10054
///                                                                                                               ///
10055
///  So the only "primitives" required are routines for AND, OR, XOR and AND NOT. The latter is not really        ///
10056
///  a primitive, but it is so easy to implement, that it can be considered one. NOT is cheap, does not require   ///
10057
///  complicated carry handling.                                                                                  ///
10058
///  Routines like Inc and Dec are cheap too: you only loop as long as there is a carry (or borrow). Often, that  ///
10059
///  is only over very few limbs.                                                                                 ///
10060
///                                                                                                               ///
10061
///  Primitives (InternalAnd(), etc.) routines were optimized too. Loops were unrolled, 64 bit registers used     ///
10062
///  where possible, both sizes are passed, so the operations can be done on the original data. The latter        ///
10063
///  reduces the need for copying into internal buffers.                                                          ///
10064
///                                                                                                               ///
10065
///  These optimizations made bitwise operators 2-3 times as fast as with the simple implementations before.      ///
10066
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10067

10068
var
10069
  LSize, RSize, MinSize, MaxSize: Integer;
10070
  LPtr, RPtr: PLimb;
10071
begin
10072
  LSize := Left.FSize and SizeMask;
10073
  RSize := Right.FSize and SizeMask;
10074
  MinSize := IntMin(LSize, RSize);
10075
  MaxSize := IntMax(LSize, RSize);
10076

10077
  if ((Left.FSize xor Right.FSize) and SignMask) = 0 then
10078
  begin
10079
    if (Left.FSize > 0) then
10080
    begin
10081
      if Addr(PlainOp) = Addr(InternalAnd) then
10082
        Result.MakeSize(MinSize)
10083
      else
10084
        Result.MakeSize(MaxSize);
10085
      PlainOp(PLimb(Left.FData), PLimb(Right.FData), PLimb(Result.FData), LSize, RSize);
10086
    end
10087
    else
10088
    begin
10089
      LPtr := AllocLimbs(LSize + RSize);                        // LPtr := Copy(Left);
10090
      RPtr := LPtr + LSize;                                     // RPtr := Coyp(Right);
10091
      CopyLimbs(PLimb(Left.FData), LPtr, LSize);
10092
      CopyLimbs(PLimb(Right.FData), RPtr, RSize);
10093
      InternalDecrement(LPtr, LSize);                           // LPtr^ := LPtr^ - 1
10094
      InternalDecrement(RPtr, RSize);                           // RPtr^ := RPtr^ - 1
10095
      Result.FSize := 0;
10096
      Result.MakeSize(MaxSize);
10097
      OppositeOp(LPtr, RPtr, PLimb(Result.FData), LSize, RSize); // Opposite op: AND --> OR, OR --> AND, XOR --> XOR
10098
      if Addr(PlainOp) = Addr(InternalXor) then
10099
        Result.FSize := Result.FSize and SizeMask               // Make positive.
10100
      else
10101
      begin
10102
        InternalIncrement(PLimb(Result.FData), MaxSize);        // Result := Result + 1
10103
        Result.FSize := Result.FSize or SignMask;               // Make negative.
10104
      end;
10105
      FreeMem(LPtr);
10106
    end;
10107
  end
10108
  else
10109
  begin
10110
    if (Left.FSize > 0) then
10111
    begin
10112
      RPtr := AllocLimbs(RSize);
10113
      CopyLimbs(PLimb(Right.FData), RPtr, RSize);
10114
      InternalDecrement(RPtr, RSize);
10115
      Result.FSize := 0;
10116
      if Addr(PlainOp) = Addr(InternalOr) then
10117
        Result.MakeSize(RSize)
10118
      else
10119
        Result.MakeSize(MaxSize);
10120
      // Inversion op: AND --> AND NOT, OR --> NOT AND, XOR --> XOR
10121
      InversionOp(PLimb(Left.FData), RPtr, PLimb(Result.FData), LSize, RSize);
10122
      if Addr(PlainOp) = Addr(InternalAnd) then
10123
        Result.FSize := Result.FSize and SizeMask               // Make positive.
10124
      else
10125
      begin
10126
         InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10127
         Result.FSize := Result.FSize or SignMask;              // Make negative.
10128
      end;
10129
      FreeMem(RPtr);
10130
    end
10131
    else
10132
    begin
10133
      LPtr := AllocLimbs(LSize);
10134
      CopyLimbs(PLimb(Left.FData), LPtr, LSize);
10135
      InternalDecrement(LPtr, LSize);
10136
      Result.FSize := 0;
10137
      if Addr(PlainOp) = Addr(InternalOr) then
10138
        Result.MakeSize(LSize)
10139
      else
10140
        Result.MakeSize(MaxSize);
10141
      InversionOp(PLimb(Right.FData), LPtr, PLimb(Result.FData), RSize, LSize);
10142
      if Addr(PlainOp) = Addr(InternalAnd) then
10143
        Result.FSize := Result.FSize and SizeMask
10144
      else
10145
      begin
10146
         InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10147
         Result.FSize := Result.FSize or SignMask;
10148
      end;
10149
      FreeMem(LPtr);
10150
    end;
10151
  end;
10152
  Result.Compact;
10153
end;
10154

10155
class function BigInteger.Negate(const Value: BigInteger): BigInteger;
10156
begin
10157
  Result.FData := Value.FData;
10158
  Result.FSize := Value.FSize xor SignMask;
10159
end;
10160

10161
class operator BigInteger.Negative(const Value: BigInteger): BigInteger;
10162
begin
10163
  // Magnitude is not modified, so a shallow copy is enough!
10164
  ShallowCopy(Value, Result);
10165
  if Result.FSize <> 0 then
10166
    Result.FSize := Result.FSize xor SignMask;
10167
end;
10168

10169
class function BigInteger.Parse(const S: string): BigInteger;
10170
var
10171
  TryResult: BigInteger;
10172
begin
10173
  if TryParse(S, TryResult) then
10174
    Result := TryResult
10175
  else
10176
    Error(ecParse, [S, 'BigInteger']);
10177
end;
10178

10179

10180
class function BigInteger.Pow(const ABase: BigInteger; AExponent: Integer): BigInteger;
10181
begin
10182
  Pow(ABase, AExponent, Result);
10183
end;
10184

10185
class procedure BigInteger.Pow(const ABase: BigInteger; AExponent: Integer; var Result: BigInteger);
10186
var
10187
  LBase: BigInteger;
10188
  LBaseBitLength: Integer;
10189
  LScaleFactor: Int64;
10190
  LBigResult: BigInteger;
10191
  LTrailingZeros: Integer;
10192
  LShift: Int64;
10193
  LNewSign: Integer;
10194
  LIntResult: Int64;
10195
  IntBase: Int64;
10196
  LExponent: Integer;
10197
  LResultIsNegative: Boolean;
10198
begin
10199
  if AExponent < 0 then
10200
    Error(ecNegativeExponent, ['AExponent']);
10201

10202
  if ABase.IsZero then
10203
    if AExponent = 0 then
10204
    begin
10205
      ShallowCopy(BigInteger.One, Result);
10206
      Exit;
10207
    end
10208
    else
10209
    begin
10210
      ShallowCopy(ABase, Result);
10211
      Exit;
10212
    end;
10213

10214
  LResultIsNegative := ABase.IsNegative and Odd(AExponent);
10215

10216
  LBase := BigInteger.Abs(ABase);
10217

10218
  ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10219
  ///  Speed things up by removing any common trailing zero bits. The resulting values will probably be smaller,  ///
10220
  ///  so exponentation is done with smaller values, and thus probably faster. The zero bits are added back in    ///
10221
  ///  (multiplied by the exponent, of course) at the very end.                                                   ///
10222
  ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10223

10224
  LTrailingZeros := LBase.LowestSetBit;
10225
  LShift := Int64(LTrailingZeros) * AExponent;
10226
  if LShift > High(Integer) then
10227
    Error(ecOverflow, []);
10228

10229
  if LTrailingZeros <> 0 then
10230
  begin
10231
    LBase := LBase shr LTrailingZeros;
10232
    LBaseBitLength := LBase.BitLength;
10233
    if LBaseBitLength = 1 then
10234
    begin
10235
      if LResultIsNegative then
10236
      begin
10237
        ShallowCopy(BigInteger.MinusOne shl (LTrailingZeros * AExponent), Result);
10238
        Exit;
10239
      end
10240
      else
10241
      begin
10242
        ShallowCopy(BigInteger.One shl (LTrailingZeros * AExponent), Result);
10243
        Exit;
10244
      end;
10245
    end;
10246
  end
10247
  else
10248
  begin
10249
    LBaseBitLength := LBase.BitLength;
10250
    if LBaseBitLength = 1 then
10251
      if LResultIsNegative then
10252
      begin
10253
        ShallowCopy(BigInteger.MinusOne, Result);
10254
        Exit;
10255
      end
10256
      else
10257
      begin
10258
        ShallowCopy(BigInteger.One, Result);
10259
        Exit;
10260
      end;
10261
  end;
10262

10263
  LScaleFactor := Int64(LBaseBitLength) * AExponent;
10264

10265
  if (LBase.Size = 1) and (LScaleFactor < 31) then
10266
  begin
10267
    // Small values.
10268
    LNewSign := 1;
10269
    if LResultIsNegative then
10270
      LNewSign := -1;
10271
    LIntResult := 1;
10272
    IntBase := LBase.Magnitude[0];
10273

10274
    //////////////////////////////////////////////////////////////////////////////////////////////////////////
10275
    ///  The exponentiation proper:                                                                        ///
10276
    ///                                                                                                    ///
10277
    ///  1. Square the power for each iteration. So you get Base^1, Base^2, Base^4, Base^8, Base^16, etc.  ///
10278
    ///  2. For each bit in the exponent, multiply with the corresponding (i.e. current value of) power    ///
10279
    ///                                                                                                    ///
10280
    ///  Example: 7^11 = 7 ^ (8 + 2 + 1) = 7^1 * 7^2 * 7^8.                                                ///
10281
    //////////////////////////////////////////////////////////////////////////////////////////////////////////
10282
    LExponent := AExponent;
10283
    while LExponent <> 0 do
10284
    begin
10285
      if Odd(LExponent) then
10286
        LIntResult := LIntResult * IntBase;
10287
      LExponent := LExponent shr 1;
10288
      if LExponent <> 0 then
10289
        IntBase := IntBase * IntBase;
10290
    end;
10291

10292
    ///////////////////////////////////////////////////////////////////////////////////////////////////////////
10293
    ///  Append the trailing zeroes (times exponent) back in, to get the real result.                       ///
10294
    ///////////////////////////////////////////////////////////////////////////////////////////////////////////
10295
    if LTrailingZeros > 0 then
10296
    begin
10297
      if LShift + LScaleFactor < 31 then
10298
        Result := BigInteger(LIntResult shl LShift)  // LIntResult shl Shift is in range of Integer.
10299
      else
10300
        Result := BigInteger(LIntResult) shl LShift; // slightly slower: BigInteger is shifted, not the integer.
10301
      if LResultIsNegative then
10302
      begin
10303
        ShallowCopy(-Result, Result);
10304
        Exit;
10305
      end
10306
      else
10307
        Exit;
10308
    end
10309
    else
10310
    begin
10311
      ShallowCopy(BigInteger(LIntResult * LNewSign), Result);
10312
      Exit;
10313
    end;
10314
  end
10315
  else
10316
  begin
10317
    // True BigIntegers.
10318
    LBigResult := BigInteger.One;
10319
    LExponent := AExponent;
10320

10321
    // The exponentiation proper. See explanation above.
10322
    while LExponent <> 0 do
10323
    begin
10324
      if Odd(LExponent) then
10325
        BigInteger.Multiply(LBigResult, LBase, LBigResult);
10326
      LExponent := LExponent shr 1;
10327
      if LExponent <> 0 then
10328
        LBase := Sqr(LBase);
10329
    end;
10330

10331
    // Append the trailing zeroes (times exponent) back in, to get the real result.
10332
    if LTrailingZeros > 0 then
10333
      LBigResult := LBigResult shl (LTrailingZeros * AExponent);
10334

10335
    if LResultIsNegative then
10336
    begin
10337
      ShallowCopy(-LBigResult, Result);
10338
      Exit;
10339
    end
10340
    else
10341
    begin
10342
      ShallowCopy(LBigResult, Result);
10343
      Exit;
10344
    end;
10345
  end;
10346
end;
10347

10348
class operator BigInteger.NotEqual(const Left, Right: BigInteger): Boolean;
10349
begin
10350
  Result := Compare(Left, Right) <> 0;
10351
end;
10352

10353
class procedure BigInteger.Octal;
10354
begin
10355
  FBase := 8;
10356
end;
10357

10358
class function BigInteger.Remainder(const Left: BigInteger; Right: UInt16): BigInteger;
10359
var
10360
  LQuotient: TMagnitude;
10361
begin
10362
  if Right = 0 then
10363
    Error(ecDivByZero, []);
10364
  Result.MakeSize(1);
10365
  SetLength(LQuotient, (Left.FSize and SizeMask));
10366
  InternalDivMod32(PLimb(Left.FData), Right, PLimb(LQuotient), PLimb(Result.FData), (Left.FSize and SizeMask));
10367
  Result.Compact;
10368
  if Result.FSize <> 0 then
10369
    Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
10370
end;
10371

10372
class function BigInteger.Remainder(const Left: BigInteger; Right: UInt32): BigInteger;
10373
var
10374
  LQuotient: TMagnitude;
10375
begin
10376
  if Right = 0 then
10377
    Error(ecDivByZero, []);
10378
  Result.MakeSize(1);
10379
  SetLength(LQuotient, (Left.FSize and SizeMask));
10380
  InternalDivMod32(PLimb(Left.FData), Right, PLimb(LQuotient), PLimb(Result.FData), (Left.FSize and SizeMask));
10381
  Result.Compact;
10382
  if Result.FSize <> 0 then
10383
    Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
10384
end;
10385

10386
class function BigInteger.Remainder(const Left, Right: BigInteger): BigInteger;
10387
var
10388
  Quotient: BigInteger;
10389
  LSize, RSize: Integer;
10390
begin
10391
  if Right.FData = nil then
10392
    Error(ecDivByZero, []);
10393

10394
  LSize := Left.FSize and SizeMask;
10395
  RSize := Right.FSize and SizeMask;
10396

10397
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
10398
    -1:
10399
      begin
10400
        ShallowCopy(Left, Result);
10401
        Exit;
10402
      end;
10403
    0:
10404
      begin
10405
        ShallowCopy(Zero, Result);
10406
        Exit;
10407
      end;
10408
    else
10409
      begin
10410
        if ShouldUseBurnikelZiegler(LSize, RSize) then
10411
          DivModBurnikelZiegler(Left, Right, Quotient, Result)
10412
        else
10413
          DivModKnuth(Left, Right, Quotient, Result);
10414

10415
        // In Delphi, sign of remainder is sign of dividend.
10416
        if Result.FSize <> 0 then
10417
          Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
10418
      end;
10419
  end;
10420
end;
10421

10422
{$IFNDEF BIGINTEGERIMMUTABLE}
10423
function BigInteger.Remainder(const Other: BigInteger): PBigInteger;
10424
begin
10425
  Result := @Self;
10426
  Self := Self mod Other;
10427
end;
10428
{$ENDIF}
10429

10430

10431
class procedure BigInteger.ShiftRight(const Value: BigInteger; Shift: Integer; var Result: BigInteger);
10432

10433
// Note: this emulates two's complement, more or less like the bitwise operators.
10434

10435
/////////////////////////////////////////////////////////////////////////////////////////////////////////
10436
//                                                                                                     //
10437
//  If Value is a negative BigInteger, then the following applies:                                     //                                                                        //
10438
//                                                                                                     //
10439
//  - shift magnitude as for positive value                                                            //
10440
//  - if (Value < 0) and (Shift > Abs(Value).LowestSetBit()) then                                      //
10441
//      Inc(Result.Magnitude);                                                                         //
10442
//  - Make Result negative if necessary.                                                               //
10443
//                                                                                                     //
10444
//  This greatly simplifies the previous code for negative results.                                    //
10445
//                                                                                                     //
10446
/////////////////////////////////////////////////////////////////////////////////////////////////////////
10447

10448
var
10449
  LSize, LShift: Integer;
10450
  ShiftOffset: Integer;
10451
  RSize: Integer;
10452
  Lowest: Integer;
10453
//  P: PLimb;
10454
begin
10455
  if Value.FData = nil then
10456
  begin
10457
    ShallowCopy(Zero, Result);
10458
    Exit;
10459
  end;
10460

10461
  LSize := (Value.FSize and SizeMask);
10462
  ShiftOffset := Shift shr 5;
10463
  RSize := LSize - ShiftOffset;
10464

10465
  if RSize <= 0 then
10466

10467
  // Shift results in 0. But for negative values, result might be -1.
10468

10469
  begin
10470
    if (Value.FSize < 0) and (Shift > Value.LowestSetBit) then
10471
      ShallowCopy(MinusOne, Result)
10472
    else
10473
      ShallowCopy(Zero, Result);
10474
    Exit;
10475
  end;
10476

10477
  LShift := Shift and $1F;
10478
  Result.MakeSize(RSize);
10479
  if LShift > 0 then
10480
    InternalShiftRight(PLimb(Value.FData) + ShiftOffset, PLimb(Result.FData), LShift, RSize)
10481
  else
10482
    CopyLimbs(PLimb(Value.FData) + ShiftOffset, PLimb(Result.FData), RSize);
10483

10484
  // See comment box above. Handle negative values, if necessary.
10485

10486
  if Value.FSize < 0 then
10487
  begin
10488

10489
    // Simulate two's complement.
10490

10491
    Lowest := Value.LowestSetBit;
10492
    if Shift > Lowest then
10493
      InternalIncrement(PLimb(Result.FData), RSize);
10494
    Result.FSize := Result.FSize or SignMask;
10495
  end;
10496

10497
  Result.Compact;
10498
end;
10499

10500
class function BigInteger.ShiftRight(const Value: BigInteger; Shift: Integer): BigInteger;
10501
begin
10502
  ShiftRight(Value, Shift, Result);
10503
end;
10504

10505
class operator BigInteger.RightShift(const Value: BigInteger; Shift: Integer): BigInteger;
10506
begin
10507
  ShiftRight(Value, Shift, Result);
10508
end;
10509

10510
class operator BigInteger.Implicit(const Value: string): BigInteger;
10511
begin
10512
  if not TryParse(Value, Result) then
10513
    Error(ecParse, [Value, 'BigInteger']);
10514
end;
10515

10516
{$IFNDEF NoAnsi}
10517
class operator BigInteger.Implicit(const Value: PAnsiChar): BigInteger;
10518
begin
10519
  if not TryParse(string(AnsiString(Value)), Result) then
10520
    Error(ecParse, [string(AnsiString(Value)), 'BigInteger']);
10521
end;
10522
{$ENDIF}
10523

10524
class operator BigInteger.Implicit(const Value: PWideChar): BigInteger;
10525
begin
10526
  if not TryParse(Value, Result) then
10527
    Error(ecParse, [Value, 'BigInteger']);
10528
end;
10529

10530
{$IFDEF HasExtended}
10531
class operator BigInteger.Explicit(const Value: BigInteger): Extended;
10532
begin
10533
  Result := Value.AsExtended;
10534
end;
10535
{$ENDIF}
10536

10537
class operator BigInteger.Explicit(const Value: BigInteger): Double;
10538
begin
10539
  Result := Value.AsDouble;
10540
end;
10541

10542
class operator BigInteger.Explicit(const Value: BigInteger): Single;
10543
begin
10544
  Result := Value.AsSingle;
10545
end;
10546

10547
class operator BigInteger.Explicit(const Value: Double): BigInteger;
10548
begin
10549
  Result.Create(Value);
10550
end;
10551

10552
class operator BigInteger.Explicit(const Value: BigInteger): string;
10553
begin
10554
  Result := Value.ToString;
10555
end;
10556

10557
class operator BigInteger.Inc(const Value: BigInteger): BigInteger;
10558
begin
10559
  if Value.FData = nil then
10560
  begin
10561
    ShallowCopy(One, Result);
10562
    Exit;
10563
  end;
10564
  Result.FData := Copy(Value.FData);
10565
  Result.FSize := Value.FSize;
10566
  if Result.FSize > 0 then
10567
  begin
10568
    Result.EnsureSize((Result.FSize and SizeMask) + 1);
10569
    InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10570
  end
10571
  else
10572
    InternalDecrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10573
  Result.Compact;
10574
end;
10575

10576
class operator BigInteger.Dec(const Value: BigInteger): BigInteger;
10577
begin
10578
  if Value.FData = nil then
10579
  begin
10580
    ShallowCopy(MinusOne, Result);
10581
    Exit;
10582
  end;
10583
  Result.FData := Copy(Value.FData);
10584
  Result.FSize := Value.FSize;
10585
  if Result.FSize < 0 then
10586
  begin
10587
    Result.EnsureSize((Result.FSize and SizeMask) + 1);
10588
    InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10589
  end
10590
  else
10591
    InternalDecrement(PLimb(Result.FData), (Result.FSize and SizeMask));
10592
  Result.Compact;
10593
end;
10594

10595
{$IFNDEF BIGINTEGERIMMUTABLE}
10596
function BigInteger.Add(const Other: BigInteger): PBigInteger;
10597
var
10598
  SelfSize, OtherSize: Integer;
10599
  Comparison: Integer;
10600
begin
10601
  Result := @Self;
10602
  if Other.IsZero then
10603
    Exit;
10604
  if Self.IsZero then
10605
  begin
10606
    Self := Other;
10607
    Exit;
10608
  end;
10609
  FData := Copy(FData);
10610
  SelfSize := FSize and SizeMask;
10611
  OtherSize := Other.FSize and SizeMask;
10612
  if Self.IsNegative = Other.IsNegative then
10613
  begin
10614
    EnsureSize(IntMax(SelfSize, OtherSize) + 1);
10615
    FInternalAdd(PLimb(Self.FData), PLimb(Other.FData), PLimb(Self.FData), SelfSize, OtherSize);
10616
  end
10617
  else
10618
  begin
10619
    // Different signs, so subtract.
10620
    EnsureSize(IntMax(SelfSize, OtherSize));
10621
    Comparison := InternalCompare(PLimb(Self.FData), PLimb(Other.FData), (Self.FSize and SizeMask),
10622
                    (Other.FSize and SizeMask));
10623
    if Comparison = 0 then
10624
    begin
10625
      Self := Zero;
10626
      Exit;
10627
    end;
10628

10629
    if Comparison > 0 then
10630
    begin
10631
      FInternalSubtract(PLimb(Self.FData), PLimb(Other.FData), PLimb(Self.FData), SelfSize, OtherSize);
10632
    end
10633
    else
10634
    begin
10635
      FInternalSubtract(PLimb(Other.FData), PLimb(Self.FData), PLimb(Self.FData), OtherSize, SelfSize);
10636
      Self.FSize := Self.FSize xor SignMask;
10637
    end;
10638
  end;
10639
  Compact;
10640
end;
10641
{$ENDIF}
10642

10643
class procedure BigInteger.AvoidPartialFlagsStall(Value: Boolean);
10644
{$IFDEF PUREPASCAL}
10645
begin
10646
  FInternalAdd := InternalAddPurePascal;
10647
  FInternalSubtract := InternalSubtractPurePascal;
10648
end;
10649
{$ELSE}
10650
begin
10651
  FAvoidStall := Value;
10652
  if Value then
10653
  begin
10654
    FInternalAdd := InternalAddModified;
10655
    FInternalSubtract := InternalSubtractModified;
10656
  end
10657
  else
10658
  begin
10659
    FInternalAdd := InternalAddPlain;
10660
    FInternalSubtract := InternalSubtractPlain;
10661
  end;
10662
end;
10663
{$ENDIF}
10664

10665
{$IFNDEF BIGINTEGERIMMUTABLE}
10666
function BigInteger.Multiply(const Other: BigInteger): PBigInteger;
10667
begin
10668
  Result := @Self;
10669
  Self := Self * Other;
10670
end;
10671
{$ENDIF}
10672

10673
procedure FlipBigIntegerBit(var B: BigInteger; Index: Integer); inline;
10674
begin
10675
  B.FData := Copy(B.FData);
10676
  B.EnsureSize(IntMax(Index shr 5 + 1, B.FSize and BigInteger.SizeMask));
10677
  B.FData[Index shr 5] := B.FData[Index shr 5] xor (1 shl (Index and $1F));
10678
  B.Compact;
10679
end;
10680

10681
function BigInteger.TestBit(Index: Integer): Boolean;
10682

10683
///////////////////////////////////////////////////////////////////////
10684
///  Two's complement semantics are required.                       ///
10685
///                                                                 ///
10686
///  Note: -A = not (A - 1) = not A + 1                             ///
10687
///                                                                 ///
10688
///  Example, assuming 16 bit limbs, negating goes like follows:    ///
10689
///                                                                 ///
10690
///    -$1234 5678 9ABC 0000 0000 -> $EDCB A987 6544 0000 0000      ///
10691
///  0:                      0000 ->                      FFFF + 1  ///
10692
///  1:                 0000      ->                 FFFF + 1       ///
10693
///  2:            9ABC           ->            6543 + 1            ///
10694
///  3:       5678                ->       A987                     ///
10695
///  4:  1234                     ->  EDCB                          ///
10696
///                                                                 ///
10697
///  So accessing limb 4 or 3:    Data := not Data                  ///
10698
///     accessing limb 2, 1 or 0: Data := not Data + 1              ///
10699
///////////////////////////////////////////////////////////////////////
10700

10701
var
10702
  I: Integer;
10703
  Mask: TLimb;
10704
  Data: TLimb;
10705
begin
10706
  if FData = nil then
10707

10708
    // Zero, so no bit set. Return False.
10709
    Result := False
10710
  else if Index >= BitLength then
10711

10712
    // Beyond bit length, so return sign
10713
    Result := (FSize and SignMask) <> 0
10714
  else
10715
  begin
10716
    Mask := 1 shl (Index and $1F);
10717
    Index := Index shr 5;
10718
    Data := FData[Index];
10719

10720
    // Emulate negation if this BigInteger is negative.
10721
    // Not necessary if BigInteger is positive.
10722
    if (FSize and SignMask) <> 0 then
10723
    begin
10724

10725
      // -A = not A + 1.
10726
      Data := not Data; // Wait with the + 1, see below.
10727
      I := 0;
10728

10729
      // See if carry propagates from lowest limb to limb containing the bit. If so, increment Data.
10730
      while (I <= Index) and (FData[I] = 0) do
10731
        Inc(I);
10732
      if Index <= I then
10733
        Inc(Data);
10734
    end;
10735

10736
    // Get the bit.
10737
    Result := (Data and Mask) <> 0;
10738
  end;
10739
end;
10740

10741
function BigInteger.SetBit(Index: Integer): BigInteger;
10742
var
10743
  LimbIndex: Integer;
10744
  BitMask, Borrow, Data: TLimb;
10745
begin
10746
  Result := Self.Clone;
10747
  LimbIndex := Index shr 5;
10748
  BitMask := 1 shl (Index and 31);
10749

10750
  if Self.IsNegative then
10751
  begin
10752
    // If negative, every bit beyond the bit length is supposed to be set already (assuming two's complement), so
10753
    // no change.
10754
    if Index > Self.BitLength then
10755
      Exit;
10756

10757
    // No need to change the limbs below the index, so start at LimbIndex.
10758

10759
    // Negate this limb, set the bit, negate it again and store it back.
10760
    Data := Result.FData[LimbIndex];
10761
    Result.FData[LimbIndex] := -(-Data or BitMask);
10762
    Inc(LimbIndex);
10763

10764
    // If there was a borrow, it must be propagated.
10765
    Borrow := Ord(Data = 0);
10766
    if Borrow <> 0 then
10767
      while LimbIndex < (Result.FSize and SizeMask) do
10768
      begin
10769
        Data := Result.FData[LimbIndex];
10770
        Result.FData[LimbIndex] := Data - 1;
10771

10772
        // We can stop if the limb *wasn't* 0, since then there will be no borrow anymore.
10773
        if Data <> 0 then
10774
          Break
10775
        else
10776
          Inc(LimbIndex);
10777
      end;
10778
  end
10779
  else
10780
  begin
10781
    // If the bit is beyond the bit length, the size must be expanded.
10782
    if (Index > Self.BitLength) or Self.IsZero then
10783
      Result.EnsureSize(LimbIndex + 1);
10784

10785
    // Set the bit.
10786
    Result.FData[LimbIndex] := Result.FData[LimbIndex] or BitMask;
10787
  end;
10788
  Result.Compact;
10789
end;
10790

10791
function BigInteger.ClearBit(Index: Integer): BigInteger;
10792
var
10793
  LimbIndex: Integer;
10794
  BitMask, Borrow, Data: TLimb;
10795
begin
10796
  Result := Self.Clone;
10797
  LimbIndex := Index shr 5;
10798
  BitMask := 1 shl (Index and 31);
10799

10800
  if Self.IsNegative then
10801
  begin
10802
    if Index > Self.BitLength then
10803
    begin
10804
      Result.EnsureSize(LimbIndex + 1);
10805
      Result.FData[LimbIndex] := Result.FData[LimbIndex] or BitMask;
10806
    end
10807
    else
10808
    begin
10809
      Data := Result.FData[LimbIndex];
10810
      Result.FData[LimbIndex] := TLimb(-(-Data and not BitMask));
10811
      Inc(LimbIndex);
10812

10813
      // Propagate borrow
10814
      Borrow := Ord(Data = 0);
10815
      if Borrow > 0 then
10816
        while LimbIndex < Result.FSize and SizeMask do
10817
        begin
10818
          Data := Result.FData[LimbIndex];
10819
          Dec(Result.FData[LimbIndex]);
10820
          if Data <> 0 then
10821
            Break
10822
          else
10823
            Inc(LimbIndex);
10824
        end;
10825
    end;
10826
  end
10827
  else
10828
  begin
10829
    if Index > BitLength then
10830
      Exit;
10831
    Result.FData[LimbIndex] := Result.FData[LimbIndex] and not BitMask;
10832
  end;
10833
  Result.Compact;
10834
end;
10835

10836
function BigInteger.FlipBit(Index: Integer): BigInteger;
10837
var
10838
  LimbIndex: Integer;
10839
  BitMask, Borrow, Data: TLimb;
10840
begin
10841
  Result := Self.Clone;
10842
  LimbIndex := Index shr 5;
10843
  BitMask := 1 shl (Index and 31);
10844

10845
  if Self.IsNegative then
10846
  begin
10847
    if Index > Self.BitLength then
10848
    begin
10849
      Result.EnsureSize(LimbIndex + 1);
10850
      Result.FData[LimbIndex] := Result.FData[LimbIndex] xor BitMask;
10851
    end
10852
    else
10853
    begin
10854
      Data := Result.FData[LimbIndex];
10855
      Result.FData[LimbIndex] := -(-Data xor BitMask);
10856
      Inc(LimbIndex);
10857

10858
      // Propagate borrow
10859
      Borrow := Ord(Data = 0);
10860
      if Borrow > 0 then
10861
        while LimbIndex < Result.FSize and SizeMask do
10862
        begin
10863
          Data := Result.FData[LimbIndex];
10864
          Dec(Result.FData[LimbIndex]);
10865
          if Data <> 0 then
10866
            Break
10867
          else
10868
            Inc(LimbIndex);
10869
        end;
10870
    end;
10871
  end
10872
  else
10873
  begin
10874
    if (Index > BitLength) or Self.IsZero then
10875
      Result.EnsureSize(LimbIndex + 1);
10876
    Result.FData[LimbIndex] := Result.FData[LimbIndex] xor BitMask;
10877
  end;
10878
  Result.Compact;
10879
end;
10880

10881
class function BigInteger.NthRoot(const Radicand: BigInteger; Index: Integer): BigInteger;
10882
var
10883
  PredIndex: Integer;
10884
  BigIndex, BigPredIndex: Integer;
10885
  Newestimate, PrevEstimate: BigInteger;
10886
begin
10887
  if Radicand.IsZero or Radicand.IsOne then
10888
    Exit(Radicand);
10889
  if Radicand.IsNegative then
10890
    Error(ecNegativeRadicand, ['NthRoot']);
10891
  case Index of
10892
    0: Exit(BigInteger.Zero);
10893
    1: Exit(Radicand);
10894
    2: Exit(BaseCaseSqrt(Radicand));
10895
  end;
10896
  if Index < 0 then
10897
    Error(ecNegativeExponent, ['NthRoot']);
10898
  PredIndex := System.Pred(Index);
10899
  Result := BigInteger.Zero.SetBit(Radicand.BitLength div Index);
10900
  PrevEstimate := Result;
10901

10902
  // Loop invariants
10903
  BigIndex := Index;
10904
  BigPredIndex := PredIndex;
10905

10906
  // Newton-Raphson approximation loop, similar to code in Sqrt().
10907
  repeat
10908
    NewEstimate := (Result * BigPredIndex + Radicand div BigInteger.Pow(Result, PredIndex)) div BigIndex;
10909
    // Loop until no difference with previous value or detect end of a cycle.
10910

10911
    ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10912
    /// Unfortunately, the true root is only detected when the cycle starts repeating, i.e. at the end of the cycle. ///
10913
    /// That means that this routine can be slower if there is a cycle. Otherwise, it is fast.                 ///
10914
    ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
10915
    if (Result = NewEstimate) or ((Result < NewEstimate) and (Result < PrevEstimate)) then
10916
      Exit(Result);
10917
    PrevEstimate := Result;
10918
    Result := NewEstimate;
10919
  until False;
10920
end;
10921

10922
class procedure BigInteger.NthRootRemainder(const Radicand: BigInteger; Index: Integer; var Root, Remainder: BigInteger);
10923
begin
10924
  Root := NthRoot(Radicand, Index);
10925
  Remainder := Radicand - Pow(Root, Index);
10926
end;
10927

10928
class function BigInteger.Sqr(const Value: BigInteger): BigInteger;
10929
begin
10930
  if (Value.FSize and SizeMask) < KaratsubaSqrThreshold then
10931
    Result := Value * Value
10932
  else
10933
    Result := SqrKaratsuba(Value);
10934
end;
10935

10936
//////////////////////////////////////////////////////////////////////////////////////////////////
10937
/// A Newton-Raphson algorithm is *much* faster than the previous binary-search like           ///
10938
/// algorithm.                                                                                 ///
10939
///                                                                                            ///
10940
/// This new N-R algorithm is even faster than the previous and correct. The previous one      ///
10941
/// could go into an endless loop when the estimate flipped continuously between the root and  ///
10942
/// root+1, which is something that doesn't happen often, but can occur, e.g. for a radicand   ///
10943
/// with the value 8.                                                                          ///
10944
///                                                                                            ///
10945
/// https://stackoverflow.com/questions/4407839#16804098                                       ///
10946
//////////////////////////////////////////////////////////////////////////////////////////////////
10947
class function BigInteger.BaseCaseSqrt(const Radicand: BigInteger): BigInteger;
10948
var
10949
  PrevEstimate, NewEstimate: BigInteger;
10950
begin
10951
  if Radicand.IsOne or Radicand.IsZero then
10952
    Exit(Radicand);
10953
  if Radicand.IsNegative then
10954
    Error(ecNegativeRadicand, ['Sqrt']); // Do not translate!
10955
  Result := Radicand shr (Radicand.BitLength shr 1);
10956
  PrevEstimate := Result;
10957
  // Loop until we hit the same value twice in a row, or wind up alternating.
10958
  repeat
10959
    NewEstimate := (Result + Radicand div Result) shr 1;
10960
    if (NewEstimate = Result) or              // normal case
10961
       (NewEstimate = PrevEstimate) then        // alternating case
10962
      Exit(BigInteger.Min(Result, NewEstimate));
10963
    PrevEstimate := Result;
10964
    Result := NewEstimate;
10965
  until False;
10966
end;
10967

10968
class procedure BigInteger.BaseCaseSqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger);
10969
begin
10970
  Root := BaseCaseSqrt(Radicand);
10971
  Remainder := Radicand - Sqr(Root);
10972
end;
10973

10974
class function BigInteger.Sqrt(const Radicand: BigInteger): BigInteger;
10975
var
10976
  Rem: BigInteger;
10977
begin
10978
  SqrtRemainder(Radicand, Result, Rem);
10979
end;
10980

10981
// Richard P. Brent and Paul Zimmermann, "Modern Computer Arithmetic", Algorithm 1.12
10982
// Produces square root and square root remainder in one go.
10983
// Extremely fast, much faster than Newton-Raphson (as used in BaseCaseSqrtRemainder), even for relatively
10984
// small sizes.
10985
class procedure BigInteger.SqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger);
10986
var
10987
  RadCopy: BigInteger;
10988
  Limbs: Integer;
10989
  BaseToL, BaseMask: BigInteger;
10990
  A3, A2, A1, A0: BigInteger;
10991
  RootQ, RemQ: BigInteger;
10992
  Quot, Rem: BigInteger;
10993
begin
10994
  // Note: if the threshold is too small, a stack overflow will occur.
10995
  if Radicand.Size < 10 then
10996
  begin
10997
    BaseCaseSqrtRemainder(Radicand, Root, Remainder);
10998
    Exit;
10999
  end;
11000

11001
  // l = trunc((n - 1) / 4)
11002
  Limbs := (Radicand.Size - 1) div 4;
11003

11004
  // if l = 0 then return BaseCaseSqrtRem(m) <-- See above: there is a threshold > 0
11005

11006
  BaseToL := BigInteger.One shl (CLimbBits * Limbs);
11007
  BaseMask := BaseToL - 1;
11008

11009
  // Write m = a3*beta^3*l + a2*beta^2*l + a1*beta^l + a0 with 0 <= a2, a1, a0 < beta^l
11010
  A0 := Radicand and BaseMask;
11011
  RadCopy := Radicand shr (CLimbBits * Limbs);
11012
  A1 := RadCopy and BaseMask;
11013
  RadCopy := RadCopy shr (CLimbBits * Limbs);
11014
  A2 := RadCopy and BaseMask;
11015
  A3 := RadCopy shr (CLimbBits * Limbs);
11016

11017
  // (s^', r') <-- SqrtRem(a3*beta^l + a2)
11018
  BigInteger.SqrtRemainder(A3 * BaseToL + A2, RootQ, RemQ);
11019

11020
  // (q, u) <-- DivRem(r'*beta^l + a1, 2*s')
11021
  BigInteger.DivMod(RemQ * BaseToL + A1, RootQ shl 1, Quot, Rem);
11022

11023
  // s <-- s'*beta^l + q
11024
  Root := RootQ * BaseToL + Quot;
11025

11026
  // r <-- u*beta^l + a0 - q^2
11027
  Remainder := Rem * BaseToL + A0 - BigInteger.Sqr(Quot);
11028

11029
  // if r < 0 then
11030
  if Remainder < 0 then
11031
  begin
11032
    // r <-- r + 2*s - 1
11033
    Remainder := Remainder + 2 * Root - 1;
11034

11035
    // s <-- s - 1
11036
    Root := Root - 1;
11037
  end;
11038

11039
  // return (s, r)
11040
end;
11041

11042
class procedure BigInteger.DivThreeHalvesByTwo(const LeftUpperMid, LeftLower, Right, RightUpper: BigInteger;
11043
  const RightLower: BigInteger; N: Integer;
11044
  var Quotient, Remainder: BigInteger);
11045
var
11046
  Q, R: BigInteger;
11047
begin
11048
  if RightLower.FData <> nil then
11049
    ;
11050
  Q := BigInteger.Zero;
11051
  R := BigInteger.Zero;
11052
  if (LeftUpperMid shr N) = RightUpper then
11053
  begin
11054
    Q := (BigInteger.One shl N) - BigInteger.One;
11055
    R := LeftUpperMid - (RightUpper shl N) + RightUpper;
11056
  end
11057
  else
11058
    DivTwoDigitsByOne(LeftUpperMid, RightUpper, N, Q, R);
11059

11060
  Quotient := Q;
11061
  Remainder := ((R shl N) or LeftLower) - Q * RightLower;
11062
  while Remainder < 0 do
11063
  begin
11064
    Dec(Quotient);
11065
    Remainder := Remainder + Right;
11066
  end;
11067
end;
11068

11069

11070
class procedure BigInteger.DivTwoDigitsByOne(const Left, Right: BigInteger; N: Integer;
11071
  var Quotient, Remainder: BigInteger);
11072
var
11073
  NIsOdd: Boolean;
11074
  LeftCopy, RightCopy: BigInteger;
11075
  HalfN: Integer;
11076
  HalfMask: BigInteger;
11077
  RightUpper, RightLower: BigInteger;
11078
  QuotientUpper, QuotientLower: BigInteger;
11079
  Quot, Rem: BigInteger;
11080
begin
11081
  Quot := BigInteger.Zero;
11082
  Rem := BigInteger.Zero;
11083
  if N <= BigInteger.BurnikelZieglerThreshold * CLimbBits then
11084
  begin
11085
    BigInteger.DivModKnuth(Left, Right, Quot, Rem);
11086
    Quotient := Quot;
11087
    Remainder := Rem;
11088
    Exit;
11089
  end;
11090

11091
  NIsOdd := Odd(N);
11092
  if NIsOdd then
11093
  begin
11094
    LeftCopy := Left shl 1;
11095
    RightCopy := Right shl 1;
11096
    Inc(N);
11097
  end
11098
  else
11099
  begin
11100
    LeftCopy := Left;
11101
    RightCopy := Right;
11102
  end;
11103
  HalfN := N shr 1;
11104
  HalfMask := (BigInteger.One shl HalfN) - BigInteger.One;
11105

11106
  RightUpper := RightCopy shr HalfN;
11107
  RightLower := RightCopy and HalfMask;
11108

11109
  DivThreeHalvesByTwo(LeftCopy shr N, (LeftCopy shr HalfN) and HalfMask, RightCopy, RightUpper,
11110
    RightLower, HalfN, QuotientUpper, Rem);
11111
  DivThreeHalvesByTwo(Rem, LeftCopy and HalfMask, RightCopy, RightUpper,
11112
    RightLower, HalfN, QuotientLower, Rem);
11113

11114
  /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
11115
  ///                                                                                                               ///
11116
  ///  Grade school division, but with (very) large digits, dividing [a1,a2,a3,a4] by [b1,b2]:                      ///
11117
  ///                                                                                                               ///
11118
  ///    +----+----+----+----+     +----+----+   +----+                                                             ///
11119
  ///    | a1 | a2 | a3 | a4 |  /  | b1 | b2 | = | q1 |        DivideThreeHalvesByTwo(a1a2, a3, b1b2, n, q1, r1r2)  ///
11120
  ///    +----+----+----+----+     +----+----+   +----+                                                             ///
11121
  ///    +--------------+  |                       |                                                                ///
11122
  ///    |   b1b2 * q1  |  |                       |                                                                ///
11123
  ///    +--------------+  |                       |                                                                ///
11124
  ///  - ================  v                       |                                                                ///
11125
  ///         +----+----+----+     +----+----+     |  +----+                                                        ///
11126
  ///         | r1 | r2 | a4 |  /  | b1 | b2 | =   |  | q2 |   DivideThreeHalvesByTwo(r1r2, a4, b1b2, n, q1, r1r2)  ///
11127
  ///         +----+----+----+     +----+----+     |  +----+                                                        ///
11128
  ///         +--------------+                     |    |                                                           ///
11129
  ///         |   b1b2 * q2  |                     |    |                                                           ///
11130
  ///         +--------------+                     |    |                                                           ///
11131
  ///       - ================                     v    v                                                           ///
11132
  ///              +----+----+                   +----+----+                                                        ///
11133
  ///              | r1 | r2 |                   | q1 | q2 |   r1r2 = a1a2a3a4 mod b1b2, q1q2 = a1a2a3a4 div b1b2   ///
11134
  ///              +----+----+                   +----+----+ ,                                                      ///
11135
  ///                                                                                                               ///
11136
  ///  Note: in the diagram above, a1, b1, q1, r1 etc. are the most significant "digits" of their numbers.          ///
11137
  ///                                                                                                               ///
11138
  /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
11139

11140
  if NIsOdd then
11141
    Rem := Rem shr 1;
11142
  Remainder := Rem;
11143
  Quotient := (QuotientUpper shl HalfN) or QuotientLower;
11144
end;
11145

11146
class procedure BigInteger.InternalDivModBurnikelZiegler(const Left, Right: BigInteger;
11147
  var Quotient, Remainder: BigInteger);
11148
var
11149
  LCopy: BigInteger;
11150
  N: Integer;
11151
  DigitMask: BigInteger;
11152
  LeftDigits: TArray<BigInteger>;
11153
  NumDigits: Integer;
11154
  QuotientDigit: BigInteger;
11155
  DigitIndex: Integer;
11156
begin
11157
  LCopy := Left;
11158
  N := Right.BitLength;
11159

11160
  // A digit has the same bit length as right has, so this is the number of digits that must be allocated.
11161
  NumDigits := (Left.BitLength + N - 1) div N;
11162
  SetLength(LeftDigits, NumDigits);
11163

11164
  // Split Left into a number of digits of the same bitsize as Right, and collect them in LeftDigits.
11165
  DigitIndex := 0;
11166
  DigitMask := (BigInteger.One shl N) - BigInteger.One;
11167
  while not LCopy.IsZero do
11168
  begin
11169
    LeftDigits[DigitIndex] := LCopy and DigitMask;
11170
    LCopy := LCopy shr N;
11171
    Inc(DigitIndex);
11172
  end;
11173
  // Make DigitIndex point to top of "stack"
11174
  Dec(DigitIndex);
11175

11176
  // Remainder is the top digit of the "two digits" that are to be divided by "one".
11177
  if LeftDigits[DigitIndex] >= Right then
11178
    Remainder := BigInteger.Zero
11179
  else
11180
  begin
11181
    Remainder := LeftDigits[DigitIndex];
11182
    Dec(DigitIndex);
11183
  end;
11184

11185
  // Clear QuotientDigit and Quotient.
11186
  QuotientDigit := BigInteger.Zero;
11187
  Quotient := BigInteger.Zero;
11188

11189
  // Repeatedly divide two digits by the right digit and shift the resulting quotient digit into the final quotient.
11190
  while DigitIndex >= 0 do
11191
  begin
11192
    DivTwoDigitsByOne((Remainder shl N) + LeftDigits[DigitIndex], Right, N, QuotientDigit, Remainder);
11193
    Dec(DigitIndex);
11194
    Quotient := (Quotient shl N) + QuotientDigit;
11195
  end;
11196
end;
11197

11198
class procedure BigInteger.DivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
11199
var
11200
  Q, R: BigInteger;
11201
begin
11202

11203
  if Right.IsZero then
11204
    raise Exception.Create('Division by zero')
11205
  else if Right.IsNegative then
11206
  begin
11207
    DivModBurnikelZiegler(-Left, -Right, Q, R);
11208
    Quotient := Q;
11209
    Remainder := -R;
11210
    Exit;
11211
  end
11212
  else if Left.IsNegative then
11213
  begin
11214
    DivModBurnikelZiegler(not Left, Right, Q, R);
11215
    Quotient := not Q;
11216
    Remainder := Right + not R;
11217
    Exit;
11218
  end
11219
  else if Left.IsZero then
11220
  begin
11221
    Quotient := BigInteger.Zero;
11222
    Remainder := BigInteger.Zero;
11223
    Exit;
11224
  end
11225
  else
11226
  begin
11227
    InternalDivModBurnikelZiegler(Left, Right, Q, R);
11228
    Quotient := Q;
11229
    Remainder := R;
11230
    Exit;
11231
  end;
11232
end;
11233

11234
end.
11235