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, Rudy Velthuis                                       }
10
{ Notes:      See http://praxis-velthuis.de/rdc/programs/bigintegers.html   }
11
{                                                                           }
12
{             For tests, see BigIntegerDevelopmentTests.dproj. The data     }
13
{             for these tests are generated by a C# program, in the         }
14
{             Tests\CSharp\BigIntegerTestGenerator subdirectory.            }
15
{                                                                           }
16
{ Credits:                                                                  }
17
{             Thanks to Peter Cordes, Nils Pipenbrinck and Johan for their  }
18
{             help on StackOverflow:                                        }
19
{             - http://stackoverflow.com/a/32298732/95954                   }
20
{             - http://stackoverflow.com/a/32087095/95954                   }
21
{             - http://stackoverflow.com/a/32084357/95954                   }
22
{                                                                           }
23
{             Thanks to Agner Fog for his excellent optimization guides.    }
24
{                                                                           }
25
{ Literature:                                                               }
26
{             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
{             4. Christoph Burnikel, Joachim Ziegler                        }
37
{                "Fast Recursive Division"                                  }
38
{                cr.yp.to/bib/1998/burnikel.ps                              }
39
{             5. Hacker's Delight, e.g.                                     }
40
{                http://www.hackersdelight.org/basics2.pdf                  }
41
{             as well as many Wikipedia articles                            }
42
{                                                                           }
43
{ ------------------------------------------------------------------------- }
44
{                                                                           }
45
{ License:    Redistribution and use in source and binary forms, with or    }
46
{             without modification, are permitted provided that the         }
47
{             following conditions are met:                                 }
48
{                                                                           }
49
{             * Redistributions of source code must retain the above        }
50
{               copyright notice, this list of conditions and the following }
51
{               disclaimer.                                                 }
52
{             * Redistributions in binary form must reproduce the above     }
53
{               copyright notice, this list of conditions and the following }
54
{               disclaimer in the documentation and/or other materials      }
55
{               provided with the distribution.                             }
56
{                                                                           }
57
{ Disclaimer: THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER "AS IS"     }
58
{             AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT     }
59
{             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND     }
60
{             FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO        }
61
{             EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE     }
62
{             FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,     }
63
{             OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,      }
64
{             PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,     }
65
{             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED    }
66
{             AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   }
67
{             LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)        }
68
{             ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF   }
69
{             ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.                    }
70
{                                                                           }
71
{---------------------------------------------------------------------------}
72

73
{---------------------------------------------------------------------------}
74
{ Corrections:                                                              }
75
{             2015.11.28: changed calls to System.@GetMem in                }
76
{             System.AllocMem. GetMem does not clear memory, causing the    }
77
{             occasional bad result.                                        }
78
{---------------------------------------------------------------------------}
79

80
unit Velthuis.BigIntegers;
81

82
interface
83

84
uses
85
  Velthuis.RandomNumbers, Types, System.SysUtils, Math;
86

87
// --- User settings ---
88

89
{$UNDEF DEBUG}
90

91
// Setting PUREPASCAL forces the use of plain Object Pascal for all routines, i.e. no assembler is used.
92

93
  {$DEFINE PUREPASCAL}
94

95

96
// Setting RESETSIZE forces the Compact routine to shrink the dynamic array when that makes sense.
97
// This can slow down code a little.
98

99
  { $DEFINE RESETSIZE}
100

101

102
// Experimental is set for code that tries something new without deleting the original code yet. Undefine it to get the original code.
103

104
  {$DEFINE Experimental}
105

106

107
// --- Permanent settings ---
108

109
// For Delphi XE3 and up:
110
{$IF CompilerVersion >= 24.0 }
111
  {$LEGACYIFEND ON}
112
{$IFEND}
113

114
// For Delphi XE and up:
115
{$IF CompilerVersion >= 22.0}
116
  {$CODEALIGN 16}
117
  {$ALIGN 16}
118
{$IFEND}
119

120
// Assembler is only supplied for Windows targets.
121
// For other targets, PUREPASCAL must be defined.
122

123
{$IFNDEF PUREPASCAL}
124
  {$IF NOT DEFINED(MSWINDOWS)}
125
    {$DEFINE PUREPASCAL}
126
  {$IFEND}
127
{$ENDIF}
128

129
const
130
{$IFDEF PUREPASCAL}
131
  PurePascal = True;
132
{$ELSE}
133
  PurePascal = False;
134
{$ENDIF}
135

136
  // This assumes an unroll factor of 4. Unrolling more (e.g. 8) does not improve performance anymore.
137
  // That was tested and removed again.
138
  CUnrollShift     = 2;
139
  CUnrollIncrement = 1 shl CUnrollShift;
140
  CunrollMask      = CUnrollIncrement - 1;
141

142
type
143
  BigIntegerException = Exception;
144

145
  TNumberBase = 2..36;
146

147
  PLimb = ^TLimb;                               // Knuth calls them "limbs".
148
  TLimb = type UInt32;
149
  TMagnitude = array of TLimb;                   // These BigIntegers use sign-magnitude format, hence the name.
150

151
  // TBigInteger uses a sign-magnitude representation, i.e. the magnitude is always interpreted as an unsigned big integer,
152
  // while the sign bit represents the sign. Currently, the sign bit is stored as the top bit of the FSize member.
153

154
  PBigInteger = ^BigInteger;
155
  BigInteger = record
156
  public
157
  {$REGION 'public constants, types and variables'}
158
    type
159
      /// <summary>TRoundingMode governs which rounding mode is used to convert from Double to BigInteger.</summary>
160
      /// <param name="rmTruncate">Truncates any fraction</param>
161
      /// <param name="rmSchool">Rounds any fraction >= 0.5 away from zero</param>
162
      /// <param name="rmRound">Rounds any fraction > 0.5 away from zero</param>
163
      TRoundingMode = (rmTruncate, rmSchool, rmRound);
164

165
    class var
166
      MinusOne: BigInteger;
167
      Zero: BigInteger;
168
      One: BigInteger;
169
      Ten: BigInteger;
170

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

176
      // TODO: check the values of these constants
177

178
  {$IFDEF PUREPASCAL}
179
    {$IFDEF CPUX64}                                             // 64PP = 64 bit, Pure Pascal
180
      KaratsubaThreshold             =   96;    // Checked
181
      ToomCook3Threshold             =  272;    // Checked
182
      BurnikelZieglerThreshold       =   91;    // Checked
183
      BurnikelZieglerOffsetThreshold =    5;    // Unchecked
184
      KaratsubaSqrThreshold          =   48;    // Unchecked
185
    {$ELSE CPUX86}                                              // 32PP = 32 bit, Pure Pascal
186
      KaratsubaThreshold             =   56;    // Checked
187
      ToomCook3Threshold             =  144;    // Checked
188
      BurnikelZieglerThreshold       =   91;    // Checked
189
      BurnikelZieglerOffsetThreshold =    5;    // Unchecked
190
      KaratsubaSqrThreshold          =   48;    // Unchecked
191
    {$ENDIF CPUX64}
192
  {$ELSE !PUREPASCAL}
193
    {$IFDEF CPUX64}                                             // 64A  = 64 bit, Assembler
194
      KaratsubaThreshold             =  256;    // Checked
195
      ToomCook3Threshold             =  768;    // Checked
196
      BurnikelZieglerThreshold       =  160;    // Checked
197
      BurnikelZieglerOffsetThreshold =   80;    // Unchecked
198
      KaratsubaSqrThreshold          =  256;    // Unchecked
199
    {$ELSE CPUX86}                                              // 32A  = 32 bit, Assembler
200
      KaratsubaThreshold             =   96;    // Checked
201
      ToomCook3Threshold             =  256;    // Checked
202
      BurnikelZieglerThreshold       =   80;    // Checked
203
      BurnikelZieglerOffsetThreshold =   40;    // Unchecked
204
      KaratsubaSqrThreshold          =  128;    // Unchecked
205
    {$ENDIF CPUX64}
206
  {$ENDIF PUREPASCAL}
207

208
      ToomCook3SqrThreshold          =  216;    // Unchecked
209
  {$ENDREGION}
210

211
  {$REGION 'public methods'}
212

213
    // -- Constructors --
214

215
    /// <summary>Initializes class variables before first use.</summary>
216
    class constructor Initialize;
217

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

223
    /// <summary>Creates a new BigInteger from the data in limbs and the sign specified in Negative.</summary>
224
    /// <param name="Data">data for the magnitude of the BigInteger. The data is interpreted as unsigned, and comes low limb first.</param>
225
    /// <param name="Negative">Indicates if the BigInteger is negative.</param>
226
    constructor Create(const Data: TMagnitude; Negative: Boolean); overload;
227

228
    /// <summary>Creates a new BigInteger with the same value as the specified BigInteger.</summary>
229
    constructor Create(const Int: BigInteger); overload;
230

231
    /// <summary>Creates a new BigInteger with the value of the specified Integer.<summary>
232
    constructor Create(const Int: Int32); overload;
233

234
    /// <summary>Creates a new BigInteger with the value of the specified Cardinal.<summary>
235
    constructor Create(const Int: UInt32); overload;
236

237
    /// <summary>Creates a new BigInteger with the value of the specified 64 bit integer.<summary>
238
    constructor Create(const Int: Int64); overload;
239

240
    /// <summary>Creates a new BigInteger with the value of the specified Integer.<summary>
241
    constructor Create(const Int: UInt64); overload;
242

243
    /// <summary>Creates a new BigInteger with the integer value of the specified Double.</summary>
244
    constructor Create(const ADouble: Double); overload;
245

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

251
    /// <summary>Creates a new random BigInteger of the given size. Uses the given IRandom to
252
    ///   generate the random value.</summary>
253
    constructor Create(NumBits: Integer; const Random: IRandom); overload;
254

255

256
    // -- Global numeric base related functions --
257

258
    /// <summary>Sets the global numeric base for big integers to 10.</summary>
259
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
260
    ///   the output function.</remarks>
261
    class procedure Decimal; static;
262

263
    /// <summary>Sets the global numeric base for big integers to 16.</summary>
264
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
265
    ///   the output function.</remarks>
266
    class procedure Hexadecimal; static;
267

268
    /// <summary>Sets the global numeric base for big integers to 16.</summary>
269
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
270
    ///   the output function.</remarks>
271
    class procedure Hex; static;
272

273
    /// <summary>Sets the global numeric base for big integers to 2.</summary>
274
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
275
    ///   the output function.</remarks>
276
    class procedure Binary; static;
277

278
    /// <summary>Sets the global numeric base for big integers to 8.</summary>
279
    /// <remarks>The global numeric base is used for input or output if there is no override in the input string or
280
    ///   the output function.</remarks>
281
    class procedure Octal; static;
282

283

284
    // -- String input functions --
285

286
    /// <summary>Tries to parse the specified string into a valid BigInteger value in the specified numeric base. Returns False if this failed.</summary>
287
    /// <param name="S">The string that represents a big integer value in the specified numeric base.</param>
288
    /// <param name="Base">The numeric base that is assumed when parsing the string. Valid values are 2..36.</param>
289
    /// <param name="Res">The resulting BigInteger, if the parsing succeeds. Res is undefined if the parsing fails.</param>
290
    /// <returns>Returns True if S could be parsed into a valid BigInteger in Res. Returns False on failure.</returns>
291
    class function TryParse(const S: string; Base: TNumberBase; out Res: BigInteger): Boolean; overload; static;
292

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

301
    /// <summary>Tries to parse the specified string into a valid BigInteger value in the default BigInteger numeric base.</summary>
302
    /// <param name="S">The string that represents a big integer value in the default numeric base, unless
303
    ///   specified otherwise. See <see cref="BigInteger.Base" /></param>
304
    /// <param name="Res">The resulting BigInteger, if the parsing succeeds. Res is undefined if the parsing fails.</param>
305
    /// <returns>Returns True if S could be parsed into a valid BigInteger in Res. Returns False on failure.</returns>
306
    /// <remarks>
307
    ///   <para>To make it easier to increase the legibility of large numbers, any '_' in the numeric string will completely be ignored, so
308
    ///     '1_000_000_000' is exactly equivalent to '1000000000'.</para>
309
    ///   <para>The string to be parsed is considered case insensitive, so '$ABC' and '$abc' represent exactly the same value.</para>
310
    ///   <para>The format of a string to be parsed is as follows:</para>
311
    ///   <para><c>[sign][base override]digits</c></para>
312
    ///   <para>
313
    ///     <param name="sign">This can either be '-' or '+'. It will make the BigInteger negative or positive, respectively.
314
    ///     If no sign is specified, a positive BigInteger is generated.</param>
315
    ///     <param name="base override">There are several ways to override the default numeric base.<para>Specifying '0x' or '$' here will cause the
316
    ///     string to be interpreted as representing a hexadecimal (base 16) value.</para><para>Specifying '0b' will cause it to be interpreted as
317
    ///     binary (base 2).</para><para>Specifying '0d' will cause it to be interpreted as
318
    ///     decimal (base 10).</para>
319
    ///     <para>Specifying '0o' or '0k' will cause it to be interpreted as octal (base 8).</para><para>Finally, to specify any base,
320
    ///     using an override in the format '%nnR' (R for radix) will cause the number to be interpreted to be in base 'nn', where 'nn' represent one or two
321
    ///     decimal digits. So '%36rRudyVelthuis' is a valid BigInteger value with base 36.</para></param>
322
    ///   </para>
323
    /// </remarks>
324
    class function TryParse(const S: string; out Res: BigInteger; aBase : Integer): Boolean; overload; static;
325

326
    /// <summary>Parses the specified string into a BigInteger, using the default numeric base.</summary>
327
    class function Parse(const S: string; aBase : Integer): BigInteger; static;
328

329

330
    // -- Sign related functions --
331

332
    /// <summary>Returns True if the BigInteger is zero.</summary>
333
    function IsZero: Boolean; inline;
334

335
    /// <summary>Returns True if the BigInteger is negative (&lt; 0).</summary>
336
    function IsNegative: Boolean; inline;
337

338
    /// <summary>Returns True if the BigInteger is positive (&gt; 0).</summary>
339
    function IsPositive: Boolean; inline;
340

341
    /// <summary>Returns True if the BigInteger is even (0 is considered even too).</summary>
342
    function IsEven: Boolean; inline;
343

344
    /// <summary>Returns True if the magnitude of the BigInteger value is exactly a power of two.</summary>
345
    function IsPowerOfTwo: Boolean;
346

347
    /// <summary>Returns True if the BigInteger represents a value of 1.</summary>
348
    function IsOne: Boolean;
349

350
    // Bit fiddling
351

352
    // TODO: Should have two's complement semantics.
353
    function TestBit(Index: Integer): Boolean;
354
    function SetBit(Index: Integer): BigInteger;
355
    function ClearBit(Index: Integer): BigInteger;
356
    function FlipBit(Index: Integer): BigInteger;
357

358
    // String output functions
359

360
    /// <summary>Returns the string interpretation of the specified BigInteger in the default numeric base, see <see cref="BigInteger.Base" />.</summary>
361
    function ToString: string; overload;
362

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

366
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 10. Equivalent
367
    ///   to ToString(10).</summary>
368
    function ToDecimalString: string;
369

370
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 16. Equivalent
371
    ///   to ToString(16).</summary>
372
    function ToHexString: string;
373

374
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 2. Equivalent
375
    ///   to ToString(2).</summary>
376
    function ToBinaryString: string;
377

378
    /// <summary>Returns the string interpretation of the specified BigInteger in numeric base 8. Equivalent
379
    ///   to ToString(8).</summary>
380
    function ToOctalString: string;
381

382
    procedure FromString(const Value: string; aBase : Integer);
383

384

385
    // -- Arithmetic operators --
386

387
    /// <summary>Adds two BigIntegers.</summary>
388
    class operator Add(const Left, Right: BigInteger): BigInteger;
389

390
    /// <summary>Subtracts the second BigInteger from the first.</summary>
391
    class operator Subtract(const Left, Right: BigInteger): BigInteger;
392

393
    /// <summary>Multiplies two BigIntegers.</summary>
394
    class operator Multiply(const Left, Right: BigInteger): BigInteger;
395

396
    /// <summary>Multiplies the specified BigInteger with the specified Word value.</summary>
397
    class operator Multiply(const Left: BigInteger; Right: Word): BigInteger; inline;
398

399
    /// <summary>multiplies the specified Wirdvalue with the specified BigInteger.</summary>
400
    class operator Multiply(Left: Word; const Right: BigInteger): BigInteger; inline;
401

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

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

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

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

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

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

420
    /// <summary>Unary minus. Negates the value of the specified BigInteger.</summary>
421
    class operator Negative(const Int: BigInteger): BigInteger;
422

423
    /// <summary>Increment. Adds 1 to the value of the specified BigInteger very fast.</summary>
424
    class operator Inc(const Int: BigInteger): BigInteger;
425

426
    /// <summary>Decrement. Subtracts 1 from the value of the specified BigInteger very fast.</summary>
427
    class operator Dec(const Int: BigInteger): BigInteger;
428

429

430
    // -- Logical and bitwise operators --
431

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

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

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

444
    /// <summary>Returns the result of the bitwise NOT operation on its BigInteger operand. The result
445
    /// has two's complement semantics, e.g. 'not 1' returns '-2'.</summary>
446
    class operator LogicalNot(const Int: BigInteger): BigInteger;
447

448

449
    // -- Shift operators --
450

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

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

464

465
    // -- Comparison operators --
466

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

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

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

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

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

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

485

486
    // -- Implicit conversion operators --
487

488
    /// <summary>Implicitly (i.e. without a cast) converts the specified Integer to a BigInteger.</summary>
489
    class operator Implicit(const Int: Integer): BigInteger;
490

491
    /// <summary>Implicitly (i.e. without a cast) converts the specified Cardinal to a BigInteger.</summary>
492
    class operator Implicit(const Int: Cardinal): BigInteger;
493

494
    /// <summary>Implicitly (i.e. without a cast) converts the specified Int64 to a BigInteger.</summary>
495
    class operator Implicit(const Int: Int64): BigInteger;
496

497
    /// <summary>Implicitly (i.e. without a cast) converts the specified UInt64 to a BigInteger.</summary>
498
    class operator Implicit(const Int: UInt64): BigInteger;
499

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

504

505
    // -- Explicit conversion operators --
506

507
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an Integer. If necessary, the
508
    ///   value of the BigInteger is truncated or sign-extended to fit in the result.</summary>
509
    class operator Explicit(const Int: BigInteger): Integer;
510

511
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a Cardinal. If necessary, the
512
    ///   value of the BigInteger is truncated to fit in the result.</summary>
513
    class operator Explicit(const Int: BigInteger): Cardinal;
514

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

519
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to an UInt64. If necessary, the
520
    ///   value of the BigInteger is truncated to fit in the result.</summary>
521
    class operator Explicit(const Int: BigInteger): UInt64;
522

523
    /// <summary>Explicitly (i.e. with a cast) converts the specified BigInteger to a Double.</summary>
524
    class operator Explicit(const Int: BigInteger): Double;
525

526
    /// <summary>Explicitly (i.e. with a cast) converts the specified Double to a BigInteger.</summary>
527
    class operator Explicit(const ADouble: Double): BigInteger;
528

529

530
    // -- Conversion functions --
531

532
    /// <summary>Converts the specified BigInteger to a Double, if this is possible. Returns an exception if the
533
    ///   value of the BigInteger is too large.</summary>
534
    function AsDouble: Double;
535

536
    /// <summary>Converts the specified BigInteger to an Integer, if this is possible. Returns an exception if the
537
    ///   value of the BigInteger is too large.</summary>
538
    function AsInteger: Integer;
539

540
    /// <summary>Converts the specified BigInteger to a Cardinal, if this is possible. Returns an exception if the
541
    ///   value of the BigInteger is too large or is negative.</summary>
542
    function AsCardinal: Cardinal;
543

544
    /// <summary>Converts the specified BigInteger to an Int64, if this is possible. Returns an exception if the
545
    ///   value of the BigInteger is too large.</summary>
546
    function AsInt64: Int64;
547

548
    /// <summary>Converts the specified BigInteger to a UInt64, if this is possible. Returns an exception if the
549
    ///   value of the BigInteger is too large or is negative.</summary>
550
    function AsUInt64: UInt64;
551

552

553
    // -- Operators as functions --
554

555
    /// <summary>The function equivalent to the operator '+'.</summary>
556
    class function Add(const Left, Right: BigInteger): BigInteger; overload; static;
557

558
    /// <summary>The function equivalent to the operator '-'.</summary>
559
    class function Subtract(const Left, Right: BigInteger): BigInteger; overload; static;
560

561
    /// <summary>The function equivalent to the operator '*'.</summary>
562
    class function Multiply(const Left, Right: BigInteger): BigInteger; overload; static;
563
    class function MultiplyThreshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger; static;
564
    class function MultiplyBaseCase(const Left, Right: BigInteger): BigInteger; static;
565

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

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

574
    /// <summary>Recursive "schoolbook" division, as described by Burnikel and Ziegler. Faster than
575
    /// <see cref="DivModBaseCase" />, but with more overhead, so should only be applied for larger BigIntegers.</summary>
576
    class procedure DivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger); static;
577

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

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

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

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

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

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

599
    class function MultiplyKaratsuba(const Left, Right: BigInteger): BigInteger; static;
600
    class function MultiplyToomCook3(const Left, Right: BigInteger): BigInteger; static;
601

602
    class function SqrKaratsuba(const Value: BigInteger): BigInteger; static;
603

604
  {$IFDEF Experimental}
605
    class function MultiplyKaratsubaThreshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger; static;
606
    class function MultiplyToomCook3Threshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger; static;
607
    class function SqrKaratsubaThreshold(const Value: BigInteger; Threshold: Integer): BigInteger; static;
608
  {$ENDIF Experimental}
609

610

611
    // -- Self-referential operator functions --
612

613
    /// <summary>
614
    ///   <para>The functional equivalent to</para>
615
    ///   <code>    A := A + Other;</code>
616
    ///   <para>This can be chained, as the function returns a pointer to itself:</para>
617
    ///   <code>    A.Add(First).Add(Second);</code></summary>
618
    /// <remarks><para>This was added in the hope to gain speed by avoiding some allocations.
619
    ///   This is not so, although a longer chain seems to improve performance, compared to normal addition
620
    ///   using operators, a bit.</para></remarks>
621
    function Add(const Other: BigInteger): PBigInteger; overload;
622

623
    /// <summary>The functional equivalent to Self := Self + Other;</summary>
624
    function Subtract(const Other: BigInteger): PBigInteger; overload;
625

626
    /// <summary>The functional equivalent to Self := Self div Other;</summary>
627
    function Divide(const Other: BigInteger): PBigInteger; overload;
628

629
    /// <summary>The functional equivalent to Self := Self mod Other;</summary>
630
    function Remainder(const Other: BigInteger): PBigInteger; overload;
631

632
    /// <summar>The functional equivalent to Self := Self * Other;</summary>
633
    function Multiply(const Other: BigInteger): PBigInteger; overload;
634

635

636
    // -- Math functions --
637

638
    /// <summary>Returns the absolute value of the value in the BigInteger.</summary>
639
    class function Abs(const Int: BigInteger): BigInteger; static;
640

641
    /// <summary>Returns the bit length, the minimum number of bits needed to represent the value, excluding
642
    ///   the sign bit.</summary>
643
    function BitLength: Integer;
644

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

649
    /// <summary>Returns a copy of the current BigInteger, with a unique copy of the data.</summary>
650
    function Clone: BigInteger;
651

652
    /// <summary>Returns +1 if the value in Left is greater than the value in Right, 0 if they are equal and
653
    ///   1 if it is lesser.</summary>
654
    class function Compare(const Left, Right: BigInteger): TValueSign; static;
655

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

659
    /// <summary>Returns the natural logarithm of the value in Int.</summary>
660
    class function Ln(const Int: BigInteger): Double; static;
661

662
    /// <summary>Returns the logarithm to the specified base of the value in Int.</summary>
663
    class function Log(const Int: BigInteger; Base: Double): Double; static;
664

665
    /// <summary>Returns the logarithm to base 2 of the value in Int.</summary>
666
    class function Log2(const Int: BigInteger): Double; static;
667

668
    /// <summary>Returns the logarithm to base 10 of the value in Int.</summary>
669
    class function Log10(const Int: BigInteger): Double; static;
670

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

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

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

680
    /// <summary>Returns the specified value raised to the specified power.</summary>
681
    class function Pow(const ABase: BigInteger; AExponent: Integer): BigInteger; static;
682

683
    /// <summary>Returns the nth root R of a BigInteger such that R^Nth <= Radicand <= (R+1)^Nth.</summary>
684
    class function NthRoot(const Radicand: BigInteger; Nth: Integer): BigInteger; static;
685

686
    /// <summary>If R is the nth root of Radicand, returns Radicand - R^Nth.</summary>
687
    class procedure NthRootRemainder(const Radicand: BigInteger; Nth: Integer; var Root, Remainder: BigInteger); static;
688

689
    /// <summary> Returns the square root R of Radicand, such that R^2 < Radicand < (R+1)^2</summary>
690
    class function Sqrt(const Radicand: BigInteger): BigInteger; static;
691

692
    /// <summary>If R is the square root of Radicand, returns Radicand - R^2.</summary>
693
    class procedure SqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger); static;
694

695
    class function Sqr(const Value: BigInteger): BigInteger; static;
696

697

698
    // -- Utility functions --
699

700
    /// <summary>Sets whether partial-flags stall must be avoided with modified routines.</summary>
701
    /// <remarks>USING THE WRONG SETTING MAY AFFECT THE TIMING OF CERTAIN ROUTINES CONSIDERABLY, SO USE THIS WITH EXTREME CARE!
702
    ///   The unit is usually able to determine the right settings automatically.</remarks>
703
    class procedure AvoidPartialFlagsStall(Value: Boolean); static;
704

705
    // -- Array function(s) --
706

707
    /// <summary>Converts a BigInteger value to a byte array.</summary>
708
    /// <returns><para>A TArray&lt;Byte&gt;, see remarks.</para></returns>
709
    /// <remarks>
710
    ///   <para>The individual bytes in the array returned by this method appear in little-endian order.</para>
711
    ///   <para>Negative values are written to the array using two's complement representation in the most compact
712
    ///   form possible. For example, -1 is represented as a single byte whose value is $FF instead of as an array
713
    ///   with multiple elements, such as $FF, $FF or $FF, $FF, $FF, $FF.</para>
714
    ///   <para>Because two's complement representation always interprets the highest-order bit of the last byte in
715
    ///   the array (the byte at position High(Array)) as the sign bit, the method returns a byte array with
716
    ///   an extra element whose value is zero to disambiguate positive values that could otherwise be interpreted
717
    ///   as having their sign bits set. For example, the value 120 or $78 is represented as a single-byte array:
718
    ///   $78. However, 129, or $81, is represented as a two-byte array: $81, $00. Something similar applies to
719
    ///   negative values: -179 (or -$B3) must be represented as $4D, $FF.</para>
720
    /// </remarks>
721
    function ToByteArray: TArray<Byte>;
722
    function GetAllocated: Integer;
723
    function GetSize: Integer; inline;
724
    function Data: PLimb; inline;
725
    function GetSign: Integer; inline;
726
    procedure SetSign(Value: Integer); inline;
727
  {$ENDREGION}
728

729
  private
730
  {$REGION 'private constants, types and variables'}
731
    type
732
      TErrorCode = (ecParse, ecDivbyZero, ecConversion, ecInvalidArg, ecOverflow, ecInvalidArgument);
733
      TClearData = (cdClearData, cdKeepData);
734
      TDyadicOperator = procedure(Left, Right, Result: PLimb; LSize, RSize: Integer);
735
    var
736
      FData: TMagnitude;                        // The limbs of the magnitude, least significant limb at lowest address.
737
      FSize: Integer;                           // The top bit is the sign of the big integer. Rest is the number of valid limbs of the big integer.
738
    class var
739
      FBase: TNumberBase;
740
      FAvoidStall: Boolean;
741
      FRoundingMode: TRoundingMode;
742
      FInternalAdd: TDyadicOperator;
743
      FInternalSubtract: TDyadicOperator;
744
  {$ENDREGION}
745

746
  {$REGION 'private functions'}
747
  {$IFNDEF PUREPASCAL}
748
    class procedure DetectPartialFlagsStall; static;
749
    class procedure InternalAddModified(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
750
    class procedure InternalAddPlain(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
751
    class procedure InternalSubtractModified(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
752
    class procedure InternalSubtractPlain(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
753
    class procedure InternalDivideBy3(Value, Result: PLimb; ASize: Integer); static;
754
  {$ELSE}
755
    class procedure InternalAddPurePascal(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
756
    class procedure InternalSubtractPurePascal(Larger, Smaller, Result: PLimb; LSize, SSize: Integer); static;
757
  {$ENDIF}
758
    class function InternalCompare(Left, Right: PLimb; LSize, RSize: Integer): TValueSign; static;
759
    class procedure InternalAnd(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
760
    class procedure InternalOr(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
761
    class procedure InternalXor(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
762
    class procedure InternalAndNot(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
763
    class procedure InternalNotAnd(Left, Right, Result: PLimb; LSize, RSize: Integer); static; inline;
764
    class procedure InternalBitwise(const Left, Right: BigInteger; var Result: BigInteger; PlainOp, OppositeOp, InversionOp: TDyadicOperator); static;
765
    class procedure InternalIncrement(Limbs: PLimb; Size: Integer); static;
766
    class procedure InternalDecrement(Limbs: PLimb; Size: Integer); static;
767
    class procedure InternalShiftLeft(Source, Dest: PLimb; Shift, Size: Integer); static;
768
    class procedure InternalShiftRight(Source, Dest: PLimb; Shift, Size: Integer); static;
769
    class function InternalDivMod(Dividend, Divisor, Quotient, Remainder: PLimb; LSize, RSize: Integer): Boolean; static;
770
    class function InternalDivMod32(Dividend: PLimb; Divisor: UInt32; Quotient, Remainder: PLimb; LSize: Integer): Boolean; static;
771
    class function InternalDivMod16(Dividend: PLimb; Divisor: UInt16; Quotient, Remainder: PLimb; LSize: Integer): Boolean; static;
772
    class procedure InternalMultiply(Left, Right, Result: PLimb; LSize, RSize: Integer); static;
773
//    class function InternalCompareMagnitudes(Left, Right: PLimb; LSize, RSize: Integer): TValueSign; static;
774
    class function InternalDivideByBase(Mag: PLimb; Base: Integer; var Size: Integer): UInt32; static;
775
    class procedure InternalMultiplyAndAdd(const Multiplicand: TMagnitude; Multiplicator, Addend: Word; const Res: TMagnitude); static;
776
    class procedure InternalNegate(Source, Dest: PLimb; Size: Integer); static;
777
    class function DivideBy3Exactly(const A: BigInteger): BigInteger; static;
778
    class procedure InternalDivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger); static;
779
    class procedure DivThreeHalvesByTwo(const LeftUpperMid, LeftLower, Right, RightUpper, RightLower: BigInteger; N: Integer; var Quotient, Remainder: BigInteger); static;
780
    class procedure DivTwoDigitsByOne(const Left, Right: BigInteger; N: Integer; var Quotient, Remainder: BigInteger); static;
781

782
    procedure AddWithOffset(const Addend: BigInteger; Offset: Integer);
783
    function Split(BlockSize, BlockCount: Integer): TArray<BigInteger>;
784

785
    class procedure SetBase(const Value: TNumberBase); static;
786
    class procedure Error(ErrorCode: TErrorCode; const ErrorInfo: string = ''); static;
787

788
    procedure Compact;
789
    procedure EnsureSize(RequiredSize: Integer);
790
    procedure MakeSize(RequiredSize: Integer);
791
  {$ENDREGION}
792

793
  public
794
  {$REGION 'public properties'}
795
    property Size: Integer read GetSize;
796
    property Allocated: Integer read GetAllocated;
797
    property Negative: Boolean read IsNegative;
798
    property Sign: Integer read GetSign write SetSign;
799
    property Magnitude: TMagnitude read FData;
800

801
    // -- Global numeric base for BigIntegers --
802

803
    class property Base: TNumberBase read FBase write SetBase;
804
    class property StallAvoided: Boolean read FAvoidStall;
805
    class property RoundingMode: TRoundingMode read FRoundingMode write FRoundingMode;
806
  {$ENDREGION}
807

808
  end;
809

810
function SignBitOf(Int: Integer): Integer; inline;
811

812
function Min(const A, B: BigInteger): BigInteger; overload; inline;
813
function Max(const A, B: BigInteger): BigInteger; overload; inline;
814

815
//var
816
//  DoDebug: Boolean = True;
817

818
implementation
819

820
// To switch PUREPASCAL for debug purposes. UNDEF PUREPASCAL before the routine and DEFINE PUREPASCAL after the routine, if PP was defined.
821
{$IFDEF PUREPASCAL}
822
{$DEFINE PP}
823
{$ENDIF}
824

825
// Copy the following around the routine for which you want to switch off PUREPASCAL
826

827
{$UNDEF PUREPASCAL}
828
// Routine here.
829
{$IFDEF PP}
830
{$DEFINE PUREPASCAL}
831
{$ENDIF}
832

833
uses
834
{$IFDEF DEBUG}
835
  Winapi.Windows,
836
{$ENDIF}
837
  Velthuis.Sizes, Velthuis.Numerics;
838

839
{$POINTERMATH ON}
840

841
{$IFDEF DEBUG}
842
function Join(const Delimiter: string; const Values: array of string): string;
843
var
844
  I: Integer;
845
begin
846
  if Length(Values) > 0 then
847
  begin
848
    Result := Values[0];
849
    for I := 1 to High(Values) do
850
      Result := Delimiter + Result;
851
  end;
852
end;
853

854
function DumpPLimb(P: PLimb; Size: Integer): string;
855
var
856
  SL: TArray<string>;
857
  I: Integer;
858
begin
859
  Result := '';
860
  SetLength(SL, Size);
861
  for I := 0 to Size - 1 do
862
    SL[I] := Format('%.8x', [P[Size - I - 1]]);
863
  Result := Result + Join(' ', SL);
864
end;
865

866
procedure Debug(const Msg: string; const Params: array of const); overload;
867
begin
868
  if not DoDebug then
869
    Exit;
870

871
  if IsConsole then
872
    // Write to console.
873
    Writeln(System.ErrOutput, Format(Msg, Params))
874
  else
875
    // Inside the IDE, this will be displayed in the Event Log.
876
    OutputDebugString(PChar(Format(Msg, Params)));
877
end;
878

879
procedure Debug(const Msg: string); overload;
880
begin
881
  Debug(Msg, []);
882
end;
883
{$ELSE}
884
procedure Debug(const Msg: string; const Params: array of const);
885
begin
886
end;
887
{$ENDIF}
888

889
const
890
  CTimingLoops = $40000;
891

892
{$IFNDEF PUREPASCAL}
893
procedure Timing(var T1, T2, T3: UInt64); stdcall;
894
{$IFDEF WIN32}
895
asm
896
        RDTSC
897
        MOV     ECX,T1
898
        MOV     DWORD PTR [ECX],EAX
899
        MOV     DWORD PTR [ECX+4],EDX
900
        XOR     EAX,EAX
901
        MOV     EDX,CTimingLoops
902

903
@ADCLoop:
904

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

909
        RDTSC
910
        MOV     ECX,T2
911
        MOV     [ECX],EAX
912
        MOV     [ECX+4],EDX
913
        XOR     EAX,EAX
914
        MOV     EDX,CTimingLoops
915
        NOP
916

917
@ADDLoop:
918

919
        ADD     EAX,[ECX]       // ADD does not read carry flag, so no partial-flags stall.
920
        DEC     EDX
921
        JNE     @ADDLoop
922

923
        RDTSC
924
        MOV     ECX,T3
925
        MOV     [ECX],EAX
926
        MOV     [ECX+4],EDX
927
end;
928
{$ELSE}
929
asm
930
        MOV     R9,RDX
931
        RDTSC
932
        MOV     [RCX],EAX
933
        MOV     [RCX+4],EDX
934
        XOR     EAX,EAX
935
        MOV     EDX,CTimingLoops
936

937
@ADCLoop:
938

939
        ADC     EAX,[RCX]
940
        DEC     EDX
941
        JNE     @ADCLoop
942

943
        RDTSC
944
        MOV     [R9],EAX
945
        MOV     [R9+4],EDX
946
        XOR     EAX,EAX
947
        MOV     EDX,CTimingLoops
948
        NOP
949

950
@ADDLoop:
951

952
        ADD     EAX,[RCX]
953
        DEC     EDX
954
        JNE     @ADDLoop
955

956
        RDTSC
957
        MOV     [R8],EAX
958
        MOV     [R8+4],EDX
959
end;
960
{$ENDIF}
961

962
class procedure BigInteger.DetectPartialFlagsStall;
963
var
964
  T1, T2, T3: UInt64;
965
  I1, I2: UInt64;
966
begin
967
  Randomize;
968
  repeat
969
    Timing(T1, T2, T3);
970
    I1 := T2 - T1;
971
    I2 := T3 - T2;
972
    Debug('Timing: %d / %d = %.2f', [I1, I2, I1 / I2]);
973

974
    // Make sure timings are far enough apart. Repeat if in "grey area" inbetween.
975
    if I1 / I2 > 4.0 then
976
    begin
977
      AvoidPartialFlagsStall(True);
978
      Exit;
979
    end
980
    else if I1 / I2 < 2.0 then
981
    begin
982
      AvoidPartialFlagsStall(False);
983
      Exit;
984
    end;
985
  until False;
986
end;
987
{$ENDIF !PUREPASCAL}
988

989
procedure DivMod64(Dividend: UInt64; Divisor: UInt64;
990
  var Result, Remainder: UInt64); overload;
991
{$IF DEFINED(CPUX64) and NOT DEFINED(PUREPASCAL_X64)}
992
asm
993
        MOV     R10,RDX
994
        MOV     RAX,RCX
995
        XOR     EDX,EDX
996
        DIV     R10
997
        MOV     [R8],RAX
998
        MOV     [R9],RDX
999
end;
1000
{$ELSE}
1001
// Merged from system __lludiv and __llumod
1002
asm
1003
        PUSH    EBX
1004
        PUSH    ESI
1005
        PUSH    EDI
1006
        PUSH    EAX
1007
        PUSH    EDX
1008
//
1009
//       Now the stack looks something like this:
1010
//
1011
//               40[esp]: Dividend(high dword)
1012
//               36[esp]: Dividend(low dword)
1013
//               32[esp]: divisor (high dword)
1014
//               28[esp]: divisor (low dword)
1015
//               24[esp]: return EIP
1016
//               20[esp]: previous EBP
1017
//               16[esp]: previous EBX
1018
//               12[esp]: previous ESI
1019
//                8[esp]: previous EDI
1020
//                4[esp]: previous EAX  Result ptr
1021
//                 [esp]: previous EDX  Remainder ptr
1022
//
1023
        MOV     EBX,28[ESP]             // get the divisor low word
1024
        MOV     ECX,32[ESP]             // get the divisor high word
1025
        MOV     EAX,36[ESP]             // get the dividend low word
1026
        MOV     EDX,40[ESP]             // get the dividend high word
1027

1028
        OR      ECX,ECX
1029
        JNZ     @DivMod64@slow_ldiv     // both high words are zero
1030

1031
        OR      EDX,EDX
1032
        JZ      @DivMod64@quick_ldiv
1033

1034
        OR      EBX,EBX
1035
        JZ      @DivMod64@quick_ldiv    // if ecx:ebx == 0 force a zero divide
1036
          // we don't expect this to actually
1037
          // work
1038
@DivMod64@slow_ldiv:
1039
        MOV     EBP,ECX
1040
        MOV     ECX,64                  // shift counter
1041
        XOR     EDI,EDI                 // fake a 64 bit dividend
1042
        XOR     ESI,ESI                 //
1043

1044
@DivMod64@xloop:
1045
        SHL     EAX,1                   // shift dividend left one bit
1046
        RCL     EDX,1
1047
        RCL     ESI,1
1048
        RCL     EDI,1
1049
        CMP     EDI,EBP                 // dividend larger?
1050
        JB      @DivMod64@nosub
1051
        JA      @DivMod64@subtract
1052
        CMP     ESI,EBX                 // maybe
1053
        JB      @DivMod64@nosub
1054

1055
@DivMod64@subtract:
1056
        SUB     ESI,EBX
1057
        SBB     EDI,EBP                 // subtract the divisor
1058
        INC     EAX                     // build quotient
1059

1060
@DivMod64@nosub:
1061
        LOOP    @DivMod64@xloop
1062
//
1063
//       When done with the loop the four registers values' look like:
1064
//
1065
//       |     edi    |    esi     |    edx     |    eax     |
1066
//       |        remainder        |         quotient        |
1067
//
1068
        JMP     @DivMod64@finish
1069

1070
@DivMod64@quick_ldiv:
1071
        DIV     EBX                     // unsigned divide
1072
        MOV     ESI,EDX
1073
        XOR     EDX,EDX
1074
        XOR     EDI,EDI
1075

1076
@DivMod64@finish:
1077
        POP     EBX
1078
        POP     ECX
1079
        MOV     [EBX],ESI
1080
        MOV     [EBX+4],EDI
1081
        MOV     [ECX],EAX
1082
        MOV     [ECX+4],EDX
1083

1084
        POP     EDI
1085
        POP     ESI
1086
        POP     EBX
1087
end;
1088
{$ifend}
1089
(*
1090
begin
1091
  Result := Dividend div Divisor;
1092
  Remainder := Dividend mod Divisor;
1093
end;
1094
*)
1095

1096
resourcestring
1097
  SErrorBigIntegerParsing = '''%s'' is not a valid big integer value';
1098
  SDivisionByZero         = 'Division by zero';
1099
  SInvalidOperation       = 'Invalid operation';
1100
  SConversionFailed       = 'BigInteger value too large for conversion to %s';
1101
  SOverflow               = 'Double parameter may not be NaN or +/- Infinity';
1102
  SInvalidArgumentBase    = 'Base parameter must be in the range 2..36.';
1103
  SSqrtBigInteger         = 'Negative values not allowed for Sqrt';
1104

1105
{$RANGECHECKS OFF}
1106
{$OVERFLOWCHECKS OFF}
1107
{$POINTERMATH ON}
1108
{$STACKFRAMES OFF}
1109

1110
type
1111
  TUInt64 = record
1112
    Lo, Hi: UInt32;
1113
  end;
1114

1115
const
1116
  // Size of a single limb, used in e.g. asm blocks.
1117
  CLimbSize = SizeOf(TLimb);
1118

1119
  // Double limb, for 64 bit access
1120
  DLimbSize = 2 * CLimbSize;
1121

1122
  // Array mapping a digit in a specified base to its textual representation.
1123
  CBaseChars: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
1124
  CNumBase = Ord('0');
1125
  CAlphaBase = Ord('A');
1126

1127
  // Array mapping a specified base to the maximum number of digits required to represent one limb in that base.
1128
  // They map a specified base to Ceil(32 / Log2(base)).
1129
  CStringMaxLengths: array[TNumberBase] of Integer =
1130
  (
1131
    32, 21, 16, 14, 13, 12, 11,
1132
    11, 10, 10,  9,  9,  9,  9,
1133
     8,  8,  8,  8,  8,  8,  8,
1134
     8,  7,  7,  7,  7,  7,  7,
1135
     7,  7,  7,  7,  7,  7,  7
1136
  );
1137

1138
  CStringMinLengths: array[TNumberBase] of Integer =
1139
  (
1140
    32, 20, 16, 13, 12, 11, 10,
1141
    10,  9,  9,  8,  8,  8,  8,
1142
     8,  7,  7,  7,  7,  7,  7,
1143
     7,  6,  6,  6,  6,  6,  6,
1144
     6,  6,  6,  6,  6,  6,  6
1145
  );
1146

1147
  // Various useful sizes and bitcounts.
1148
  CLimbBits     = CByteBits * CLimbSize;
1149
  CLimbWords    = CLimbSize div SizeOf(Word);
1150
  CUInt64Limbs  = SizeOf(UInt64) div CLimbSize;
1151
  CInt64Limbs   = SizeOf(Int64) div CLimbSize;
1152

1153
function IntMax(Left, Right: UInt32): UInt32;
1154
{$IFNDEF PUREPASCAL}
1155
{$IFDEF WIN32}
1156
asm
1157
        CMP    EAX,EDX
1158
        CMOVB  EAX,EDX
1159
end;
1160
{$ELSE WIN64}
1161
asm
1162
        MOV    EAX,ECX
1163
        CMP    EAX,EDX
1164
        CMOVB  EAX,EDX
1165
end;
1166
{$ENDIF}
1167
{$ELSE}
1168
begin
1169
  Result := Left;
1170
  if Left < Right then
1171
    Result := Right;
1172
end;
1173
{$ENDIF}
1174

1175
function IntMin(Left, Right: UInt32): UInt32;
1176
{$IFNDEF PUREPASCAL}
1177
{$IFDEF WIN32}
1178
asm
1179
        CMP    EAX,EDX
1180
        CMOVA  EAX,EDX
1181
end;
1182
{$ELSE WIN64}
1183
asm
1184
        MOV    EAX,ECX
1185
        CMP    EAX,EDX
1186
        CMOVA  EAX,EDX
1187
end;
1188
{$ENDIF}
1189
{$ELSE}
1190
begin
1191
  Result := Left;
1192
  if Left > Right then
1193
    Result := Right;
1194
end;
1195
{$ENDIF}
1196

1197
function ShouldUseBurnikelZiegler(LSize, RSize: Integer): Boolean; inline;
1198
begin
1199
  // http://mail.openjdk.java.net/pipermail/core-libs-dev/2013-November/023493.html
1200
  Result := (RSize >= BigInteger.BurnikelZieglerThreshold) and
1201
            ((LSize - RSize) >= BigInteger.BurnikelZieglerOffsetThreshold);
1202
end;
1203

1204
function SizeBitsOf(Int: Integer): Integer; inline;
1205
begin
1206
  Result := Int and BigInteger.SizeMask;
1207
end;
1208

1209
function SignBitOf(Int: Integer): Integer; inline;
1210
begin
1211
  Result := Int and BigInteger.SignMask;
1212
end;
1213

1214
function Min(const A, B: BigInteger): BigInteger; inline;
1215
begin
1216
  Result := BigInteger.Min(A, B);
1217
end;
1218

1219
function Max(const A, B: BigInteger): BigInteger; inline;
1220
begin
1221
  Result := BigInteger.Max(A, B);
1222
end;
1223

1224
function GreaterSize(Left, Right: Integer): Integer; inline;
1225
begin
1226
  Result := IntMax(SizeBitsOf(Left), SizeBitsOf(Right));
1227
end;
1228

1229
function LesserSize(Left, Right: Integer): Integer; inline;
1230
begin
1231
  Result := IntMin(SizeBitsOf(Left), SizeBitsOf(Right));
1232
end;
1233

1234
function AllocLimbs(Size: Integer): PLimb; inline;
1235
begin
1236
  GetMem(Result, Size * CLimbSize);
1237
end;
1238

1239
procedure CopyLimbs(Src, Dest: PLimb; Count: Integer); inline;
1240
begin
1241
  Move(Src^, Dest^, Count * CLimbSize);
1242
end;
1243

1244
{ TBigInteger }
1245

1246
procedure ShallowCopy(const Value: BigInteger; var Result: BigInteger); inline;
1247
begin
1248
  Result.FSize := Value.FSize;
1249
  Result.FData := Value.FData;
1250
end;
1251

1252
procedure DeepCopy(const Value: BigInteger; var Result: BigInteger); inline;
1253
begin
1254
  Result.FSize := Value.FSize;
1255
  Result.FData := Copy(Value.FData);
1256
end;
1257

1258
class function BigInteger.Abs(const Int: BigInteger): BigInteger;
1259
begin
1260
  ShallowCopy(Int, Result);
1261
  Result.SetSign(0);
1262
end;
1263

1264
class function BigInteger.Add(const Left, Right: BigInteger): BigInteger;
1265
var
1266
  Res: BigInteger;
1267
  LSize, RSize: Integer;
1268
  SignBit: Integer;
1269
  Comparison: TValueSign;
1270
begin
1271
  if Left.FData = nil then
1272
  begin
1273
    ShallowCopy(Right, Result);
1274
    Exit;
1275
  end
1276
  else if Right.FData = nil then
1277
  begin
1278
    ShallowCopy(Left, Result);
1279
    Exit;
1280
  end;
1281

1282
  LSize := SizeBitsOf(Left.FSize);
1283
  RSize := SizeBitsOf(Right.FSize);
1284
  Res.MakeSize(IntMax(LSize, RSize) + 1);
1285

1286
  if ((Left.FSize xor Right.FSize) and SignMask) = 0 then
1287
  begin
1288
    // Same sign: add both magnitudes and transfer sign.
1289
    FInternalAdd(PLimb(Left.FData), PLimb(Right.FData), PLimb(Res.FData), LSize, RSize);
1290
    SignBit := SignBitOf(Left.FSize);
1291
  end
1292
  else
1293
  begin
1294
    Comparison := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), Left.FSize and SizeMask, Right.FSize and SizeMask);
1295
    case Comparison of
1296
      -1: // Left < Right
1297
        begin
1298
          FInternalSubtract(PLimb(Right.FData), PLimb(Left.FData), PLimb(Res.FData), RSize, LSize);
1299
          SignBit := SignBitOf(Right.FSize);
1300
        end;
1301
      1: // Left > Right
1302
        begin
1303
          FInternalSubtract(PLimb(Left.FData), PLimb(Right.FData), PLimb(Res.FData), LSize, RSize);
1304
          SignBit := SignBitOf(Left.FSize);
1305
        end;
1306
      else // Left = Right
1307
        begin
1308
          // Left and Right have equal magnitude but different sign, so return 0.
1309
          ShallowCopy(Zero, Result);
1310
          Exit;
1311
        end;
1312
    end;
1313
  end;
1314
  Res.FSize := (Res.FSize and SizeMask) or SignBit;
1315
  Res.Compact;
1316
  ShallowCopy(Res, Result);
1317
end;
1318

1319
class operator BigInteger.Add(const Left, Right: BigInteger): BigInteger;
1320
begin
1321
  Result := Add(Left, Right);
1322
end;
1323

1324
class procedure BigInteger.Binary;
1325
begin
1326
  FBase := 2;
1327
end;
1328

1329
class procedure BigInteger.InternalAnd(Left, Right, Result: PLimb; LSize, RSize: Integer);
1330
{$IFDEF PUREPASCAL}
1331
var
1332
  I: Integer;
1333
begin
1334
  if LSize < RSize then
1335
    RSize := LSize;
1336
  for I := 0 to RSize - 1 do
1337
    Result[I] := Left[I] and Right[I];
1338
end;
1339
{$ELSE !PUREPASCAL}
1340
{$IFDEF WIN32}
1341
asm
1342
        PUSH    ESI
1343
        PUSH    EDI
1344
        PUSH    EBX
1345

1346
        MOV     EBX,RSize
1347
        MOV     EDI,LSize
1348

1349
        CMP     EDI,EBX
1350
        JAE     @SkipSwap
1351
        XCHG    EBX,EDI
1352
        XCHG    EAX,EDX
1353

1354
@SkipSwap:
1355

1356
        MOV     EDI,EBX
1357
        AND     EDI,CUnrollMask
1358
        SHR     EBX,CUnrollShift
1359
        JE      @MainTail
1360

1361
@MainLoop:
1362

1363
        MOV     ESI,[EAX]
1364
        AND     ESI,[EDX]
1365
        MOV     [ECX],ESI
1366

1367
        MOV     ESI,[EAX + CLimbSize]
1368
        AND     ESI,[EDX + CLimbSize]
1369
        MOV     [ECX + CLimbSize],ESI
1370

1371
        MOV     ESI,[EAX + 2*CLimbSize]
1372
        AND     ESI,[EDX + 2*CLimbSize]
1373
        MOV     [ECX + 2*CLimbSize],ESI
1374

1375
        MOV     ESI,[EAX + 3*CLimbSize]
1376
        AND     ESI,[EDX + 3*CLimbSize]
1377
        MOV     [ECX + 3*CLimbSize],ESI
1378

1379
        LEA     EAX,[EAX + 4*CLimbSize]
1380
        LEA     EDX,[EDX + 4*CLimbSize]
1381
        LEA     ECX,[ECX + 4*CLimbSize]
1382
        DEC     EBX
1383
        JNE     @MainLoop
1384

1385
@MainTail:
1386

1387
        LEA     EAX,[EAX + EDI*CLimbSize]
1388
        LEA     EDX,[EDX + EDI*CLimbSize]
1389
        LEA     ECX,[ECX + EDI*CLimbSize]
1390
        LEA     EBX,[@JumpsMain]
1391
        JMP     [EBX + EDI*TYPE Pointer]
1392

1393
        // Align jump tables manually, with NOPs.
1394

1395
@JumpsMain:
1396

1397
        DD      @Exit
1398
        DD      @Main1
1399
        DD      @Main2
1400
        DD      @Main3
1401

1402
@Main3:
1403

1404
        MOV     ESI,[EAX - 3*CLimbSize]
1405
        AND     ESI,[EDX - 3*CLimbSize]
1406
        MOV     [ECX - 3*CLimbSize],ESI
1407

1408
@Main2:
1409

1410
        MOV     ESI,[EAX - 2*CLimbSize]
1411
        AND     ESI,[EDX - 2*CLimbSize]
1412
        MOV     [ECX - 2*CLimbSize],ESI
1413

1414
@Main1:
1415

1416
        MOV     ESI,[EAX - CLimbSize]
1417
        AND     ESI,[EDX - CLimbSize]
1418
        MOV     [ECX - CLimbSize],ESI
1419

1420
@Exit:
1421

1422
        POP     EBX
1423
        POP     EDI
1424
        POP     ESI
1425
end;
1426
{$ELSE WIN64}
1427
asm
1428
        MOV     R10D,RSize
1429

1430
        CMP     R9D,R10D
1431
        JAE     @SkipSwap
1432
        XCHG    R10D,R9D
1433
        XCHG    RCX,RDX
1434

1435
@SkipSwap:
1436

1437
        MOV     R9D,R10D
1438
        AND     R9D,CUnrollMask
1439
        SHR     R10D,CUnrollShift
1440
        JE      @MainTail
1441

1442
@MainLoop:
1443

1444
        MOV     RAX,[RCX]
1445
        AND     RAX,[RDX]
1446
        MOV     [R8],RAX
1447
        MOV     RAX,[RCX + DLimbSize]
1448
        AND     RAX,[RDX + DLimbSize]
1449
        MOV     [R8 + DLimbSize],RAX
1450
        LEA     RCX,[RCX + 2*DLimbSize]
1451
        LEA     RDX,[RDX + 2*DLimbSize]
1452
        LEA     R8,[R8 + 2*DLimbSize]
1453
        DEC     R10D
1454
        JNE     @MainLoop
1455

1456
@MainTail:
1457

1458
        LEA     RCX,[RCX + R9*CLimbSize]
1459
        LEA     RDX,[RDX + R9*CLimbSize]
1460
        LEA     R8,[R8 + R9*CLimbSize]
1461
        LEA     R10,[@JumpsMain]
1462
        JMP     [R10 + R9*TYPE Pointer]
1463

1464
        // Align jump table manually, with NOPs
1465

1466
        NOP
1467
        NOP
1468
        NOP
1469

1470
@JumpsMain:
1471

1472
        DQ      @Exit
1473
        DQ      @Main1
1474
        DQ      @Main2
1475
        DQ      @Main3
1476

1477
@Main3:
1478

1479
        MOV     EAX,[RCX - 3*CLimbSize]
1480
        AND     EAX,[RDX - 3*CLimbSize]
1481
        MOV     [R8 - 3*CLimbSize],EAX
1482

1483
@Main2:
1484

1485
        MOV     EAX,[RCX - 2*CLimbSize]
1486
        AND     EAX,[RDX - 2*CLimbSize]
1487
        MOV     [R8 - 2*CLimbSize],EAX
1488

1489
@Main1:
1490

1491
        MOV     EAX,[RCX - CLimbSize]
1492
        AND     EAX,[RDX - CLimbSize]
1493
        MOV     [R8 - CLimbSize],EAX
1494

1495
@Exit:
1496

1497
end;
1498
{$ENDIF WIN64}
1499
{$ENDIF !PUREPASCAL}
1500

1501
class procedure BigInteger.InternalXor(Left, Right, Result: PLimb; LSize, RSize: Integer);
1502
{$IFDEF PUREPASCAL}
1503
var
1504
  I: Integer;
1505
  P: PLimb;
1506
begin
1507
  if LSize < RSize then
1508
  begin
1509
    // Swap left and right pointers and sizes.
1510
    I := LSize;
1511
    LSize := RSize;
1512
    RSize := I;
1513
    P := Left;
1514
    Left := Right;
1515
    Right := P;
1516
  end;
1517
  for I := 0 to RSize - 1 do
1518
    Result[I] := Left[I] xor Right[I];
1519
  for I := RSize to LSize - 1 do
1520
    Result[I] := Left[I];
1521
end;
1522
{$ELSE !PUREPASCAL}
1523
{$IFDEF WIN32}
1524
asm
1525
        PUSH    ESI
1526
        PUSH    EDI
1527
        PUSH    EBX
1528

1529
        MOV     EBX,RSize
1530
        MOV     EDI,LSize
1531

1532
        CMP     EDI,EBX
1533
        JAE     @SkipSwap
1534
        XCHG    EBX,EDI
1535
        XCHG    EAX,EDX
1536

1537
@SkipSwap:
1538

1539
        SUB     EDI,EBX
1540
        PUSH    EDI                             // Number of "tail" loops
1541
        MOV     EDI,EBX
1542
        AND     EDI,CUnrollMask
1543
        SHR     EBX,CUnrollShift
1544
        JE      @MainTail
1545

1546
@MainLoop:
1547

1548
        MOV     ESI,[EAX]
1549
        XOR     ESI,[EDX]
1550
        MOV     [ECX],ESI
1551

1552
        MOV     ESI,[EAX + CLimbSize]
1553
        XOR     ESI,[EDX + CLimbSize]
1554
        MOV     [ECX + CLimbSize],ESI
1555

1556
        MOV     ESI,[EAX + 2*CLimbSize]
1557
        XOR     ESI,[EDX + 2*CLimbSize]
1558
        MOV     [ECX + 2*CLimbSize],ESI
1559

1560
        MOV     ESI,[EAX + 3*CLimbSize]
1561
        XOR     ESI,[EDX + 3*CLimbSize]
1562
        MOV     [ECX + 3*CLimbSize],ESI
1563

1564
        LEA     EAX,[EAX + 4*CLimbSize]
1565
        LEA     EDX,[EDX + 4*CLimbSize]
1566
        LEA     ECX,[ECX + 4*CLimbSize]
1567
        DEC     EBX
1568
        JNE     @MainLoop
1569

1570
@MainTail:
1571

1572
        LEA     EAX,[EAX + EDI*CLimbSize]
1573
        LEA     EDX,[EDX + EDI*CLimbSize]
1574
        LEA     ECX,[ECX + EDI*CLimbSize]
1575
        LEA     EBX,[@JumpsMain]
1576
        JMP     [EBX + EDI*TYPE Pointer]
1577

1578
        // Align jump table manually, with NOPs
1579

1580
        NOP
1581

1582
@JumpsMain:
1583

1584
        DD      @DoRestLoop
1585
        DD      @Main1
1586
        DD      @Main2
1587
        DD      @Main3
1588

1589
@Main3:
1590

1591
        MOV     ESI,[EAX - 3*CLimbSize]
1592
        XOR     ESI,[EDX - 3*CLimbSize]
1593
        MOV     [ECX - 3*CLimbSize],ESI
1594

1595
@Main2:
1596

1597
        MOV     ESI,[EAX - 2*CLimbSize]
1598
        XOR     ESI,[EDX - 2*CLimbSize]
1599
        MOV     [ECX - 2*CLimbSize],ESI
1600

1601
@Main1:
1602

1603
        MOV     ESI,[EAX - CLimbSize]
1604
        XOR     ESI,[EDX - CLimbSize]
1605
        MOV     [ECX - CLimbSize],ESI
1606

1607
@DoRestLoop:
1608

1609
        XOR     EDX,EDX
1610
        POP     EBX
1611
        MOV     EDI,EBX
1612
        AND     EDI,CUnrollMask
1613
        SHR     EBX,CunrollShift
1614
        JE      @RestLast3
1615

1616
@RestLoop:
1617

1618
        MOV     EDX,[EAX]
1619
        MOV     [ECX],EDX
1620

1621
        MOV     EDX,[EAX + CLimbSize]
1622
        MOV     [ECX + CLimbSize],EDX
1623

1624
        MOV     EDX,[EAX + 2*CLimbSize]
1625
        MOV     [ECX + 2*CLimbSize],EDX
1626

1627
        MOV     EDX,[EAX + 3*CLimbSize]
1628
        MOV     [ECX + 3*CLimbSize],EDX
1629

1630
        LEA     EAX,[EAX + 4*CLimbSize]
1631
        LEA     ECX,[ECX + 4*CLimbSize]
1632
        DEC     EBX
1633
        JNE     @RestLoop
1634

1635
@RestLast3:
1636

1637
        LEA     EAX,[EAX + EDI*CLimbSize]
1638
        LEA     ECX,[ECX + EDI*CLimbSize]
1639
        LEA     EBX,[@RestJumps]
1640
        JMP     [EBX + EDI*TYPE Pointer]
1641

1642
        // Align jump table manually, with NOPs.
1643

1644
        NOP
1645
        NOP
1646

1647
@RestJumps:
1648

1649
        DD      @Exit
1650
        DD      @Rest1
1651
        DD      @Rest2
1652
        DD      @Rest3
1653

1654
@Rest3:
1655

1656
        MOV     EDX,[EAX - 3*CLimbSize]
1657
        MOV     [ECX - 3*CLimbSize],EDX
1658

1659
@Rest2:
1660

1661
        MOV     EDX,[EAX - 2*CLimbSize]
1662
        MOV     [ECX - 2*CLimbSize],EDX
1663

1664
@Rest1:
1665

1666
        MOV     EDX,[EAX - CLimbSize]
1667
        MOV     [ECX - CLimbSize],EDX
1668

1669
@Exit:
1670

1671
        POP     EBX
1672
        POP     EDI
1673
        POP     ESI
1674
end;
1675
{$ELSE WIN64}
1676
asm
1677
        MOV     R10D,RSize
1678

1679
        CMP     R9D,R10D
1680
        JAE     @SkipSwap
1681
        XCHG    R10D,R9D
1682
        XCHG    RCX,RDX
1683

1684
@SkipSwap:
1685

1686
        SUB     R9D,R10D
1687
        PUSH    R9
1688
        MOV     R9D,R10D
1689
        AND     R9D,CUnrollMask
1690
        SHR     R10D,CUnrollShift
1691
        JE      @MainTail
1692

1693
@MainLoop:
1694

1695
        MOV     RAX,[RCX]
1696
        XOR     RAX,[RDX]
1697
        MOV     [R8],RAX
1698

1699
        MOV     RAX,[RCX + DLimbSize]
1700
        XOR     RAX,[RDX + DLimbSize]
1701
        MOV     [R8 + DLimbSize],RAX
1702

1703
        LEA     RCX,[RCX + 2*DLimbSize]
1704
        LEA     RDX,[RDX + 2*DLimbSize]
1705
        LEA     R8,[R8 + 2*DLimbSize]
1706
        DEC     R10D
1707
        JNE     @MainLoop
1708

1709
@MainTail:
1710

1711
        LEA     RCX,[RCX + R9*CLimbSize]
1712
        LEA     RDX,[RDX + R9*CLimbSize]
1713
        LEA     R8,[R8 + R9*CLimbSize]
1714
        LEA     R10,[@JumpsMain]
1715
        JMP     [R10 + R9*TYPE Pointer]
1716

1717
@JumpsMain:
1718

1719
        DQ      @DoRestLoop
1720
        DQ      @Main1
1721
        DQ      @Main2
1722
        DQ      @Main3
1723

1724
@Main3:
1725

1726
        MOV     EAX,[RCX - 3*CLimbSize]
1727
        XOR     EAX,[RDX - 3*CLimbSize]
1728
        MOV     [R8 - 3*CLimbSize],EAX
1729

1730
@Main2:
1731

1732
        MOV     EAX,[RCX - 2*CLimbSize]
1733
        XOR     EAX,[RDX - 2*CLimbSize]
1734
        MOV     [R8 - 2*CLimbSize],EAX
1735

1736
@Main1:
1737

1738
        MOV     EAX,[RCX - CLimbSize]
1739
        XOR     EAX,[RDX - CLimbSize]
1740
        MOV     [R8 - CLimbSize],EAX
1741

1742
@DoRestLoop:
1743

1744
        POP     R10
1745
        TEST    R10D,R10D
1746
        JE      @Exit
1747
        MOV     R9D,R10D
1748
        AND     R9D,CUnrollMask
1749
        SHR     R10D,CUnrollShift
1750
        JE      @RestLast3
1751

1752
@RestLoop:
1753

1754
        MOV     RAX,[RCX]
1755
        MOV     [R8],RAX
1756

1757
        MOV     RAX,[RCX + DLimbSize]
1758
        MOV     [R8 + DLimbSize],RAX
1759

1760
        LEA     RCX,[RCX + 2*DLimbSize]
1761
        LEA     R8,[R8 + 2*DLimbSize]
1762
        DEC     R10D
1763
        JNE     @RestLoop
1764

1765
@RestLast3:
1766

1767
        LEA     RCX,[RCX + R9*CLimbSize]
1768
        LEA     R8,[R8 + R9*CLimbSize]
1769
        LEA     R10,[@RestJumps]
1770
        JMP     [R10 + R9*TYPE Pointer]
1771

1772
@RestJumps:
1773

1774
        DQ      @Exit
1775
        DQ      @Rest1
1776
        DQ      @Rest2
1777
        DQ      @Rest3
1778

1779
@Rest3:
1780

1781
        MOV     EAX,[RCX - 3*CLimbSize]
1782
        MOV     [R8 - 3*CLimbSize],EAX
1783

1784
@Rest2:
1785

1786
        MOV     EAX,[RCX - 2*CLimbSize]
1787
        MOV     [R8 - 2*CLimbSize],EAX
1788

1789
@Rest1:
1790

1791
        MOV     EAX,[RCX - CLimbSize]
1792
        MOV     [R8 - CLimbSize],EAX
1793

1794
@Exit:
1795

1796
end;
1797
{$ENDIF WIN64}
1798
{$ENDIF !PUREPASCAL}
1799

1800
class procedure BigInteger.InternalOr(Left, Right, Result: PLimb; LSize, RSize: Integer);
1801
{$IFDEF PUREPASCAL}
1802
var
1803
  I: Integer;
1804
  P: PLimb;
1805
begin
1806
  if LSize < RSize then
1807
  begin
1808
    // Swap left and right pointers and sizes.
1809
    I := LSize;
1810
    LSize := RSize;
1811
    RSize := I;
1812
    P := Left;
1813
    Left := Right;
1814
    Right := P;
1815
  end;
1816
  for I := 0 to RSize - 1 do
1817
    Result[I] := Left[I] or Right[I];
1818
  for I := RSize to LSize - 1 do
1819
    Result[I] := Left[I];
1820
end;
1821
{$ELSE !PUREPASCAL}
1822
{$IFDEF WIN32}
1823
asm
1824
        PUSH    ESI
1825
        PUSH    EDI
1826
        PUSH    EBX
1827

1828
        MOV     EBX,RSize
1829
        MOV     EDI,LSize
1830

1831
        CMP     EDI,EBX
1832
        JAE     @SkipSwap
1833
        XCHG    EBX,EDI
1834
        XCHG    EAX,EDX
1835

1836
@SkipSwap:
1837

1838
        SUB     EDI,EBX
1839
        PUSH    EDI                             // Number of "rest" loops
1840
        MOV     EDI,EBX
1841
        AND     EDI,CUnrollMask
1842
        SHR     EBX,CUnrollShift
1843
        JE      @MainTail
1844

1845
@MainLoop:
1846

1847
        MOV     ESI,[EAX]
1848
        OR      ESI,[EDX]
1849
        MOV     [ECX],ESI
1850

1851
        MOV     ESI,[EAX + CLimbSize]
1852
        OR      ESI,[EDX + CLimbSize]
1853
        MOV     [ECX + CLimbSize],ESI
1854

1855
        MOV     ESI,[EAX + 2*CLimbSize]
1856
        OR      ESI,[EDX + 2*CLimbSize]
1857
        MOV     [ECX + 2*CLimbSize],ESI
1858

1859
        MOV     ESI,[EAX + 3*CLimbSize]
1860
        OR      ESI,[EDX + 3*CLimbSize]
1861
        MOV     [ECX + 3*CLimbSize],ESI
1862

1863
        LEA     EAX,[EAX + 4*CLimbSize]
1864
        LEA     EDX,[EDX + 4*CLimbSize]
1865
        LEA     ECX,[ECX + 4*CLimbSize]
1866
        DEC     EBX
1867
        JNE     @MainLoop
1868

1869
@MainTail:
1870

1871
        LEA     EAX,[EAX + EDI*CLimbSize]
1872
        LEA     EDX,[EDX + EDI*CLimbSize]
1873
        LEA     ECX,[ECX + EDI*CLimbSize]
1874
        LEA     EBX,[@JumpsMain]
1875
        JMP     [EBX + EDI*TYPE Pointer]
1876

1877
        // Align jump table manually, with NOPs
1878

1879
        NOP
1880

1881
@JumpsMain:
1882

1883
        DD      @DoRestLoop
1884
        DD      @Main1
1885
        DD      @Main2
1886
        DD      @Main3
1887

1888
@Main3:
1889

1890
        MOV     ESI,[EAX - 3*CLimbSize]
1891
        OR      ESI,[EDX - 3*CLimbSize]
1892
        MOV     [ECX - 3*CLimbSize],ESI
1893

1894
@Main2:
1895

1896
        MOV     ESI,[EAX - 2*CLimbSize]
1897
        OR      ESI,[EDX - 2*CLimbSize]
1898
        MOV     [ECX - 2*CLimbSize],ESI
1899

1900
@Main1:
1901

1902
        MOV     ESI,[EAX - CLimbSize]
1903
        OR      ESI,[EDX - CLimbSize]
1904
        MOV     [ECX - CLimbSize],ESI
1905

1906
@DoRestLoop:
1907

1908
        XOR     EDX,EDX
1909
        POP     EBX
1910
        MOV     EDI,EBX
1911
        AND     EDI,CUnrollMask
1912
        SHR     EBX,CUnrollShift
1913
        JE      @RestLast3
1914

1915
@RestLoop:
1916

1917
        MOV     EDX,[EAX]
1918
        MOV     [ECX],EDX
1919

1920
        MOV     EDX,[EAX + CLimbSize]
1921
        MOV     [ECX + CLimbSize],EDX
1922

1923
        MOV     EDX,[EAX + 2*CLimbSize]
1924
        MOV     [ECX + 2*CLimbSize],EDX
1925

1926
        MOV     EDX,[EAX + 3*CLimbSize]
1927
        MOV     [ECX + 3*CLimbSize],EDX
1928

1929
        LEA     EAX,[EAX + 4*CLimbSize]
1930
        LEA     ECX,[ECX + 4*CLimbSize]
1931
        DEC     EBX
1932
        JNE     @RestLoop
1933

1934
@RestLast3:
1935

1936
        LEA     EAX,[EAX + EDI*CLimbSize]
1937
        LEA     ECX,[ECX + EDI*CLimbSize]
1938
        LEA     EBX,[@RestJumps]
1939
        JMP     [EBX + EDI*TYPE Pointer]
1940

1941
        // Align jump table manually, with NOPs.
1942

1943
        NOP
1944
        NOP
1945

1946
@RestJumps:
1947

1948
        DD      @Exit
1949
        DD      @Rest1
1950
        DD      @Rest2
1951
        DD      @Rest3
1952

1953
@Rest3:
1954

1955
        MOV     EDX,[EAX - 3*CLimbSize]
1956
        MOV     [ECX - 3*CLimbSize],EDX
1957

1958
@Rest2:
1959

1960
        MOV     EDX,[EAX - 2*CLimbSize]
1961
        MOV     [ECX - 2*CLimbSize],EDX
1962

1963
@Rest1:
1964

1965
        MOV     EDX,[EAX - CLimbSize]
1966
        MOV     [ECX - CLimbSize],EDX
1967

1968
@Exit:
1969

1970
        POP     EBX
1971
        POP     EDI
1972
        POP     ESI
1973
end;
1974
{$ELSE WIN64}
1975
asm
1976
        MOV     R10D,RSize
1977

1978
        CMP     R9D,R10D
1979
        JAE     @SkipSwap
1980
        XCHG    R10D,R9D
1981
        XCHG    RCX,RDX
1982

1983
@SkipSwap:
1984

1985
        SUB     R9D,R10D
1986
        PUSH    R9
1987
        MOV     R9D,R10D
1988
        AND     R9D,CUnrollMask
1989
        SHR     R10D,CUnrollShift
1990
        JE      @MainTail
1991

1992
@MainLoop:
1993

1994
        MOV     RAX,[RCX]
1995
        OR      RAX,[RDX]
1996
        MOV     [R8],RAX
1997

1998
        MOV     RAX,[RCX + DLimbSize]
1999
        OR      RAX,[RDX + DLimbSize]
2000
        MOV     [R8 + DLimbSize],RAX
2001

2002
        LEA     RCX,[RCX + 2*DLimbSize]
2003
        LEA     RDX,[RDX + 2*DLimbSize]
2004
        LEA     R8,[R8 + 2*DLimbSize]
2005
        DEC     R10D
2006
        JNE     @MainLoop
2007

2008
@MainTail:
2009

2010
        LEA     RCX,[RCX + R9*CLimbSize]
2011
        LEA     RDX,[RDX + R9*CLimbSize]
2012
        LEA     R8,[R8 + R9*CLimbSize]
2013
        LEA     R10,[@JumpsMain]
2014
        JMP     [R10 + R9*TYPE Pointer]
2015

2016
        // Align jump table manually, with NOPs.
2017

2018
        DB      $90,$90,$90,$90,$90,$90
2019

2020
@JumpsMain:
2021

2022
        DQ      @DoRestLoop
2023
        DQ      @Main1
2024
        DQ      @Main2
2025
        DQ      @Main3
2026

2027
@Main3:
2028

2029
        MOV     EAX,[RCX - 3*CLimbSize]
2030
        OR      EAX,[RDX - 3*CLimbSize]
2031
        MOV     [R8 - 3*CLimbSize],EAX
2032

2033
@Main2:
2034

2035
        MOV     EAX,[RCX - 2*CLimbSize]
2036
        OR      EAX,[RDX - 2*CLimbSize]
2037
        MOV     [R8 - 2*CLimbSize],EAX
2038

2039
@Main1:
2040

2041
        MOV     EAX,[RCX - CLimbSize]
2042
        OR      EAX,[RDX - CLimbSize]
2043
        MOV     [R8 - CLimbSize],EAX
2044

2045
@DoRestLoop:
2046

2047
        POP     R10
2048
        TEST    R10D,R10D
2049
        JE      @Exit
2050
        MOV     R9D,R10D
2051
        AND     R9D,CUnrollMask
2052
        SHR     R10D,CUnrollShift
2053
        JE      @RestLast3
2054

2055
@RestLoop:
2056

2057
        MOV     RAX,[RCX]
2058
        MOV     [R8],RAX
2059

2060
        MOV     RAX,[RCX + DLimbSize]
2061
        MOV     [R8 + DLimbSize],RAX
2062

2063
        LEA     RCX,[RCX + 2*DLimbSize]
2064
        LEA     R8,[R8 + 2*DLimbSize]
2065
        DEC     R10D
2066
        JNE     @RestLoop
2067

2068
@RestLast3:
2069

2070
        LEA     RCX,[RCX + R9*CLimbSize]
2071
        LEA     R8,[R8 + R9*CLimbSize]
2072
        LEA     R10,[@RestJumps]
2073
        JMP     [R10 + R9*TYPE Pointer]
2074

2075
        // Align jump table manually, with NOPs.
2076

2077
        // -- Aligned.
2078

2079
@RestJumps:
2080

2081
        DQ      @Exit
2082
        DQ      @Rest1
2083
        DQ      @Rest2
2084
        DQ      @Rest3
2085

2086
@Rest3:
2087

2088
        MOV     EAX,[RCX - 3*CLimbSize]
2089
        MOV     [R8 - 3*CLimbSize],EAX
2090

2091
@Rest2:
2092

2093
        MOV     EAX,[RCX - 2*CLimbSize]
2094
        MOV     [R8 - 2*CLimbSize],EAX
2095

2096
@Rest1:
2097

2098
        MOV     EAX,[RCX - CLimbSize]
2099
        MOV     [R8 - CLimbSize],EAX
2100

2101
@Exit:
2102

2103
end;
2104
{$ENDIF WIN64}
2105
{$ENDIF !PUREPASCAL}
2106

2107
class procedure BigInteger.InternalAndNot(Left, Right, Result: PLimb; LSize, RSize: Integer);
2108
{$IFDEF PUREPASCAL}
2109
var
2110
  I: Integer;
2111
begin
2112

2113
  // Note: AndNot is - of course - not commutative.
2114
  if LSize < RSize then
2115
    RSize := LSize;
2116
  for I := 0 to RSize - 1 do
2117
    Result[I] := not Right[I] and Left[I];
2118
  for I := RSize to LSize - 1 do
2119
    Result[I] := Left[I];
2120
end;
2121
{$ELSE !PUREPASCAL}
2122
{$IFDEF WIN32}
2123
asm
2124
        PUSH    ESI
2125
        PUSH    EDI
2126
        PUSH    EBX
2127

2128
        MOV     EBX,RSize
2129
        MOV     EDI,LSize
2130

2131
        CMP     EDI,EBX
2132
        JAE     @SkipSwap
2133
        MOV     EBX,EDI
2134

2135
@SkipSwap:
2136

2137
        SUB     EDI,EBX
2138
        PUSH    EDI                             // Number of "rest" loops
2139
        MOV     EDI,EBX
2140
        AND     EDI,CUnrollMask
2141
        SHR     EBX,CUnrollShift
2142
        JE      @MainTail
2143

2144
@MainLoop:
2145

2146
        MOV     ESI,[EDX]
2147
        NOT     ESI
2148
        AND     ESI,[EAX]
2149
        MOV     [ECX],ESI
2150

2151
        MOV     ESI,[EDX + CLimbSize]
2152
        NOT     ESI
2153
        AND     ESI,[EAX + CLimbSize]
2154
        MOV     [ECX + CLimbSize],ESI
2155

2156
        MOV     ESI,[EDX + 2*CLimbSize]
2157
        NOT     ESI
2158
        AND     ESI,[EAX + 2*CLimbSize]
2159
        MOV     [ECX + 2*CLimbSize],ESI
2160

2161
        MOV     ESI,[EDX + 3*CLimbSize]
2162
        NOT     ESI
2163
        AND     ESI,[EAX + 3*CLimbSize]
2164
        MOV     [ECX + 3*CLimbSize],ESI
2165

2166
        LEA     EAX,[EAX + 4*CLimbSize]
2167
        LEA     EDX,[EDX + 4*CLimbSize]
2168
        LEA     ECX,[ECX + 4*CLimbSize]
2169
        DEC     EBX
2170
        JNE     @MainLoop
2171

2172
@MainTail:
2173

2174
        LEA     EAX,[EAX + EDI*CLimbSize]
2175
        LEA     EDX,[EDX + EDI*CLimbSize]
2176
        LEA     ECX,[ECX + EDI*CLimbSize]
2177
        LEA     EBX,[@JumpsMain]
2178
        JMP     [EBX + EDI*TYPE Pointer]
2179

2180
        // Align jump table manually, with NOPs
2181

2182
        NOP
2183
        NOP
2184

2185
@JumpsMain:
2186

2187
        DD      @DoRestLoop
2188
        DD      @Main1
2189
        DD      @Main2
2190
        DD      @Main3
2191

2192
@Main3:
2193

2194
        MOV     ESI,[EDX - 3*CLimbSize]
2195
        NOT     ESI
2196
        AND     ESI,[EAX - 3*CLimbSize]
2197
        MOV     [ECX - 3*CLimbSize],ESI
2198

2199
@Main2:
2200

2201
        MOV     ESI,[EDX - 2*CLimbSize]
2202
        NOT     ESI
2203
        AND     ESI,[EAX - 2*CLimbSize]
2204
        MOV     [ECX - 2*CLimbSize],ESI
2205

2206
@Main1:
2207

2208
        MOV     ESI,[EDX - CLimbSize]
2209
        NOT     ESI
2210
        AND     ESI,[EAX - CLimbSize]
2211
        MOV     [ECX - CLimbSize],ESI
2212

2213
@DoRestLoop:
2214

2215
        XOR     EDX,EDX
2216
        POP     EBX
2217
        MOV     EDI,EBX
2218
        AND     EDI,CUnrollMask
2219
        SHR     EBX,CUnrollShift
2220
        JE      @RestLast3
2221

2222
@RestLoop:
2223

2224
        //      X AND NOT 0 = X AND -1 = X
2225
        MOV     EDX,[EAX]
2226
        MOV     [ECX],EDX
2227

2228
        MOV     EDX,[EAX + CLimbSize]
2229
        MOV     [ECX + CLimbSize],EDX
2230

2231
        MOV     EDX,[EAX + 2*CLimbSize]
2232
        MOV     [ECX + 2*CLimbSize],EDX
2233

2234
        MOV     EDX,[EAX + 3*CLimbSize]
2235
        MOV     [ECX + 3*CLimbSize],EDX
2236

2237
        LEA     EAX,[EAX + 4*CLimbSize]
2238
        LEA     ECX,[ECX + 4*CLimbSize]
2239
        DEC     EBX
2240
        JNE     @RestLoop
2241

2242
@RestLast3:
2243

2244
        LEA     EAX,[EAX + EDI*CLimbSize]
2245
        LEA     ECX,[ECX + EDI*CLimbSize]
2246
        LEA     EBX,[@RestJumps]
2247
        JMP     [EBX + EDI*TYPE Pointer]
2248

2249
        // Align jump table manually, with NOPs.
2250

2251
@RestJumps:
2252

2253
        DD      @Exit
2254
        DD      @Rest1
2255
        DD      @Rest2
2256
        DD      @Rest3
2257

2258
@Rest3:
2259

2260
        MOV     EDX,[EAX - 3*CLimbSize]
2261
        MOV     [ECX - 3*CLimbSize],EDX
2262

2263
@Rest2:
2264

2265
        MOV     EDX,[EAX - 2*CLimbSize]
2266
        MOV     [ECX - 2*CLimbSize],EDX
2267

2268
@Rest1:
2269

2270
        MOV     EDX,[EAX - CLimbSize]
2271
        MOV     [ECX - CLimbSize],EDX
2272

2273
@Exit:
2274

2275
        POP     EBX
2276
        POP     EDI
2277
        POP     ESI
2278
end;
2279
{$ELSE WIN64}
2280
asm
2281
        MOV     R10D,RSize
2282

2283
        CMP     R9D,R10D
2284
        JAE     @SkipSwap
2285
        MOV     R10D,R9D
2286

2287
@SkipSwap:
2288

2289
        SUB     R9D,R10D
2290
        PUSH    R9
2291
        MOV     R9D,R10D
2292
        AND     R9D,CUnrollMask
2293
        SHR     R10D,CUnrollShift
2294
        JE      @MainTail
2295

2296
@MainLoop:
2297

2298
        MOV     RAX,[RDX]
2299
        NOT     RAX
2300
        AND     RAX,[RCX]
2301
        MOV     [R8],RAX
2302

2303
        MOV     RAX,[RDX + DLimbSize]
2304
        NOT     RAX
2305
        AND     RAX,[RCX + DLimbSize]
2306
        MOV     [R8 + DLimbSize],RAX
2307

2308
        LEA     RCX,[RCX + 2*DLimbSize]
2309
        LEA     RDX,[RDX + 2*DLimbSize]
2310
        LEA     R8,[R8 + 2*DLimbSize]
2311
        DEC     R10D
2312
        JNE     @MainLoop
2313

2314
@MainTail:
2315

2316
        LEA     RCX,[RCX + R9*CLimbSize]
2317
        LEA     RDX,[RDX + R9*CLimbSize]
2318
        LEA     R8,[R8 + R9*CLimbSize]
2319
        LEA     R10,[@JumpsMain]
2320
        JMP     [R10 + R9*TYPE Pointer]
2321

2322
        // Align jump table manually, with NOPs.
2323

2324
        DB      $90,$90,$90
2325

2326
@JumpsMain:
2327

2328
        DQ      @DoRestLoop
2329
        DQ      @Main1
2330
        DQ      @Main2
2331
        DQ      @Main3
2332

2333
@Main3:
2334

2335
        MOV     EAX,[RDX - 3*CLimbSize]
2336
        NOT     EAX
2337
        AND     EAX,[RCX - 3*CLimbSize]
2338
        MOV     [R8 - 3*CLimbSize],EAX
2339

2340
@Main2:
2341

2342
        MOV     EAX,[RDX - 2*CLimbSize]
2343
        NOT     EAX
2344
        AND     EAX,[RCX - 2*CLimbSize]
2345
        MOV     [R8 - 2*CLimbSize],EAX
2346

2347
@Main1:
2348

2349
        MOV     EAX,[RDX - CLimbSize]
2350
        NOT     EAX
2351
        AND     EAX,[RCX - CLimbSize]
2352
        MOV     [R8 - CLimbSize],EAX
2353

2354
@DoRestLoop:
2355

2356
        POP     R10
2357
        TEST    R10D,R10D
2358
        JE      @Exit
2359
        MOV     R9D,R10D
2360
        AND     R9D,CUnrollMask
2361
        SHR     R10D,CUnrollShift
2362
        JE      @RestLast3
2363

2364
@RestLoop:
2365

2366
        //      X AND NOT 0 = X AND -1 = X
2367

2368
        MOV     RAX,[RCX]
2369
        MOV     RDX,[RCX + DLimbSize]
2370
        MOV     [R8],RAX
2371
        MOV     [R8 + DLimbSize],RDX
2372

2373
        LEA     RCX,[RCX + 2*DLimbSize]
2374
        LEA     R8,[R8 + 2*DLimbSize]
2375
        DEC     R10D
2376
        JNE     @RestLoop
2377

2378
@RestLast3:
2379

2380
        LEA     RCX,[RCX + R9*CLimbSize]
2381
        LEA     R8,[R8 + R9*CLimbSize]
2382
        LEA     R10,[@RestJumps]
2383
        JMP     [R10 + R9*TYPE Pointer]
2384

2385
        // Align jump table manually, with NOPs.
2386

2387
        DB      $90,$90
2388

2389
@RestJumps:
2390

2391
        DQ      @Exit
2392
        DQ      @Rest1
2393
        DQ      @Rest2
2394
        DQ      @Rest3
2395

2396
@Rest3:
2397

2398
        MOV     EAX,[RCX - 3*CLimbSize]
2399
        MOV     [R8 - 3*CLimbSize],EAX
2400

2401
@Rest2:
2402

2403
        MOV     EAX,[RCX - 2*CLimbSize]
2404
        MOV     [R8 - 2*CLimbSize],EAX
2405

2406
@Rest1:
2407

2408
        MOV     EAX,[RCX - CLimbSize]
2409
        MOV     [R8 - CLimbSize],EAX
2410

2411
@Exit:
2412

2413
end;
2414
{$ENDIF WIN64}
2415
{$ENDIF !PUREPASCAL}
2416

2417
class procedure BigInteger.InternalNotAnd(Left, Right, Result: PLimb; LSize, RSize: Integer);
2418
begin
2419
  InternalAndNot(Right, Left, Result, RSize, LSize);
2420
end;
2421

2422
class operator BigInteger.BitwiseAnd(const Left, Right: BigInteger): BigInteger;
2423
begin
2424

2425
  // Special handling for 0.
2426
  if (Left.FData = nil)  or (Right.FData = nil) then
2427
  begin
2428
    Result.FData := nil;
2429
    Result.FSize := 0;
2430
    Exit;
2431
  end;
2432

2433
  InternalBitwise(Left, Right, Result, InternalAnd, InternalOr, InternalAndNot);
2434
end;
2435

2436
class operator BigInteger.BitwiseOr(const Left, Right: BigInteger): BigInteger;
2437
begin
2438

2439
  // Special handling for 0.
2440
  if Left.FData = nil then
2441
  begin
2442
    ShallowCopy(Right, Result);
2443
    Exit;
2444
  end
2445
  else if Right.FData = nil then
2446
  begin
2447
    ShallowCopy(Left, Result);
2448
    Exit;
2449
  end;
2450

2451
  InternalBitwise(Left, Right, Result, InternalOr, InternalAnd, InternalNotAnd);
2452
end;
2453

2454
class operator BigInteger.BitwiseXor(const Left, Right: BigInteger): BigInteger;
2455
begin
2456

2457
  // Special handling for 0.
2458
  if Left.FData = nil then
2459
  begin
2460
    ShallowCopy(Right, Result);
2461
    Exit;
2462
  end
2463
  else if Right.FData = nil then
2464
  begin
2465
    ShallowCopy(Left, Result);
2466
    Exit;
2467
  end;
2468

2469
  InternalBitwise(Left, Right, Result, InternalXor, InternalXor, InternalXor);
2470
end;
2471

2472
function BigInteger.Clone: BigInteger;
2473
begin
2474
  DeepCopy(Self, Result);
2475
end;
2476

2477
function FindSize(Limb: PLimb; Size: Integer): Integer;
2478
{$IFDEF PUREPASCAL}
2479
begin
2480
  while (Size > 0) and (Limb[Size - 1] = 0) do
2481
    Dec(Size);
2482
  Result := Size;
2483
end;
2484
{$ELSE}
2485
{$IFDEF WIN32}
2486
asm
2487

2488
        LEA     EAX,[EAX + EDX * CLimbSize - CLimbSize]
2489
        XOR     ECX,ECX
2490

2491
@Loop:
2492

2493
        CMP     [EAX],ECX
2494
        JNE     @Exit
2495
        LEA     EAX,[EAX - CLimbSize]
2496
        DEC     EDX
2497
        JNE     @Loop
2498

2499
@Exit:
2500

2501
        MOV     EAX,EDX
2502

2503
end;
2504
{$ELSE !WIN32}
2505
asm
2506

2507
        LEA     RAX,[RCX + RDX * CLimbSize - CLimbSize]
2508
        XOR     ECX,ECX
2509

2510
@Loop:
2511

2512
        CMP     [RAX],ECX
2513
        JNE     @Exit
2514
        LEA     RAX,[RAX - CLimbSize]
2515
        DEC     EDX
2516
        JNE     @Loop
2517

2518
@Exit:
2519

2520
        MOV     EAX,EDX
2521

2522
end;
2523
{$ENDIF !WIN32}
2524
{$ENDIF}
2525

2526
procedure BigInteger.Compact;
2527
var
2528
  NewSize: Integer;
2529
begin
2530
  if FData = nil then
2531
  begin
2532
    FSize := 0;
2533
    Exit;
2534
  end;
2535

2536
  NewSize := FindSize(PLimb(FData), FSize and SizeMask);
2537
  if NewSize < (FSize and SizeMask) then
2538
  begin
2539
    if NewSize = 0 then
2540
    begin
2541
      FSize := 0;
2542
      FData := nil;
2543
    end
2544
    else
2545
    begin
2546
      FSize := SignBitOf(FSize) or NewSize;
2547
    {$IFDEF RESETSIZE}
2548
      SetLength(FData, (NewSize + 4) and CapacityMask);
2549
    {$ENDIF}
2550
    end;
2551
  end;
2552
end;
2553

2554
class function BigInteger.Compare(const Left, Right: BigInteger): TValueSign;
2555
begin
2556
  Result := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), Left.FSize and SizeMask, Right.FSize and SizeMask);
2557
  if Left.FSize < 0 then
2558
    if Right.FSize < 0 then
2559
      Result := -Result
2560
    else
2561
      Result := -1
2562
  else if Right.FSize < 0 then
2563
    Result := 1;
2564
end;
2565

2566
constructor BigInteger.Create(const Int: Integer);
2567
begin
2568
  Create(Cardinal(System.Abs(Int)));
2569
  if Int < 0 then
2570
    FSize := FSize or SignMask;
2571
end;
2572

2573
constructor BigInteger.Create(const Int: BigInteger);
2574
begin
2575
  Self.FSize := Int.FSize;
2576
  Self.FData := Int.FData;
2577
end;
2578

2579
constructor BigInteger.Create(const Data: TMagnitude; Negative: Boolean);
2580
begin
2581
  FSize := Length(Data) or (Ord(Negative) * SignMask);
2582
  FData := Copy(Data);
2583
  Compact;
2584
end;
2585

2586
constructor BigInteger.Create(const Int: UInt64);
2587
begin
2588
  FData := nil;
2589
  if Int <> 0 then
2590
  begin
2591
    if Int > High(UInt32) then
2592
      FSize := CUInt64Limbs
2593
    else
2594
      FSize := 1;
2595
    SetLength(FData, 4);
2596
    Move(Int, FData[0], SizeOf(Int));
2597
  end
2598
  else
2599
  begin
2600
    FData := nil;
2601
    FSize := 0;
2602
  end;
2603
end;
2604

2605
const
2606
  CMantissaBits = 52;
2607
  CMaxShift     = 62;
2608

2609
function IsDenormal(const ADouble: Double): Boolean; inline;
2610
begin
2611
  Result := (PUInt64(@ADouble)^ and (UInt64($7FF) shl CMantissaBits)) = 0
2612
end;
2613

2614
function MantissaOf(const ADouble: Double): UInt64; inline;
2615
begin
2616
  Result := PUInt64(@ADouble)^ and (UInt64(-1) shr (64 - CMantissaBits));
2617
  if not IsDenormal(ADouble) then
2618
    Result := Result or (UInt64(1) shl CMantissaBits);
2619
end;
2620

2621
function ExponentOf(const ADouble: Double): Integer;
2622
begin
2623
  Result := ((PUInt64(@ADouble)^ shr CMantissaBits) and $7FF) - 1023;
2624
  if Result = -1023 then
2625
    Result := -1022;
2626
end;
2627

2628
function SignOf(const ADouble: Double): Boolean;
2629
begin
2630
  Result := PInt64(@ADouble)^ < 0;
2631
end;
2632

2633
constructor BigInteger.Create(const ADouble: Double);
2634
var
2635
  Exponent: Integer;
2636
  Mantissa: UInt64;
2637
  Sign, Guard, Round, Sticky: Boolean;
2638
  Shift: Integer;
2639
  ZeroExponentLimit: Integer;
2640
begin
2641
  FSize := 0;
2642
//  FData := nil;
2643

2644
  // Error for special values.
2645
  if IsNan(ADouble) or IsInfinite(ADouble) then
2646
    Error(ecOverflow);
2647

2648
  // Get the required values from TDoubleHelper.
2649
  Mantissa := MantissaOf(ADouble);
2650
  Exponent := ExponentOf(ADouble);
2651
  Sign := SignOf(ADouble);
2652

2653
  // Make 0 for denormal values and values < 0.5.
2654
  if FRoundingMode <> rmTruncate then
2655
    ZeroExponentLimit := -1
2656
  else
2657
    ZeroExponentLimit := 0;
2658

2659
  // Denormals and values with small exponent convert to 0.
2660
  if IsDenormal(ADouble) or (Exponent < ZeroExponentLimit) then
2661
  begin
2662
    Self := BigInteger.Zero;
2663
    Exit;
2664
  end;
2665

2666
  // Internal shift of the mantissa.
2667
  Shift := Exponent;
2668
  if Shift > CMaxShift then
2669
    Shift := CMaxShift;
2670

2671
  // Guard, Round and Sticky bits are used to determine rounding, see comments in function AsDouble.
2672
  Guard := False;
2673
  Round := False;
2674
  Sticky := False;
2675
  if (FRoundingMode <> rmTruncate) and (Exponent < CMantissaBits) then
2676
  begin
2677
    // Round anything with a fraction >= 0.5 away from 0. No Round and Sticky bits required.
2678
    Guard := ((UInt64(1) shl (CMantissaBits - 1 - Exponent)) and Mantissa) <> 0;
2679

2680
    if FRoundingMode = rmRound then
2681
    begin
2682
      // Only if full rounding (like System.Round() performs) is required: Round any fraction > 0.5 away from 0.
2683
      Round := ((UInt64(1) shl (CMantissaBits - 2 - Exponent)) and Mantissa) <> 0;
2684
      Sticky := ((Int64(-1) shr (Exponent + (64 - CMantissaBits + 2))) and Mantissa) <> 0;
2685
    end;
2686
  end;
2687

2688
  // Shift mantissa left or right to get the most bits out of it before converting to BigInteger.
2689
  if Shift > CMantissaBits then
2690
    Mantissa := Mantissa shl (Shift - CMantissaBits)
2691
  else
2692
    Mantissa := Mantissa shr (CMantissaBits - Shift);
2693

2694
  // Round shifted mantissa.
2695
  if ((RoundingMode = rmSchool) and Guard) or
2696
     ((RoundingMode = rmRound) and (Guard and (Round or Sticky))) then
2697
    Inc(Mantissa);
2698

2699
  // Turn shifted mantissa (a UInt64) into BigInteger.
2700
  Self := 0;
2701
  Self.Create(UInt64(Mantissa));
2702

2703
  // Shift left by the restant value of the exponent.
2704
  if Exponent > Shift then
2705
    Self := Self shl (Exponent - Shift);
2706
  if Sign then
2707
    FSize := FSize or SignMask;
2708

2709
end;
2710

2711
// Bytes are considered to contain value in two's complement format.
2712
constructor BigInteger.Create(const Bytes: array of Byte);
2713
var
2714
  Limbs: TMagnitude;
2715
  Negative: Boolean;
2716
begin
2717
  Negative := Bytes[High(Bytes)] >= $80;
2718
  SetLength(Limbs, (Length(Bytes) + 3) div 4);
2719
  if Negative then
2720
    Limbs[High(Limbs)] := TLimb(-1);
2721
  Move((@Bytes[0])^, PLimb(Limbs)^, Length(Bytes));
2722
  if Negative then
2723
    InternalNegate(PLimb(Limbs), PLimb(Limbs), Length(Limbs));
2724
  Create(Limbs, Negative);
2725
end;
2726

2727
// This assumes sign-magnitude format.
2728
constructor BigInteger.Create(const Limbs: array of TLimb; Negative: Boolean);
2729
var
2730
  LSize: Integer;
2731
begin
2732
  LSize := Length(Limbs);
2733
  MakeSize(LSize);
2734
  FSize := LSize or (Ord(Negative) * SignMask);
2735
  if LSize > 0 then
2736
    CopyLimbs(@Limbs[0], PLimb(FData), LSize);
2737
  Compact;
2738
end;
2739

2740
constructor BigInteger.Create(const Int: Int64);
2741
begin
2742
  Create(UInt64(System.Abs(Int)));
2743
  if Int < 0 then
2744
    FSize := FSize or SignMask;
2745
end;
2746

2747
constructor BigInteger.Create(const Int: Cardinal);
2748
begin
2749
  if Int <> 0 then
2750
  begin
2751
    FSize := 1;
2752
    SetLength(FData, 4);
2753
    FData[0] := Int;
2754
  end
2755
  else
2756
  begin
2757
    FData := nil;
2758
    FSize := 0;
2759
  end;
2760
end;
2761

2762
constructor BigInteger.Create(NumBits: Integer; const Random: IRandom);
2763
var
2764
  Bytes: TArray<Byte>;
2765
  Bits: Byte;
2766
begin
2767
  if NumBits = 0 then
2768
  begin
2769
    ShallowCopy(Zero, Self);
2770
    Exit;
2771
  end;
2772

2773
  SetLength(Bytes, (NumBits + 7) shr 3 + 1);
2774
  Random.NextBytes(Bytes);
2775

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

2779
  // Set bits above required bit length to 0.
2780
  Bits := NumBits and $07;
2781
  Bytes[High(Bytes) - 1] := Bytes[High(Bytes) - 1] and ($7F shr (7 - Bits));
2782
  Create(Bytes);
2783
  Compact;
2784
//  Assert(BitLength <= Numbits, Format('BitLength (%d) >= NumBits (%d): %s', [BitLength, NumBits, Self.ToString(2)]));
2785
end;
2786

2787
function BigInteger.GetAllocated: Integer;
2788
begin
2789
  Result := Length(FData);
2790
end;
2791

2792
function BigInteger.IsEven: Boolean;
2793
begin
2794
  Result := IsZero or ((FData[0] and 1) = 0);
2795
end;
2796

2797
function BigInteger.IsNegative: Boolean;
2798
begin
2799
  Result := FSize < 0;
2800
end;
2801

2802
function BigInteger.IsOne: Boolean;
2803
begin
2804
  Result := (FSize = 1) and (FData[0] = 1);
2805
end;
2806

2807
function BigInteger.IsPositive: Boolean;
2808
begin
2809
  Result := FSize > 0;
2810
end;
2811

2812
function BigInteger.IsPowerOfTwo: Boolean;
2813
var
2814
  FirstNonZeroIndex: Integer;
2815
  AHigh: Integer;
2816
begin
2817
  AHigh := (FSize and SizeMask) - 1;
2818
  if (FData = nil) or not Velthuis.Numerics.IsPowerOfTwo(FData[AHigh]) then
2819
    Result := False
2820
  else
2821
  begin
2822
    FirstNonZeroIndex := 0;
2823

2824
    // All limbs below top one must be 0
2825
    while FData[FirstNonZeroIndex] = 0 do
2826
      Inc(FirstNonZeroIndex);
2827

2828
    // Top limb must be power of two.
2829
    Result := (FirstNonZeroIndex = AHigh);
2830
  end;
2831
end;
2832

2833
function BigInteger.GetSign: Integer;
2834
begin
2835
  if FData = nil then
2836
  begin
2837
    FSize := 0;
2838
    Exit(0);
2839
  end;
2840

2841
  if FSize > 0 then
2842
    Result := 1
2843
  else
2844
    Result := -1
2845
end;
2846

2847
function BigInteger.GetSize: Integer;
2848
begin
2849
  if FData = nil then
2850
    FSize := 0;
2851
  Result := FSize and SizeMask;
2852
end;
2853

2854
function BigInteger.Data: PLimb;
2855
begin
2856
  Result := PLimb(FData);
2857
end;
2858

2859
class operator BigInteger.GreaterThan(const Left, Right: BigInteger): Boolean;
2860
begin
2861
  Result := Compare(Left, Right) > 0;
2862
//  Result := not (Left <= Right);
2863
end;
2864

2865
class operator BigInteger.GreaterThanOrEqual(const Left, Right: BigInteger): Boolean;
2866
begin
2867
  Result := Compare(left, Right) >= 0;
2868
end;
2869

2870
// http://en.wikipedia.org/wiki/Binary_GCD_algorithm
2871
class function BigInteger.GreatestCommonDivisor(const Left, Right: BigInteger): BigInteger;
2872
var
2873
  Shift: Integer;
2874
  ALeft, ARight, Temp: BigInteger;
2875
begin
2876
  // GCD(left, 0) = left; GCD(0, right) = right; GCD(0, 0) = 0
2877
  if Left.IsZero then
2878
    Exit(Abs(Right));
2879
  if Right.IsZero then
2880
    Exit(Abs(Left));
2881

2882
  // Let Shift = Log2(K), where K is the greatest power of 2 dividing both ALeft and ARight.
2883
  ALeft := Abs(Left);
2884
  ARight := Abs(Right);
2885
  Shift := 0;
2886
  while ALeft.IsEven and ARight.IsEven do
2887
  begin
2888
    ALeft := ALeft shr 1;
2889
    ARight := ARight shr 1;
2890
    Inc(Shift);
2891
  end;
2892

2893
  while ALeft.IsEven do
2894
    ALeft := ALeft shr 1;
2895

2896
  // Now, ALeft is always odd.
2897
  repeat
2898
    // Remove all factors of 2 in ARight, since they are not in common.
2899
    // ARight is not 0, so the loop will terminate
2900
    while ARight.IsEven do
2901
      ARight := ARight shr 1;
2902

2903
    // ALeft and ARight are both odd. Swap if necessary, so that ALeft <= ARight,
2904
    // then set ARight to ARight - ALeft (which is even).
2905
    if ALeft > ARight then
2906
    begin
2907
      // Swap ALeft and ALeft.
2908
      Temp := ALeft;
2909
      ALeft := ARight;
2910
      ARight := Temp;
2911
    end;
2912
    ARight := ARight - ALeft;
2913
  until ARight = 0;
2914

2915
  // Restore common factors of 2.
2916
  Result := ALeft shl Shift;
2917
end;
2918

2919
class procedure BigInteger.Hexadecimal;
2920
begin
2921
  FBase := 16;
2922
end;
2923

2924
class procedure BigInteger.Hex;
2925
begin
2926
  FBase := 16;
2927
end;
2928

2929
class operator BigInteger.Implicit(const Int: Cardinal): BigInteger;
2930
begin
2931
  Result := BigInteger.Create(Int);
2932
end;
2933

2934
class operator BigInteger.Implicit(const Int: Integer): BigInteger;
2935
begin
2936
  Result := BigInteger.Create(Int);
2937
end;
2938

2939
class operator BigInteger.Implicit(const Int: UInt64): BigInteger;
2940
begin
2941
  Result := BigInteger.Create(Int);
2942
end;
2943

2944
class operator BigInteger.Implicit(const Int: Int64): BigInteger;
2945
begin
2946
  Result := BigInteger.Create(Int);
2947
end;
2948

2949
class constructor BigInteger.Initialize;
2950
begin
2951
  MinusOne := -1;
2952
  Zero.FSize := 0;
2953
  Zero.FData := nil;
2954
  One := 1;
2955
  Ten := 10;
2956
  FBase := 10;
2957
  FRoundingMode := rmTruncate;
2958
{$IFNDEF PUREPASCAL}
2959
  // See comments in BigInteger.InternalAddEmu.
2960
  BigInteger.DetectPartialFlagsStall;
2961
{$ELSE}
2962
  FInternalAdd := InternalAddPurePascal;
2963
  FInternalSubtract := InternalSubtractPurePascal;
2964
{$ENDIF}
2965
end;
2966

2967
class operator BigInteger.IntDivide(const Left, Right: BigInteger): BigInteger;
2968
begin
2969
  Result := Divide(Left, Right);
2970
end;
2971

2972
class operator BigInteger.IntDivide(const Left: BigInteger; Right: UInt16): BigInteger;
2973
begin
2974
  Result := Divide(Left, Right);
2975
end;
2976

2977
class operator BigInteger.IntDivide(const Left: BigInteger; Right: UInt32): BigInteger;
2978
begin
2979
  Result := Divide(Left, Right);
2980
end;
2981

2982
{$IFNDEF PUREPASCAL}
2983
class procedure BigInteger.InternalAddModified(Left, Right, Result: PLimb; LSize, RSize: Integer);
2984
{$IFDEF WIN32}
2985
asm
2986
        PUSH    ESI
2987
        PUSH    EDI
2988
        PUSH    EBX
2989

2990
        MOV     ESI,EAX
2991
        MOV     EDI,EDX
2992
        MOV     EBX,ECX
2993

2994
        MOV     ECX,RSize
2995
        MOV     EDX,LSize
2996

2997
        CMP     EDX,ECX
2998
        JAE     @SkipSwap
2999
        XCHG    ECX,EDX
3000
        XCHG    ESI,EDI
3001

3002
@SkipSwap:
3003

3004
        SUB     EDX,ECX
3005
        PUSH    EDX
3006
        XOR     EDX,EDX
3007

3008
        XOR     EAX,EAX
3009

3010
        MOV     EDX,ECX
3011
        AND     EDX,CunrollMask
3012
        SHR     ECX,CunrollShift
3013

3014
        CLC
3015
        JE      @MainTail
3016

3017
@MainLoop:
3018

3019
        MOV     EAX,[ESI]
3020
        ADC     EAX,[EDI]
3021
        MOV     [EBX],EAX
3022

3023
        MOV     EAX,[ESI + CLimbSize]
3024
        ADC     EAX,[EDI + CLimbSize]
3025
        MOV     [EBX + CLimbSize],EAX
3026

3027
        MOV     EAX,[ESI + 2*CLimbSize]
3028
        ADC     EAX,[EDI + 2*CLimbSize]
3029
        MOV     [EBX + 2*CLimbSize],EAX
3030

3031
        MOV     EAX,[ESI + 3*CLimbSize]
3032
        ADC     EAX,[EDI + 3*CLimbSize]
3033
        MOV     [EBX + 3*CLimbSize],EAX
3034

3035
        LEA     ESI,[ESI + CUnrollIncrement*CLimbSize]
3036
        LEA     EDI,[EDI + CUnrollIncrement*CLimbSize]
3037
        LEA     EBX,[EBX + CUnrollIncrement*CLimbSize]
3038

3039
        LEA     ECX,[ECX - 1]
3040
        JECXZ   @Maintail
3041
        JMP     @Mainloop
3042

3043
@MainTail:
3044

3045
        LEA     ESI,[ESI + EDX*CLimbSize]
3046
        LEA     EDI,[EDI + EDX*CLimbSize]
3047
        LEA     EBX,[EBX + EDX*CLimbSize]
3048

3049
        LEA     ECX,[@JumpsMain]
3050
        JMP     [ECX + EDX*TYPE Pointer]
3051

3052
        // Align jump table manually, with NOPs.
3053

3054
        NOP
3055

3056
@JumpsMain:
3057

3058
        DD      @DoRestLoop
3059
        DD      @Main1
3060
        DD      @Main2
3061
        DD      @Main3
3062

3063
@Main3:
3064

3065
        MOV     EAX,[ESI - 3*CLimbSize]
3066
        ADC     EAX,[EDI - 3*CLimbSize]
3067
        MOV     [EBX - 3*CLimbSize],EAX
3068

3069
@Main2:
3070

3071
        MOV     EAX,[ESI - 2*CLimbSize]
3072
        ADC     EAX,[EDI - 2*CLimbSize]
3073
        MOV     [EBX - 2*CLimbSize],EAX
3074

3075
@Main1:
3076

3077
        MOV     EAX,[ESI - CLimbSize]
3078
        ADC     EAX,[EDI - CLimbSize]
3079
        MOV     [EBX - CLimbSize],EAX
3080

3081
@DoRestLoop:
3082

3083
        SETC    AL                      // Save Carry Flag
3084

3085
        XOR     EDI,EDI
3086

3087
        POP     ECX
3088
        MOV     EDX,ECX
3089
        AND     EDX,CUnrollMask
3090
        SHR     ECX,CUnrollShift
3091

3092
        ADD     AL,255                  // Restore Carry Flag.
3093

3094
        JECXZ   @RestLastN
3095

3096
@RestLoop:
3097

3098
        MOV     EAX,[ESI]
3099
        ADC     EAX,EDI
3100
        MOV     [EBX],EAX
3101

3102
        MOV     EAX,[ESI + CLimbSize]
3103
        ADC     EAX,EDI
3104
        MOV     [EBX + CLimbSize],EAX
3105

3106
        MOV     EAX,[ESI + 2*CLimbSize]
3107
        ADC     EAX,EDI
3108
        MOV     [EBX + 2*CLimbSize],EAX
3109

3110
        MOV     EAX,[ESI + 3*CLimbSize]
3111
        ADC     EAX,EDI
3112
        MOV     [EBX + 3*CLimbSize],EAX
3113

3114
        LEA     ESI,[ESI + CUnrollIncrement*CLimbSize]
3115
        LEA     EBX,[EBX + CUnrollIncrement*CLimbSize]
3116

3117
        LEA     ECX,[ECX - 1]
3118
        JECXZ   @RestLastN
3119
        JMP     @RestLoop
3120

3121
@RestLastN:
3122

3123
        LEA     ESI,[ESI + EDX*CLimbSize]
3124
        LEA     EBX,[EBX + EDX*CLimbSize]
3125

3126
        LEA     ECX,[@RestJumps]
3127
        JMP     [ECX + EDX*TYPE Pointer]
3128

3129
        // Align jump table manually, with NOPs.
3130

3131
        NOP
3132

3133
@RestJumps:
3134

3135
        DD      @LastLimb
3136
        DD      @Rest1
3137
        DD      @Rest2
3138
        DD      @Rest3
3139

3140
@Rest3:
3141

3142
        MOV     EAX,[ESI - 3*CLimbSize]
3143
        ADC     EAX,EDI
3144
        MOV     [EBX - 3*CLimbSize],EAX
3145

3146
@Rest2:
3147

3148
        MOV     EAX,[ESI - 2*CLimbSize]
3149
        ADC     EAX,EDI
3150
        MOV     [EBX - 2*CLimbSize],EAX
3151

3152
@Rest1:
3153

3154
        MOV     EAX,[ESI - CLimbSize]
3155
        ADC     EAX,EDI
3156
        MOV     [EBX - CLimbSize],EAX
3157

3158
@LastLimb:
3159

3160
        ADC     EDI,EDI
3161
        MOV     [EBX],EDI
3162

3163
@Exit:
3164

3165
        POP     EBX
3166
        POP     EDI
3167
        POP     ESI
3168
end;
3169
{$ELSE WIN64}
3170
asm
3171
        MOV     R10,RCX
3172
        MOV     ECX,RSize
3173

3174
        CMP     R9D,ECX
3175
        JAE     @SkipSwap
3176
        XCHG    ECX,R9D
3177
        XCHG    R10,RDX
3178

3179
@SkipSwap:
3180

3181
        SUB     R9D,ECX
3182
        PUSH    R9
3183

3184
        MOV     R9D,ECX
3185
        AND     R9D,CUnrollMask
3186
        SHR     ECX,CUnrollShift
3187

3188
        CLC
3189
        JE      @MainTail
3190

3191
@MainLoop:
3192

3193
        MOV     RAX,[R10]
3194
        ADC     RAX,[RDX]
3195
        MOV     [R8],RAX
3196

3197
        MOV     RAX,[R10 + DLimbSize]
3198
        ADC     RAX,[RDX + DLimbSize]
3199
        MOV     [R8 + DLimbSize],RAX
3200

3201
        LEA     R10,[R10 + 2*DLimbSize]
3202
        LEA     RDX,[RDX + 2*DLimbSize]
3203
        LEA     R8,[R8 + 2*DLimbSize]
3204

3205
        LEA     RCX,[RCX - 1]
3206
        JECXZ   @MainTail
3207
        JMP     @MainLoop
3208

3209
@MainTail:
3210

3211
        LEA     RCX,[@MainJumps]
3212
        JMP     [RCX + R9*TYPE Pointer]
3213

3214
        // Align jump table manually, with NOPs.
3215

3216
        DB      $90,$90,$90,$90
3217

3218
@MainJumps:
3219

3220
        DQ      @DoRestLoop
3221
        DQ      @Main1
3222
        DQ      @Main2
3223
        DQ      @Main3
3224

3225
@Main3:
3226

3227
        MOV     RAX,[R10]
3228
        ADC     RAX,[RDX]
3229
        MOV     [R8],RAX
3230

3231
        MOV     EAX,[R10 + 2*CLimbSize]
3232
        ADC     EAX,[RDX + 2*CLimbSize]
3233
        MOV     [R8 + 2*CLimbSize],EAX
3234

3235
        LEA     R10,[R10 + 3*CLimbSize]
3236
        LEA     RDX,[RDX + 3*CLimbSize]
3237
        LEA     R8,[R8 + 3*CLimbSize]
3238

3239
        JMP     @DoRestLoop
3240

3241
@Main2:
3242

3243
        MOV     RAX,[R10]
3244
        ADC     RAX,[RDX]
3245
        MOV     [R8],RAX
3246

3247
        LEA     R10,[R10 + 2*CLimbSize]
3248
        LEA     RDX,[RDX + 2*CLimbSize]
3249
        LEA     R8,[R8 + 2*CLimbSize]
3250

3251
        JMP     @DoRestLoop
3252

3253
@Main1:
3254

3255
        MOV     EAX,[R10]
3256
        ADC     EAX,[RDX]
3257
        MOV     [R8],EAX
3258

3259
        LEA     R10,[R10 + CLimbSize]
3260
        LEA     RDX,[RDX + CLimbSize]
3261
        LEA     R8,[R8 + CLimbSize]
3262

3263
@DoRestLoop:
3264

3265
        SETC    AL                      // Save Carry Flag
3266

3267
        XOR     EDX,EDX
3268

3269
        POP     RCX
3270
        MOV     R9D,ECX
3271
        AND     R9D,CUnrollMask
3272
        SHR     ECX,CUnrollShift
3273

3274
        ADD     AL,255                  // Restore Carry Flag.
3275

3276
        JECXZ   @RestLast3
3277

3278
@RestLoop:
3279

3280
        MOV     RAX,[R10]
3281
        ADC     RAX,RDX
3282
        MOV     [R8],RAX
3283

3284
        MOV     RAX,[R10 + DLimbSize]
3285
        ADC     RAX,RDX
3286
        MOV     [R8 + DLimbSize],RAX
3287

3288
        LEA     R10,[R10 + 2*DLimbSize]
3289
        LEA     R8,[R8 + 2*DLimbSize]
3290

3291
        LEA     RCX,[RCX - 1]
3292
        JECXZ   @RestLast3
3293
        JMP     @RestLoop
3294

3295
@RestLast3:
3296

3297
        LEA     RCX,[@RestJumps]
3298
        JMP     [RCX + R9*TYPE Pointer]
3299

3300
        // If necessary, align second jump table with NOPs.
3301

3302
        DB      $90,$90,$90,$90,$90,$90
3303

3304
@RestJumps:
3305

3306
        DQ      @LastLimb
3307
        DQ      @Rest1
3308
        DQ      @Rest2
3309
        DQ      @Rest3
3310

3311
@Rest3:
3312

3313
        MOV     RAX,[R10]
3314
        ADC     RAX,RDX
3315
        MOV     [R8],RAX
3316

3317
        MOV     EAX,[R10 + 2*CLimbSize]
3318
        ADC     EAX,EDX
3319
        MOV     [R8 + 2*CLimbSize],EAX
3320

3321
        LEA     R8,[R8 + 3*CLimbSize]
3322

3323
        JMP     @LastLimb
3324

3325
@Rest2:
3326

3327
        MOV     RAX,[R10]
3328
        ADC     RAX,RDX
3329
        MOV     [R8],RAX
3330

3331
        LEA     R8,[R8 + 2*CLimbSize]
3332

3333
        JMP     @LastLimb
3334

3335
@Rest1:
3336

3337
        MOV     EAX,[R10]
3338
        ADC     EAX,EDX
3339
        MOV     [R8],EAX
3340

3341
        LEA     R8,[R8 + CLimbSize]
3342

3343
@LastLimb:
3344

3345
        ADC     EDX,EDX
3346
        MOV     [R8],EDX
3347

3348
@Exit:
3349

3350
end;
3351
{$ENDIF WIN32/WIN64}
3352

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

3355
//==============================================//
3356
//                                              //
3357
// To understand the code, please read this:    //
3358
//                                              //
3359
//   http://stackoverflow.com/q/32084204/95954  //
3360
//                                              //
3361
// especially Peter Cordes' answer:             //
3362
//                                              //
3363
//   http://stackoverflow.com/a/32087095/95954  //
3364
//                                              //
3365
//==============================================//
3366

3367
{$IFDEF WIN32}
3368
asm
3369
        PUSH    ESI
3370
        PUSH    EDI
3371
        PUSH    EBX
3372

3373
        MOV     ESI,EAX                         // Left
3374
        MOV     EDI,EDX                         // Right
3375
        MOV     EBX,ECX                         // Result
3376

3377
        MOV     ECX,RSize
3378
        MOV     EDX,LSize
3379

3380
        CMP     EDX,ECX
3381
        JAE     @SkipSwap
3382
        XCHG    ECX,EDX
3383
        XCHG    ESI,EDI
3384

3385
@SkipSwap:
3386

3387
        SUB     EDX,ECX
3388
        PUSH    EDX
3389
        XOR     EDX,EDX
3390

3391
        XOR     EAX,EAX
3392

3393
        MOV     EDX,ECX
3394
        AND     EDX,CUnrollMask
3395
        SHR     ECX,CUnrollShift
3396

3397
        CLC
3398
        JE      @MainTail
3399

3400
@MainLoop:
3401

3402
        MOV     EAX,[ESI]
3403
        ADC     EAX,[EDI]
3404
        MOV     [EBX],EAX
3405

3406
        MOV     EAX,[ESI + CLimbSize]
3407
        ADC     EAX,[EDI + CLimbSize]
3408
        MOV     [EBX + CLimbSize],EAX
3409

3410
        MOV     EAX,[ESI + 2*CLimbSize]
3411
        ADC     EAX,[EDI + 2*CLimbSize]
3412
        MOV     [EBX + 2*CLimbSize],EAX
3413

3414
        MOV     EAX,[ESI + 3*CLimbSize]
3415
        ADC     EAX,[EDI + 3*CLimbSize]
3416
        MOV     [EBX + 3*CLimbSize],EAX
3417

3418
        LEA     ESI,[ESI + 4*CLimbSize]
3419
        LEA     EDI,[EDI + 4*CLimbSize]
3420
        LEA     EBX,[EBX + 4*CLimbSize]
3421

3422
        DEC     ECX
3423
        JNE     @MainLoop
3424

3425
@MainTail:
3426

3427
        LEA     ESI,[ESI + EDX*CLimbSize]
3428
        LEA     EDI,[EDI + EDX*CLimbSize]
3429
        LEA     EBX,[EBX + EDX*CLimbSize]
3430

3431
        LEA     ECX,[@JumpsMain]
3432
        JMP     [ECX + EDX*TYPE Pointer]
3433

3434
        // Align jump table manually, with NOPs. Update if necessary.
3435

3436
        NOP
3437

3438
@JumpsMain:
3439

3440
        DD      @DoRestLoop
3441
        DD      @Main1
3442
        DD      @Main2
3443
        DD      @Main3
3444

3445
@Main3:
3446

3447
        MOV     EAX,[ESI - 3*CLimbSize]
3448
        ADC     EAX,[EDI - 3*CLimbSize]
3449
        MOV     [EBX - 3*CLimbSize],EAX
3450

3451
@Main2:
3452

3453
        MOV     EAX,[ESI - 2*CLimbSize]
3454
        ADC     EAX,[EDI - 2*CLimbSize]
3455
        MOV     [EBX - 2*CLimbSize],EAX
3456

3457
@Main1:
3458

3459
        MOV     EAX,[ESI - CLimbSize]
3460
        ADC     EAX,[EDI - CLimbSize]
3461
        MOV     [EBX - CLimbSize],EAX
3462

3463
@DoRestLoop:
3464

3465
        SETC    AL                      // Save Carry Flag
3466

3467
        XOR     EDI,EDI
3468

3469
        POP     ECX
3470
        MOV     EDX,ECX
3471
        AND     EDX,CUnrollMask
3472
        SHR     ECX,CUnrollShift
3473

3474
        ADD     AL,255                  // Restore Carry Flag.
3475

3476
        INC     ECX
3477
        DEC     ECX
3478
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
3479

3480
@RestLoop:
3481

3482
        MOV     EAX,[ESI]
3483
        ADC     EAX,EDI
3484
        MOV     [EBX],EAX
3485

3486
        MOV     EAX,[ESI + CLimbSize]
3487
        ADC     EAX,EDI
3488
        MOV     [EBX + CLimbSize],EAX
3489

3490
        MOV     EAX,[ESI + 2*CLimbSize]
3491
        ADC     EAX,EDI
3492
        MOV     [EBX + 2*CLimbSize],EAX
3493

3494
        MOV     EAX,[ESI + 3*CLimbSize]
3495
        ADC     EAX,EDI
3496
        MOV     [EBX + 3*CLimbSize],EAX
3497

3498
        LEA     ESI,[ESI + 4*CLimbSize]
3499
        LEA     EBX,[EBX + 4*CLimbSize]
3500

3501
        DEC     ECX
3502
        JNE     @RestLoop
3503

3504
@RestLast3:
3505

3506
        LEA     ESI,[ESI + EDX*CLimbSize]
3507
        LEA     EBX,[EBX + EDX*CLimbSize]
3508

3509
        LEA     ECX,[@RestJumps]
3510
        JMP     [ECX + EDX*TYPE Pointer]
3511

3512
        // If necessary, align second jump table with NOPs
3513

3514
        NOP
3515
        NOP
3516
        NOP
3517

3518
@RestJumps:
3519

3520
        DD      @LastLimb
3521
        DD      @Rest1
3522
        DD      @Rest2
3523
        DD      @Rest3
3524

3525
@Rest3:
3526

3527
        MOV     EAX,[ESI - 3*CLimbSize]
3528
        ADC     EAX,EDI
3529
        MOV     [EBX - 3*CLimbSize],EAX
3530

3531
@Rest2:
3532

3533
        MOV     EAX,[ESI - 2*CLimbSize]
3534
        ADC     EAX,EDI
3535
        MOV     [EBX - 2*CLimbSize],EAX
3536

3537
@Rest1:
3538

3539
        MOV     EAX,[ESI - CLimbSize]
3540
        ADC     EAX,EDI
3541
        MOV     [EBX - CLimbSize],EAX
3542

3543
@LastLimb:
3544

3545
        ADC     EDI,EDI
3546
        MOV     [EBX],EDI
3547

3548
@Exit:
3549

3550
        POP     EBX
3551
        POP     EDI
3552
        POP     ESI
3553
end;
3554
{$ELSE WIN64}
3555
asm
3556
        MOV     R10,RCX
3557
        MOV     ECX,RSize
3558

3559
        CMP     R9D,ECX
3560
        JAE     @SkipSwap
3561
        XCHG    ECX,R9D
3562
        XCHG    R10,RDX
3563

3564
@SkipSwap:
3565

3566
        SUB     R9D,ECX
3567
        PUSH    R9
3568

3569
        MOV     R9D,ECX
3570
        AND     R9D,CUnrollMask
3571
        SHR     ECX,CUnrollShift
3572

3573
        CLC
3574
        JE      @MainTail
3575

3576
@MainLoop:
3577

3578
        MOV     RAX,[R10]
3579
        ADC     RAX,[RDX]
3580
        MOV     [R8],RAX
3581

3582
        MOV     RAX,[R10 + DLimbSize]
3583
        ADC     RAX,[RDX + DLimbSize]
3584
        MOV     [R8 + DLimbSize],RAX
3585

3586
        LEA     R10,[R10 + 2*DLimbSize]
3587
        LEA     RDX,[RDX + 2*DLimbSize]
3588
        LEA     R8,[R8 + 2*DLimbSize]
3589

3590
        DEC     ECX
3591
        JNE     @MainLoop
3592

3593
@MainTail:
3594

3595
        LEA     RCX,[@MainJumps]
3596
        JMP     [RCX + R9*TYPE Pointer]
3597

3598
        // Align jump table. Update if necessary!
3599

3600
        NOP
3601

3602
@MainJumps:
3603

3604
        DQ      @DoRestLoop
3605
        DQ      @Main1
3606
        DQ      @Main2
3607
        DQ      @Main3
3608

3609
@Main3:
3610

3611
        MOV     RAX,[R10]
3612
        ADC     RAX,[RDX]
3613
        MOV     [R8],RAX
3614

3615
        MOV     EAX,[R10 + 2*CLimbSize]
3616
        ADC     EAX,[RDX + 2*CLimbSize]
3617
        MOV     [R8 + 2*CLimbSize],EAX
3618

3619
        LEA     R10,[R10 + 3*CLimbSize]
3620
        LEA     RDX,[RDX + 3*CLimbSize]
3621
        LEA     R8,[R8 + 3*CLimbSize]
3622

3623
        JMP     @DoRestLoop
3624

3625
@Main2:
3626

3627
        MOV     RAX,[R10]
3628
        ADC     RAX,[RDX]
3629
        MOV     [R8],RAX
3630

3631
        LEA     R10,[R10 + 2*CLimbSize]
3632
        LEA     RDX,[RDX + 2*CLimbSize]
3633
        LEA     R8,[R8 + 2*CLimbSize]
3634

3635
        JMP     @DoRestLoop
3636

3637
@Main1:
3638

3639
        MOV     EAX,[R10]
3640
        ADC     EAX,[RDX]
3641
        MOV     [R8],EAX
3642

3643
        LEA     R10,[R10 + CLimbSize]
3644
        LEA     RDX,[RDX + CLimbSize]
3645
        LEA     R8,[R8 + CLimbSize]
3646

3647
@DoRestLoop:
3648

3649
        SETC    AL                      // Save Carry Flag
3650

3651
        XOR     EDX,EDX
3652

3653
        POP     RCX
3654
        MOV     R9D,ECX
3655
        AND     R9D,CUnrollMask
3656
        SHR     ECX,CUnrollShift
3657

3658
        ADD     AL,255                  // Restore Carry Flag.
3659

3660
        INC     ECX
3661
        DEC     ECX
3662
        JE      @RestLast3
3663

3664
@RestLoop:
3665

3666
        MOV     RAX,[R10]
3667
        ADC     RAX,RDX
3668
        MOV     [R8],RAX
3669

3670
        MOV     RAX,[R10 + DLimbSize]
3671
        ADC     RAX,RDX
3672
        MOV     [R8 + DLimbSize],RAX
3673

3674
        LEA     R10,[R10 + 2*DLimbSize]
3675
        LEA     R8,[R8 + 2*DLimbSize]
3676

3677
        DEC     ECX
3678
        JNE     @RestLoop
3679

3680
@RestLast3:
3681

3682
        LEA     RCX,[@RestJumps]
3683
        JMP     [RCX + R9*TYPE Pointer]
3684

3685
        // If necessary, align second jump table with NOPs
3686

3687
        // -- Aligned.
3688

3689
@RestJumps:
3690

3691
        DQ      @LastLimb
3692
        DQ      @Rest1
3693
        DQ      @Rest2
3694
        DQ      @Rest3
3695

3696
@Rest3:
3697

3698
        MOV     RAX,[R10]
3699
        ADC     RAX,RDX
3700
        MOV     [R8],RAX
3701

3702
        MOV     EAX,[R10 + DLimbSize]
3703
        ADC     EAX,EDX
3704
        MOV     [R8 + DLimbSize],EAX
3705

3706
        LEA     R8,[R8 + 3*CLimbSize]
3707

3708
        JMP     @LastLimb
3709

3710
@Rest2:
3711

3712
        MOV     RAX,[R10]
3713
        ADC     RAX,RDX
3714
        MOV     [R8],RAX
3715

3716
        LEA     R8,[R8 + DLimbSize]
3717

3718
        JMP     @LastLimb
3719

3720
@Rest1:
3721

3722
        MOV     EAX,[R10]
3723
        ADC     EAX,EDX
3724
        MOV     [R8],EAX
3725

3726
        LEA     R8,[R8 + CLimbSize]
3727

3728
@LastLimb:
3729

3730
        ADC     EDX,EDX
3731
        MOV     [R8],EDX
3732

3733
@Exit:
3734

3735
end;
3736
{$ENDIF !WIN32}
3737
{$ENDIF !PUREPASCAL}
3738

3739
{$IFDEF PUREPASCAL}
3740
class procedure BigInteger.InternalAddPurePascal(Left, Right, Result: PLimb; LSize, RSize: Integer);
3741
var
3742
  I: Integer;
3743
  Carry, InterCarry: TLimb;
3744
  PTemp: PLimb;
3745
  LCount, LTail: Integer;
3746
  Sum: TLimb;
3747
{$IFDEF CPUX64}
3748
  Left64, Sum64, Carry64, InterCarry64: UInt64;
3749
{$ELSE}
3750
  Left32: TLimb;
3751
{$ENDIF}
3752
begin
3753
  if LSize < RSize then
3754
  begin
3755
    PTemp := Left;
3756
    Left := Right;
3757
    Right := PTemp;
3758
    I := LSize;
3759
    LSize := RSize;
3760
    RSize := I;
3761
  end;
3762
  // From here on,
3763
  // - Left is larger and LSize is its size,
3764
  // - Right is smaller and RSize is its size.
3765

3766
  // Emulate ADC (add with carry)
3767
  Carry := 0;
3768
  Dec(LSize, RSize);
3769

3770
  LTail := RSize and CUnrollMask;
3771
  LCount := RSize shr CUnrollShift;
3772

3773
{$IFDEF CPUX64}
3774
  Carry64 := 0;
3775
{$ENDIF}
3776
  while LCount > 0 do
3777
  begin
3778
{$IFDEF CPUX64}
3779
    Left64 := PUInt64(Left)[0];
3780
    Sum64 := Left64 + PUInt64(Right)[0];
3781
    InterCarry64 := Ord(Sum64 < Left64);
3782
    Inc(Sum64, Carry64);
3783
    PUInt64(Result)[0] := Sum64;
3784
    Carry64 := InterCarry64 or Ord(Sum64 < Carry64);
3785

3786
    Left64 := PUInt64(Left)[1];
3787
    Sum64 := Left64 + PUInt64(Right)[1];
3788
    InterCarry64 := Ord(Sum64 < Left64);
3789
    Inc(Sum64, Carry64);
3790
    PUInt64(Result)[1] := Sum64;
3791
    Carry64 := InterCarry64 or Ord(Sum64 < Carry64);
3792
{$ELSE !CPUX64}
3793
    Left32 := Left[0];
3794
    Sum := Left32 + Right[0];
3795
    InterCarry := TLimb(Sum < Left32);
3796
    Inc(Sum, Carry);
3797
    Result[0] := Sum;
3798
    Carry := InterCarry or TLimb(Sum < Carry);
3799

3800
    Left32 := Left[1];
3801
    Sum := Left32 + Right[1];
3802
    InterCarry := TLimb(Sum < Left32);
3803
    Inc(Sum, Carry);
3804
    Result[1] := Sum;
3805
    Carry := InterCarry or TLimb(Sum < Carry);
3806

3807
    Left32 := Left[2];
3808
    Sum := Left32 + Right[2];
3809
    InterCarry := TLimb(Sum < Left32);
3810
    Inc(Sum, Carry);
3811
    Result[2] := Sum;
3812
    Carry := InterCarry or TLimb(Sum < Carry);
3813

3814
    Left32 := Left[3];
3815
    Sum := Left32 + Right[3];
3816
    InterCarry := TLimb(Sum < Left32);
3817
    Inc(Sum, Carry);
3818
    Result[3] := Sum;
3819
    Carry := InterCarry or TLimb(Sum < Carry);
3820
{$ENDIF}
3821

3822
    Inc(Left, CUnrollIncrement);
3823
    Inc(Right, CUnrollIncrement);
3824
    Inc(Result, CUnrollIncrement);
3825
    Dec(LCount);
3826
  end;
3827

3828
{$IFDEF CPUX64}
3829
  Carry := Carry64;
3830
{$ENDIF}
3831

3832
  while LTail > 0 do
3833
  begin
3834
    Sum := Left[0] + Right[0];
3835
    InterCarry := TLimb(Sum < Left[0]);
3836
    Inc(Sum, Carry);
3837
    Result[0] := Sum;
3838
    Carry := TLimb(Sum < Carry) or InterCarry;
3839

3840
    Inc(Left);
3841
    Inc(Right);
3842
    Inc(Result);
3843
    Dec(LTail);
3844
  end;
3845

3846
  LTail := LSize and CUnrollMask;
3847
  LCount := LSize shr CunrollShift;
3848

3849
{$IFDEF CPUX64}
3850
  Carry64 := Carry;
3851
{$ENDIF}
3852

3853
  while LCount > 0 do
3854
  begin
3855
{$IFDEF CPUX64}
3856
    Sum64 := PUInt64(Left)[0] + Carry64;
3857
    PUInt64(Result)[0] := Sum64;
3858
    Carry64 := Ord(Sum64 < Carry64);
3859

3860
    Sum64 := PUInt64(Left)[1] + Carry64;
3861
    PUInt64(Result)[1] := Sum64;
3862
    Carry64 := Ord(Sum64 < Carry64);
3863
{$ELSE}
3864
    Sum := Left[0] + Carry;
3865
    Result[0] := Sum;
3866
    Carry := TLimb(Sum < Carry);
3867

3868
    Sum := Left[1] + Carry;
3869
    Result[1] := Sum;
3870
    Carry := TLimb(Sum < Carry);
3871

3872
    Sum := Left[2] + Carry;
3873
    Result[2] := Sum;
3874
    Carry := TLimb(Sum < Carry);
3875

3876
    Sum := Left[3] + Carry;
3877
    Result[3] := Sum;
3878
    Carry := TLimb(Sum < Carry);
3879
{$ENDIF}
3880

3881
    Inc(Left, CUnrollIncrement);
3882
    Inc(Result, CUnrollIncrement);
3883
    Dec(LCount);
3884
  end;
3885

3886
{$IFDEF CPUX64}
3887
  Carry := Carry64;
3888
{$ENDIF}
3889

3890
  while LTail > 0 do
3891
  begin
3892
    Sum := Left[0] + Carry;
3893
    Result[0] := Sum;
3894
    Carry := TLimb(Sum < Carry);
3895

3896
    Inc(Left);
3897
    Inc(Result);
3898
    Dec(LTail);
3899
  end;
3900

3901
  Result[0] := Carry;
3902
end;
3903
{$ENDIF}
3904

3905
class procedure BigInteger.InternalMultiply(Left, Right, Result: PLimb; LSize, RSize: Integer);
3906
{$IFDEF PUREPASCAL}
3907
type
3908
  TUInt64 = packed record
3909
    Lo, Hi: TLimb;
3910
  end;
3911
var
3912
  Product: UInt64;
3913
  LRest, LCount: Integer;
3914
  CurrentRightLimb: TLimb;
3915
  PLeft, PDest, PRight, PDestRowStart: PLimb;
3916
begin
3917
  if RSize > LSize then
3918
  begin
3919
    PDest := Left;
3920
    Left := Right;
3921
    Right := PDest;
3922
    LRest := LSize;
3923
    LSize := RSize;
3924
    RSize := LRest;
3925
  end;
3926

3927
  PRight := Right;
3928
  PDestRowStart := Result;
3929

3930
  PLeft := Left;
3931
  PDest := PDestRowStart;
3932
  Inc(PDestRowStart);
3933
  CurrentRightLimb := PRight^;
3934
  Inc(PRight);
3935
  TUInt64(Product).Hi := 0;
3936
  Dec(RSize);
3937
  LCount := LSize;
3938

3939
  while LCount > 0 do
3940
  begin
3941
    Product := UInt64(PLeft^) * CurrentRightLimb + TUInt64(Product).Hi;
3942
    PDest^ := TUInt64(Product).Lo;
3943
    Inc(PLeft);
3944
    Inc(PDest);
3945
    Dec(LCount);
3946
  end;
3947
  PDest^ := TUInt64(Product).Hi;
3948

3949
  LRest := LSize and CUnrollMask; // Low 2 bits: 0..3.
3950
  LSize := LSize shr CUnrollShift; // Divide by 4.
3951
  while RSize > 0 do
3952
  begin
3953
    PLeft := Left;
3954
    PDest := PDestRowStart;
3955
    Inc(PDestRowStart);
3956
    CurrentRightLimb := PRight^;
3957
    Inc(PRight);
3958

3959
    if CurrentRightLimb <> 0 then
3960
    begin
3961
      TUInt64(Product).Hi := 0;
3962
      LCount := LSize;
3963

3964
      // Inner loop, unrolled.
3965
      while LCount > 0 do
3966
      begin
3967
        Product := UInt64(PLeft[0]) * CurrentRightLimb + PDest[0] + TUInt64(Product).Hi;
3968
        PDest[0] := TUInt64(Product).Lo;
3969
        Product := UInt64(PLeft[1]) * CurrentRightLimb + PDest[1] + TUInt64(Product).Hi;
3970
        PDest[1] := TUInt64(Product).Lo;
3971
        Product := UInt64(PLeft[2]) * CurrentRightLimb + PDest[2] + TUInt64(Product).Hi;
3972
        PDest[2] := TUInt64(Product).Lo;
3973
        Product := UInt64(PLeft[3]) * CurrentRightLimb + PDest[3] + TUInt64(Product).Hi;
3974
        PDest[3] := TUInt64(Product).Lo;
3975

3976
        Inc(PLeft, CUnrollIncrement);
3977
        Inc(PDest, CunrollIncrement);
3978
        Dec(LCount);
3979
      end;
3980

3981
      // Rest loop.
3982
      LCount := LRest;
3983
      while LCount > 0 do
3984
      begin
3985
        Product := UInt64(PLeft^) * CurrentRightLimb + PDest^ + TUInt64(Product).Hi;
3986
        PDest^ := TUInt64(Product).Lo;
3987
        Inc(PLeft);
3988
        Inc(PDest);
3989
        Dec(LCount);
3990
      end;
3991

3992
      // Last (top) limb of this row.
3993
      PDest^ := TUInt64(Product).Hi;
3994
    end;
3995
    Dec(RSize);
3996
  end;
3997
end;
3998
{$ELSE !PUREPASCAL}
3999
{$IFDEF WIN32)}
4000
var
4001
  SaveResult: PLimb;
4002
  LRest, LCount: Integer;
4003
  PRight, PDestRowStart: PLimb;
4004
  LLeft, LRight: PLimb;
4005
asm
4006
        PUSH    ESI
4007
        PUSH    EDI
4008
        PUSH    EBX
4009

4010
        MOV     SaveResult,ECX
4011

4012
        MOV     ESI,LSize
4013
        MOV     EDI,RSize
4014
        CMP     ESI,EDI
4015
        JA      @SkipSwap
4016

4017
        XCHG    EAX,EDX
4018
        XCHG    ESI,EDI
4019
        MOV     LSize,ESI
4020
        MOV     RSize,EDI
4021

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

4024
@SkipSwap:
4025

4026
        MOV     LLeft,EAX
4027
        MOV     LRight,EDX
4028

4029
// First loop, setting up first row:
4030

4031
        MOV     PRight,EDX
4032
        MOV     EDI,SaveResult
4033
        MOV     PDestRowStart,EDI               // EDI = PDest
4034

4035
        MOV     ESI,LLeft                       // ESI = PLeft
4036

4037
// If CurrentLimbRight = 0, we can skip a lot, and simply do a FillChar
4038

4039
        MOV     ECX,[EDX]                       // CurrentRightLimb
4040
        XOR     EBX,EBX                         // PreviousProductHi
4041
        ADD     PDestRowStart,CLimbSize
4042
        ADD     PRight,CLimbSize
4043
        MOV     EAX,LSize
4044
        MOV     LCount,EAX
4045

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

4048
@SetupLoop:
4049

4050
        MOV     EAX,[ESI]
4051
        MUL     EAX,ECX                         // Uses MUL EAX,ECX syntax because of bug in XE2 assembler.
4052
        ADD     EAX,EBX
4053
        ADC     EDX,0
4054
        MOV     [EDI],EAX
4055
        MOV     EBX,EDX
4056
        LEA     ESI,[ESI + CLimbSize]
4057
        LEA     EDI,[EDI + CLimbSize]
4058
        DEC     LCount
4059
        JNE     @SetupLoop
4060
        MOV     [EDI],EDX
4061

4062
        MOV     EAX,LSize
4063
        MOV     EDX,EAX
4064
        SHR     EAX,CUnrollShift
4065
        MOV     LSize,EAX
4066
        AND     EDX,CUnrollMask
4067
        MOV     LRest,EDX
4068

4069
        DEC     RSize
4070
        JE      @Exit
4071

4072
// The outer loop iterates over the limbs of the shorter operand. After the setup loop, the lowest limb
4073
// has already been taken care of.
4074

4075
@OuterLoop:
4076

4077
        MOV     ESI,LLeft
4078
        MOV     EDI,PDestRowStart
4079
        ADD     PDestRowStart,CLimbSize
4080
        MOV     EAX,PRight
4081
        ADD     PRight,CLimbSize
4082

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

4085
        MOV     ECX,[EAX]
4086
        TEST    ECX,ECX
4087
        JE      @NextOuterLoop
4088

4089
        XOR     EBX,EBX
4090
        MOV     EAX,LSize
4091
        MOV     LCount,EAX
4092
        CMP     EAX,0
4093
        JE      @EndInnerLoop
4094

4095
@InnerLoop:
4096

4097
        // Loop unrolled. Approx. 70% faster than simple loop.
4098

4099
        MOV     EAX,[ESI]
4100
        MUL     EAX,ECX
4101
        ADD     EAX,[EDI]
4102
        ADC     EDX,0
4103
        ADD     EAX,EBX
4104
        ADC     EDX,0
4105
        MOV     [EDI],EAX
4106
        MOV     EBX,EDX
4107

4108
        MOV     EAX,[ESI + CLimbSize]
4109
        MUL     EAX,ECX
4110
        ADD     EAX,[EDI + CLimbSize]
4111
        ADC     EDX,0
4112
        ADD     EAX,EBX
4113
        ADC     EDX,0
4114
        MOV     [EDI + CLimbSize],EAX
4115
        MOV     EBX,EDX
4116

4117
        MOV     EAX,[ESI + 2*CLimbSize]
4118
        MUL     EAX,ECX
4119
        ADD     EAX,[EDI + 2*CLimbSize]
4120
        ADC     EDX,0
4121
        ADD     EAX,EBX
4122
        ADC     EDX,0
4123
        MOV     [EDI + 2*CLimbSize],EAX
4124
        MOV     EBX,EDX
4125

4126
        MOV     EAX,[ESI + 3*CLimbSize]
4127
        MUL     EAX,ECX
4128
        ADD     EAX,[EDI + 3*CLimbSize]
4129
        ADC     EDX,0
4130
        ADD     EAX,EBX
4131
        ADC     EDX,0
4132
        MOV     [EDI + 3*CLimbSize],EAX
4133
        MOV     EBX,EDX
4134

4135
        LEA     ESI,[ESI + 4*CLimbSize]
4136
        LEA     EDI,[EDI + 4*CLimbSize]
4137
        DEC     LCount
4138
        JNE     @InnerLoop
4139

4140
@EndInnerLoop:
4141

4142
        // The restant limbs to be handled.
4143

4144
        MOV     EAX,LRest
4145
        MOV     LCount,EAX
4146
        CMP     EAX,0
4147
        JE      @EndInnerRestLoop
4148

4149
@InnerRestLoop:
4150

4151
        MOV     EAX,[ESI]
4152
        MUL     EAX,ECX
4153
        ADD     EAX,EBX
4154
        ADC     EDX,0
4155
        ADD     EAX,[EDI]
4156
        ADC     EDX,0
4157
        MOV     [EDI],EAX
4158
        MOV     EBX,EDX
4159
        LEA     ESI,[ESI + CLimbSize]
4160
        LEA     EDI,[EDI + CLimbSize]
4161
        DEC     LCount
4162
        JNE     @InnerRestLoop
4163

4164
@EndInnerRestLoop:
4165

4166
        // The last (left) limb gets the top of the 64 bit product.
4167

4168
        MOV     [EDI],EBX
4169

4170
@NextOuterLoop:
4171

4172
        DEC     RSize
4173
        JNE     @OuterLoop
4174

4175
@Exit:
4176
        POP     EBX
4177
        POP     EDI
4178
        POP     ESI
4179
end;
4180
{$ELSE WIN64}
4181

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

4184
var
4185
  LeftOdd, RightOdd: Boolean;                   // Left, Right (resp.): odd number of limbs?
4186
  SaveLeft: PLimb;
4187
  LeftSize, RightSize: Integer;
4188
asm
4189
        .PUSHNV RSI
4190
        .PUSHNV RDI
4191
        .PUSHNV RBX
4192

4193
        MOV     EDI,RSize
4194
        CMP     R9D,EDI
4195
        JAE     @SwapEnd
4196

4197
        XCHG    RCX,RDX
4198
        XCHG    R9D,EDI
4199

4200
@SwapEnd:
4201

4202
        MOV     SaveLeft,RCX
4203

4204
        MOV     EAX,R9D
4205
        SHR     R9D,1
4206
        MOV     LeftSize,R9D            // Number of double limbs of Left
4207
        AND     AL,1
4208
        MOV     LeftOdd,AL              // Does Left have an odd number of limbs?
4209

4210
        MOV     EAX,EDI
4211
        SHR     EDI,1
4212
        MOV     RightSize,EDI           // Number of double limbs of Right
4213
        AND     AL,1
4214
        MOV     RightOdd,AL             // Does Right have an odd number of limbs?
4215

4216
        MOV     R10,RDX                 // Current limb to be multiplied
4217
        XOR     RBX,RBX                 // Top DWORD (EDX) of previous multiplication
4218

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

4221
        CMP     RightSize,0
4222
        JE      @FinalOddPart
4223

4224
        MOV     RCX,[R10]               // Current Right limb's value
4225
        MOV     RDI,R8                  // Result limb pointer
4226
        MOV     RSI,SaveLeft            // Left limb pointer
4227
        ADD     R8,DLimbSize            // Result's pointer to start of current row
4228
        ADD     R10,DLimbSize           // Current Right limb pointer
4229

4230
        MOV     R11D,LeftSize           // Loop counter
4231
        CMP     R11D,0
4232
        JE      @SetupOddPart
4233

4234
// Setup loop (64 bit part)
4235

4236
@SetupLoop64:
4237

4238
        MOV     RAX,[RSI]
4239
        MUL     RCX
4240
        ADD     RAX,RBX
4241
        ADC     RDX,0
4242
        MOV     [RDI],RAX
4243
        MOV     RBX,RDX
4244
        LEA     RSI,[RSI + DLimbSize]
4245
        LEA     RDI,[RDI + DLimbSize]
4246
        DEC     R11D
4247
        JNE     @SetupLoop64
4248

4249
// Setup loop, last limb ("odd" part).
4250

4251
@SetupOddPart:
4252

4253
        CMP     LeftOdd,0
4254
        JE      @SkipSetupOddPart
4255

4256
        MOV     EAX,[RSI]               // 32 bit register to read odd limb of this loop
4257
        MUL     RCX
4258
        ADD     RAX,RBX
4259
        ADC     RDX,0
4260
        MOV     [RDI],RAX
4261
        MOV     [RDI + DLimbSize],RDX
4262
        JMP     @SkipSkipSetupOddPart
4263

4264
@SkipSetupOddPart:
4265

4266
        MOV     [RDI],RDX
4267

4268
@SkipSkipSetupOddPart:
4269

4270
        DEC     RightSize
4271
        JE      @FinalOddPart
4272

4273
@OuterLoop:
4274

4275
        MOV     RDI,R8
4276
        ADD     R8,DLimbSize
4277
        MOV     RCX,[R10]
4278
        ADD     R10,DLimbSize
4279

4280
        TEST    RCX,RCX
4281
        JE      @NextOuterLoop
4282

4283
        MOV     RSI,SaveLeft
4284
        XOR     RBX,RBX
4285
        MOV     R11D,LeftSize
4286
        CMP     R11D,0
4287
        JE      @InnerLoopOddPart
4288

4289
        SHR     R11D,CUnrollShift
4290
        JE      @InnerTail64
4291

4292
@InnerLoop64:
4293

4294
        MOV     RAX,[RSI]               // Get double limb from Left data
4295
        MUL     RCX                     // multiply it with current Right double limb's value --> RDX:RAX
4296
        ADD     RAX,[RDI]               // Add current value in Result data
4297
        ADC     RDX,0
4298
        ADD     RAX,RBX                 // Add "carry", i.e. top double limb from previous multiplcation
4299
        ADC     RDX,0
4300
        MOV     [RDI],RAX               // Store in Result
4301
        MOV     RBX,RDX                 // And save top double limb as "carry".
4302

4303
        MOV     RAX,[RSI + DLimbSize]
4304
        MUL     RCX
4305
        ADD     RAX,[RDI + DLimbSize]
4306
        ADC     RDX,0
4307
        ADD     RAX,RBX
4308
        ADC     RDX,0
4309
        MOV     [RDI + DLimbSize],RAX
4310
        MOV     RBX,RDX
4311

4312
        MOV     RAX,[RSI + 2*DLimbSize]
4313
        MUL     RCX
4314
        ADD     RAX,[RDI + 2*DLimbSize]
4315
        ADC     RDX,0
4316
        ADD     RAX,RBX
4317
        ADC     RDX,0
4318
        MOV     [RDI + 2*DLimbSize],RAX
4319
        MOV     RBX,RDX
4320

4321
        MOV     RAX,[RSI + 3*DLimbSize]
4322
        MUL     RCX
4323
        ADD     RAX,[RDI + 3*DLimbSize]
4324
        ADC     RDX,0
4325
        ADD     RAX,RBX
4326
        ADC     RDX,0
4327
        MOV     [RDI + 3*DLimbSize],RAX
4328
        MOV     RBX,RDX
4329

4330
        LEA     RSI,[RSI + 4*DLimbSize]
4331
        LEA     RDI,[RDI + 4*DLimbSize]
4332
        DEC     R11D
4333
        JNE     @InnerLoop64
4334

4335
@InnerTail64:
4336

4337
        MOV     R11D,LeftSize
4338
        AND     R11D,CUnrollMask
4339
        JE      @InnerLoopOddPart
4340

4341
@InnerTailLoop64:
4342

4343
        MOV     RAX,[RSI]
4344
        MUL     RCX
4345
        ADD     RAX,[RDI]
4346
        ADC     RDX,0
4347
        ADD     RAX,RBX
4348
        ADC     RDX,0
4349
        MOV     [RDI],RAX
4350
        MOV     RBX,RDX
4351
        LEA     RSI,[RSI + DLimbSize]
4352
        LEA     RDI,[RDI + DLimbSize]
4353
        DEC     R11D
4354
        JNE     @InnerTailLoop64
4355

4356
@InnerLoopOddPart:
4357

4358
        CMP     LeftOdd,0               // If Left's size is odd, handle last limb.
4359
        JE      @InnerLoopLastLimb
4360

4361
        MOV     RAX,[RSI]
4362
        MUL     RCX
4363
        ADD     RAX,[RDI]
4364
        ADC     RDX,0
4365
        ADD     RAX,RBX
4366
        ADC     RDX,0
4367
        MOV     [RDI],RAX
4368
        MOV     [RDI + DLimbSize],RDX
4369
        JMP     @NextOuterLoop
4370

4371
@InnerLoopLastLimb:
4372

4373
        MOV     [RDI],RDX
4374

4375
@NextOuterLoop:
4376

4377
        DEC     RightSize
4378
        JNE     @OuterLoop
4379

4380
@FinalOddPart:
4381

4382
        CMP     RightOdd,0
4383
        JE      @Exit
4384

4385
        MOV     RDI,R8
4386
        MOV     RSI,SaveLeft
4387
        MOV     RAX,R10
4388
        MOV     ECX,[RAX]                      // Right is odd, so read single TLimb
4389
        XOR     RBX,RBX
4390
        MOV     R11D,LeftSize
4391
        CMP     R11D,0
4392
        JE      @SkipFinalLoop
4393

4394
@FinalLoop:
4395

4396
        MOV     RAX,[RSI]
4397
        MUL     RCX
4398
        ADD     RAX,[RDI]
4399
        ADC     RDX,0
4400
        ADD     RAX,RBX
4401
        ADC     RDX,0
4402
        MOV     [RDI],RAX
4403
        MOV     RBX,RDX
4404
        LEA     ESI,[ESI + DLimbSize]
4405
        LEA     EDI,[EDI + DLimbSize]
4406
        DEC     R11D
4407
        JNE     @FinalLoop
4408

4409
@SkipFinalLoop:
4410

4411
        CMP    LeftOdd,0
4412
        JE     @LastLimb
4413

4414
        MOV    EAX,[RSI]
4415
        MUL    RCX
4416
        ADD    RAX,[RDI]
4417
        ADC    RDX,0
4418
        ADD    RAX,RBX
4419
        ADC    RDX,0
4420
        MOV    [RDI],RAX
4421
        MOV    [RDI + DLimbSize],RDX
4422
        JMP    @Exit
4423

4424
@LastLimb:
4425

4426
        MOV    [RDI],RDX
4427

4428
@Exit:
4429

4430
end;
4431
{$ENDIF !WIN32}
4432
{$ENDIF !PUREPASCAL}
4433

4434
function BigInteger.ToBinaryString: string;
4435
begin
4436
  Result := ToString(2);
4437
end;
4438

4439
function BigInteger.ToByteArray: TArray<Byte>;
4440
var
4441
  Neg: TMagnitude;
4442
  Bytes, Bits: Integer;
4443
  ExtraByte: Byte;
4444
begin
4445
  if IsZero then
4446
  begin
4447
    SetLength(Result, 1);
4448
    Result[0] := 0;
4449
    Exit;
4450
  end;
4451

4452
  Bytes := BitLength;
4453
  Bits := Bytes and $07;
4454
  Bytes := (Bytes + 7) shr 3;
4455
  if FSize > 0 then
4456
  begin
4457
    Neg := FData;
4458
    ExtraByte := $00;
4459
  end
4460
  else
4461
  begin
4462
    SetLength(Neg, Size);
4463
    InternalNegate(PLimb(FData), PLimb(Neg), Size);
4464
    ExtraByte := $FF;
4465
  end;
4466
  SetLength(Result, Bytes + Byte(Bits = 0));
4467
  Move(Neg[0], Result[0], Bytes);
4468
  if Bits = 0 then
4469
    Result[Bytes] := ExtraByte;
4470
end;
4471

4472
function BigInteger.ToDecimalString: string;
4473
begin
4474
  Result := ToString(10);
4475
end;
4476

4477
function BigInteger.ToHexString: string;
4478
begin
4479
  Result := ToString(16);
4480
end;
4481

4482
function BigInteger.ToOctalString: string;
4483
begin
4484
  Result := ToString(8);
4485
end;
4486

4487
function BigInteger.ToString: string;
4488
begin
4489
  Result := ToString(FBase);
4490
end;
4491

4492
function BigInteger.ToString(Base: Integer): string;
4493
var
4494
  P: PChar;
4495
  LBuffer: TArray<Char>;
4496
  LMagnitude: PLimb;
4497
  LSize: Integer;
4498
begin
4499
  if not Base in [2..36] then
4500
    Error(ecInvalidArgument);
4501
  if FData = nil then
4502
  begin
4503
    Result := '0';
4504
    Exit;
4505
  end;
4506
  LSize := FSize and SizeMask;
4507
  SetLength(LBuffer, LSize * CStringMaxLengths[Base] + 1);
4508
  LMagnitude := PLimb(System.Copy(FData));
4509
  P := PChar(LBuffer) + Length(LBuffer);
4510
  Dec(P);
4511
  P^ := #0;
4512
  while LSize > 0 do
4513
  begin
4514
    Dec(P);
4515
    P^ := CBaseChars[InternalDivideByBase(LMagnitude, Base, LSize)];
4516
  end;
4517
  if FSize < 0 then
4518
  begin
4519
    Dec(P);
4520
    P^ := '-';
4521
  end;
4522
  Result := P;
4523
end;
4524

4525
// By default, uses FBase as numeric base, otherwise, if string "starts" with $, 0x, 0b or 0o, uses 16, 16 (both hex), 2 (binary) and 8 (octal) respectively.
4526
class function BigInteger.TryParse(const S: string; out Res: BigInteger; aBase : Integer): Boolean;
4527
var
4528
  LTrimmed: string;
4529
  LIsNegative: Boolean;
4530
  P: PChar;
4531
  LBase, LBaseNew: Integer;
4532
begin
4533
  Result := False;
4534
  LTrimmed := UpperCase(Trim(S)); // Make string case insensitive.
4535
  if LTrimmed = '' then
4536
    Exit;
4537
  LIsNegative := False;
4538
  P := PChar(LTrimmed);
4539
  if (P^ = '-') or (P^ = '+') then
4540
  begin
4541
    LIsNegative := (P^ = '-');
4542
    Inc(P);
4543
  end;
4544
  LBase := aBase;               // By default, use global numeric base.
4545
  case P^ of
4546
    '$':                        // $ prefix indicates hexadecimal (equivalent to 0x and %16r)
4547
      begin
4548
        Inc(P);
4549
        LBase := 16;
4550
      end;
4551
    '0':
4552
      begin
4553
        Inc(P);
4554
        case P^ of
4555
          #0:
4556
            begin
4557
              Res := Zero;
4558
              Exit(True);
4559
            end;
4560
          'B':                  // 0b prefix indicates binary (equivalent to %2r)
4561
            LBase := 2;
4562
          'O', 'K':             // 0o17, 0k17 prefixes indicate octal (equivalent to %8r)
4563
            LBase := 8;
4564
          'X':                  // 0x prefix indicates hexadecimal (equivalent to $ and %16r)
4565
            LBase := 16;
4566
          'D':
4567
            LBase := 10;
4568
          else
4569
            Dec(P);
4570
        end;
4571
        Inc(P);
4572
      end;
4573
    '%':                        // %nnr prefix indicates base n (nn is always decimal)
4574
      begin
4575
        Inc(P);
4576
        LBaseNew := 0;
4577
        while P^ <> 'R' do
4578
        begin
4579
          if P^ = #0 then
4580
            Exit;
4581
          LBaseNew := LBaseNew * 10 + Ord(P^) - CNumBase;
4582
          Inc(P);
4583
        end;
4584
        Inc(P);
4585
        if not (LBaseNew in [2..36]) then
4586
          Exit;
4587
        LBase := LBaseNew;
4588
      end;
4589
  end;
4590
  Result := TryParse(P, LBase, Res);
4591
  if Result and LIsNegative then
4592
    Res := -Res;
4593
end;
4594

4595
class function BigInteger.TryParse(const S: string; Base: TNumberBase; out Res: BigInteger): Boolean;
4596
var
4597
  LIsNegative: Boolean;
4598
  LTrimmed: string;
4599
  LVal: Integer;
4600
  P: PChar;
4601
begin
4602
  Result := False;
4603
  LTrimmed := Trim(S);
4604
  if LTrimmed = '' then
4605
    Exit;
4606
  LIsNegative := False;
4607
  Res.FSize := 0;
4608
  Res.MakeSize(Length(S) div CStringMinLengths[Base] + 4);
4609
  P := PChar(LTrimmed);
4610
  if (P^ = '-') or (P^ = '+') then
4611
  begin
4612
    LIsNegative := (P^ = '-');
4613
    Inc(P);
4614
  end;
4615
  while P^ <> #0 do
4616
  begin
4617
    if (P^ = '_') or (P^ = ' ') or (P = FormatSettings.ThousandSeparator) then
4618
    begin
4619
      Inc(P);
4620
      Continue;
4621
    end;
4622
    LVal := Ord(P^);
4623
    Inc(P);
4624
    if LVal in [Ord('0')..Ord('9')] then
4625
      Dec(LVal, CNumBase)
4626
    else if LVal >= CAlphaBase then
4627
    begin
4628
      if LVal >= Ord('a') then
4629
        Dec(LVal, 32);
4630
      Dec(LVal, CAlphaBase - 10);
4631
    end
4632
    else
4633
      Exit;
4634
    if LVal >= Base then
4635
      Exit;
4636
    InternalMultiplyAndAdd(Res.FData, Base, LVal, Res.FData);
4637
  end;
4638
  if LIsNegative then
4639
    Res := -Res;
4640
  Result := True;
4641
//  Res.Compact;
4642
end;
4643

4644
class procedure BigInteger.Decimal;
4645
begin
4646
  FBase := 10;
4647
end;
4648

4649
class function BigInteger.Divide(const Left: BigInteger; Right: UInt16): BigInteger;
4650
var
4651
  LSign: Integer;
4652
begin
4653
  if Right = 0 then
4654
    Error(ecDivByZero);
4655
  if Left.FData = nil then
4656
  begin
4657
    ShallowCopy(Zero, Result);
4658
    Exit;
4659
  end;
4660
  LSign := Left.FSize and SignMask;
4661
  Result.MakeSize(Left.FSize and SizeMask);
4662
  InternalDivMod16(PLimb(Left.FData), Right, PLImb(Result.FData), nil, Left.FSize and SizeMask);
4663
  Result.Compact;
4664
  if Result.FData <> nil then
4665
    Result.FSize := (Result.FSize and SizeMask) or LSign;
4666
end;
4667

4668
class function BigInteger.Divide(const Left: BigInteger; Right: UInt32): BigInteger;
4669
var
4670
  LSign: Integer;
4671
begin
4672
  if Right = 0 then
4673
    Error(ecDivByZero);
4674
  if Left.FData = nil then
4675
  begin
4676
    ShallowCopy(Zero, Result);
4677
    Exit;
4678
  end;
4679
  LSign := Left.FSize and SignMask;
4680
  Result.MakeSize(Left.FSize and SizeMask);
4681
  InternalDivMod32(PLimb(Left.FData), Right, PLimb(Result.FData), nil, Left.FSize and SizeMask);
4682
  Result.Compact;
4683
  if Result.FData <> nil then
4684
    Result.FSize := (Result.FSize and SizeMask) or LSign;
4685
end;
4686

4687
class function BigInteger.Divide(const Left, Right: BigInteger): BigInteger;
4688
var
4689
  Sign, LSize, RSize: Integer;
4690
  Remainder: BigInteger;
4691
begin
4692
  if Right.FData = nil then
4693
    Error(ecDivByZero);
4694

4695
  Sign := (Left.FSize and SignMask) xor (Right.FSize and SignMask);
4696
  LSize := Left.FSize and SizeMask;
4697
  RSize := Right.FSize and SizeMask;
4698

4699
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
4700
    -1:
4701
      begin
4702
        ShallowCopy(Zero, Result);
4703
      end;
4704
    0:
4705
      begin
4706
        if Sign = 0 then
4707
          ShallowCopy(One, Result)
4708
        else
4709
          ShallowCopy(MinusOne, Result);
4710
      end;
4711
    else
4712
      begin
4713
        if ShouldUseBurnikelZiegler(LSize, RSize) then
4714
          DivModBurnikelZiegler(Left, Right, Result, Remainder)
4715
        else
4716
          DivModKnuth(Left, Right, Result, Remainder);
4717

4718
        if Result.FSize <> 0 then
4719
          Result.FSize := (Result.FSize and SizeMask) or Sign;
4720
      end;
4721
  end;
4722
end;
4723

4724
function BigInteger.Divide(const Other: BigInteger): PBigInteger;
4725
begin
4726
  Result := @Self;
4727
  Self := Self div Other;
4728
end;
4729

4730
class procedure BigInteger.DivMod(const Dividend, Divisor: BigInteger; var Quotient, Remainder: BigInteger);
4731
var
4732
  LSign, RSign: Integer;
4733
  LSize, RSize: Integer;
4734
begin
4735
  if Divisor.FData = nil then
4736
    Error(ecDivByZero);
4737

4738
  LSign := SignBitOf(Dividend.FSize);
4739
  RSign := SignBitOf(Divisor.FSize);
4740
  LSize := Dividend.FSize and SizeMask;
4741
  RSize := Divisor.FSize and SizeMask;
4742

4743
  case InternalCompare(PLimb(Dividend.FData), PLimb(Divisor.FData), LSize, RSize) of
4744
    -1:
4745
      begin
4746
        ShallowCopy(Dividend, Remainder);
4747
        ShallowCopy(Zero, Quotient);
4748
        Exit;
4749
      end;
4750
    0:
4751
      begin
4752
        ShallowCopy(Zero, Remainder);
4753
        if LSign = RSign then
4754
          ShallowCopy(One, Quotient)
4755
        else
4756
          ShallowCopy(MinusOne, Quotient);
4757
        Exit;
4758
      end
4759
    else
4760
      begin
4761
        if ShouldUseBurnikelZiegler(LSize, RSize) then
4762
          DivModBurnikelZiegler(Dividend, Divisor, Quotient, Remainder)
4763
        else
4764
          DivModKnuth(Dividend, Divisor, Quotient, Remainder);
4765

4766
//        if Quotient.FSize <> 0 then
4767
//          Quotient.FSize := (Quotient.FSize and SizeMask) or (LSign xor RSign);
4768
//        if Remainder.FSize <> 0 then
4769
//          Remainder.FSize := (Remainder.FSize and SizeMask) or LSign;
4770
      end;
4771
  end;
4772
end;
4773

4774
class procedure BigInteger.DivModKnuth(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
4775
var
4776
  LSign, RSign: Integer;
4777
  LSize, RSize: Integer;
4778
begin
4779
  if Right.FData = nil then
4780
    Error(ecDivByZero);
4781

4782
  LSign := SignBitOf(Left.FSize);
4783
  RSign := SignBitOf(Right.FSize);
4784
  LSize := Left.FSize and SizeMask;
4785
  RSize := Right.FSize and SizeMask;
4786

4787
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
4788
    -1:
4789
      begin
4790
        ShallowCopy(Left, Remainder);
4791
        ShallowCopy(Zero, Quotient);
4792
        Exit;
4793
      end;
4794
    0:
4795
      begin
4796
        ShallowCopy(Zero, Remainder);
4797
        if LSign = RSign then
4798
          ShallowCopy(One, Quotient)
4799
        else
4800
          ShallowCopy(MinusOne, Quotient);
4801
        Exit;
4802
      end
4803
    else
4804
      begin
4805
        Quotient.MakeSize(LSize - RSize + 1);
4806
        Remainder.MakeSize(RSize);
4807
        if not InternalDivMod(PLimb(Left.FData), PLimb(Right.FData), PLimb(Quotient.FData), PLimb(Remainder.FData), LSize, RSize) then
4808
          Error(ecInvalidArg);
4809
        Quotient.Compact;
4810
        Remainder.Compact;
4811

4812
        if Quotient.FSize <> 0 then
4813
          Quotient.FSize := (Quotient.FSize and SizeMask) or (LSign xor RSign);
4814
        if Remainder.FSize <> 0 then
4815
          Remainder.FSize := (Remainder.FSize and SizeMask) or LSign;
4816
      end;
4817
  end;
4818
end;
4819

4820
class procedure BigInteger.InternalShiftLeft(Source, Dest: PLimb; Shift, Size: Integer);
4821
{$IF DEFINED(PUREPASCAL)}
4822
var
4823
  I: Integer;
4824
begin
4825
  Shift := Shift and 31;
4826
  if Shift = 0 then
4827
    CopyLimbs(Source, Dest, Size)
4828
  else
4829
  begin
4830
    Dest[Size] := Source[Size - 1] shr (CLimbBits - Shift);
4831
    for I := Size - 1 downto 1 do
4832
      Dest[I] := (Source[I] shl Shift) or (Source[I - 1] shr (CLimbBits - Shift));
4833
    Dest[0] := Source[0] shl Shift;
4834
  end;
4835
end;
4836
{$ELSEIF DEFINED(WIN32)}
4837
asm
4838
        PUSH    ESI
4839
        PUSH    EDI
4840
        PUSH    EBX
4841

4842
        MOV     ESI,EAX
4843
        MOV     EDI,EDX
4844

4845
        // No need to test for nil.
4846
        MOV     EBX,Size
4847

4848
        MOV     EAX,[ESI + CLimbSize*EBX]
4849
        DEC     EBX
4850
        JS      @LoopEnd
4851

4852
@ShiftLoop:
4853

4854
        MOV     EDX,[ESI + CLimbSize*EBX]
4855
        SHLD    EAX,EDX,CL
4856
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
4857
        MOV     EAX,EDX
4858

4859
@ShiftStart:
4860

4861
        DEC     EBX
4862
        JNS     @ShiftLoop
4863

4864
@LoopEnd:
4865

4866
        SHL     EAX,CL
4867
        MOV     [EDI],EAX
4868

4869
@Exit:
4870

4871
        POP     EBX
4872
        POP     EDI
4873
        POP     ESI
4874
end;
4875
{$ELSE}
4876
asm
4877
        XCHG    RCX,R8
4878
        MOV     R10,RDX
4879

4880
        MOV     EAX,[R8 + CLimbSize*R9]
4881
        DEC     R9D
4882
        JS      @LoopEnd
4883

4884
@ShiftLoop:
4885

4886
        MOV     EDX,[R8 + CLimbSize*R9]
4887
        SHLD    EAX,EDX,CL
4888
        MOV     [R10 + CLimbSize*R9 + CLimbSize],EAX
4889
        MOV     EAX,EDX
4890

4891
@ShiftStart:
4892

4893
        DEC     R9D
4894
        JNS     @ShiftLoop
4895

4896
@LoopEnd:
4897

4898
        SHL     EAX,CL
4899
        MOV     [R10],EAX
4900

4901
@Exit:
4902
end;
4903
{$IFEND}
4904

4905
class procedure BigInteger.InternalShiftRight(Source, Dest: PLimb; Shift, Size: Integer);
4906
{$IF DEFINED(PUREPASCAL)}
4907
var
4908
  I: Integer;
4909
begin
4910
  Shift := Shift and 31;
4911
  if Shift = 0 then
4912
    CopyLimbs(Source, Dest, Size)
4913
  else
4914
  begin
4915
    for I := 0 to Size - 1 do
4916
      Dest[I] := (Source[I] shr Shift) or (Source[I + 1] shl (CLimbBits - Shift));
4917
    Dest[Size - 1] := Source[Size - 1] shr Shift;
4918
  end;
4919
end;
4920
{$ELSEIF DEFINED(WIN32)}
4921
asm
4922
        PUSH    ESI
4923
        PUSH    EDI
4924
        PUSH    EBX
4925

4926
        MOV     ESI,EAX
4927
        MOV     EDI,EDX
4928
        MOV     EBX,Size
4929
        MOV     EAX,[ESI]
4930
        LEA     ESI,[ESI + CLimbSize]
4931
        DEC     EBX
4932
        JE      @EndLoop
4933

4934
@ShiftLoop:
4935

4936
        MOV     EDX,[ESI]
4937
        SHRD    EAX,EDX,CL
4938
        MOV     [EDI],EAX
4939
        MOV     EAX,EDX
4940
        LEA     ESI,[ESI + CLimbSize]
4941
        LEA     EDI,[EDI + CLimbSize]
4942
        DEC     EBX
4943
        JNE     @ShiftLoop
4944

4945
@EndLoop:
4946

4947
        SHR     EAX,CL
4948
        MOV     [EDI],EAX
4949

4950
@Exit:
4951

4952
        POP     EBX
4953
        POP     EDI
4954
        POP     ESI
4955
end;
4956
{$ELSE}
4957
asm
4958
        XCHG    RCX,R8                        // R8 = source, ECX = shift
4959

4960
        MOV     EAX,[R8]
4961
        LEA     R8,[R8 + CLimbSize]
4962
        DEC     R9D
4963
        JE      @LoopEnd
4964

4965
@ShiftLoop:
4966

4967
        MOV     R10D,[R8]
4968
        SHRD    EAX,R10D,CL
4969
        MOV     [RDX],EAX
4970
        MOV     EAX,R10D
4971
        LEA     RDX,[RDX + CLimbSize]
4972
        LEA     R8,[R8 + CLimbSize]
4973
        DEC     R9D
4974
        JNE     @ShiftLoop
4975

4976
@LoopEnd:
4977

4978
        SHR     EAX,CL
4979
        MOV     [RDX],EAX
4980

4981
@Exit:
4982

4983
end;
4984
{$IFEND}
4985

4986
type
4987
{$IFDEF CPUX64}
4988
  TDivLimb = UInt32;
4989
  TDblLimb = UInt64;
4990
{$ELSE}
4991
  TDivLimb = UInt16;
4992
  TDblLimb = UInt32;
4993
{$ENDIF}
4994
  PDivLimb = ^TDivLimb;
4995
  PDblLimb = ^TDblLimb;
4996

4997
const
4998
  CDivLimbBase = TDblLimb(High(TDivLimb)) + 1;
4999
  CDivLimbBits = SizeOf(TDivLimb) * 8;
5000
  CDblLimbBits = SizeOf(TDblLimb) * 8;
5001

5002
class function BigInteger.InternalDivMod16(Dividend: PLimb; Divisor: UInt16; Quotient, Remainder: PLimb; LSize: Integer): Boolean;
5003
{$IFDEF PUREPASCAL}
5004
// In PUREPASCAL, using 16-bit division with an intermediate 32-bit result turned out to be faster than
5005
// 32-bit division with an intermediate 64-bit result.
5006
type
5007
  PUInt16 = ^UInt16;
5008
var
5009
  J: Integer;
5010
  LRemainder: UInt16;
5011
begin
5012
  LSize := LSize + LSize;
5013

5014
  LRemainder := 0;
5015
  for J := LSize - 1 downto 0 do
5016
    Math.DivMod(Cardinal(LRemainder shl 16 + PUInt16(Dividend)[J]), Divisor, PUInt16(Quotient)[J], LRemainder);
5017

5018
  if Remainder <> nil then
5019
    Remainder[0] := LRemainder;
5020
  Exit(True);
5021
end;
5022
{$ELSE !PUREPASCAL}
5023
// In assembler, 32 bit division is faster, so promote divisor to 32 bit and use InternalDivMod32.
5024
begin
5025
  Result := InternalDivMod32(Dividend, UInt32(Divisor), Quotient, Remainder, LSize);
5026
end;
5027
{$ENDIF !PUREPASCAL}
5028

5029
class function BigInteger.InternalDivMod32(Dividend: PLimb; Divisor: UInt32; Quotient, Remainder: PLimb; LSize: Integer): Boolean;
5030
{$IFDEF PUREPASCAL}
5031
{$IFDEF CPUX86}
5032
begin
5033
  // In 32PP, plain division using System.Math.DivMod(UInt64, ...) is much slower than this:
5034
  Result := InternalDivMod(Dividend, @Divisor, Quotient, Remainder, LSize, 1);
5035
end;
5036
{$ELSE CPUX64}
5037
var
5038
  J: Integer;
5039
  LQuotient, LRemainder: UInt64;
5040
begin
5041
  LRemainder := 0;
5042
  for J := LSize - 1 downto 0 do
5043
  begin
5044
    // DivMod(UInt64, UInt64, var UInt64, var UInt64)
5045
    DivMod64(LRemainder * (UInt64(High(UInt32)) + 1) + Dividend[J], Divisor, LQuotient, LRemainder);
5046
    Quotient[J] := TLimb(LQuotient);
5047
  end;
5048
  if Remainder <> nil then
5049
    Remainder[0] := TLimb(LRemainder);
5050
  Exit(True);
5051
end;
5052
{$ENDIF CPUX64}
5053
{$ELSE !PUREPASCAL}
5054
{$IFDEF WIN32}
5055
asm
5056
        PUSH    ESI
5057
        PUSH    EDI
5058
        PUSH    EBX
5059

5060
        MOV     EBX,EDX
5061

5062
        MOV     EDI,LSize
5063
        LEA     ESI,[EAX + CLimbSize*EDI - CLimbSize]
5064
        LEA     ECX,[ECX + CLimbSize*EDI - CLimbSize]
5065
        XOR     EDX,EDX
5066

5067
        SHR     EDI,CUnrollShift
5068
        JE      @Tail
5069

5070
@DivLoop:
5071

5072
        MOV     EAX,[ESI]
5073
        DIV     EAX,EBX
5074
        MOV     [ECX],EAX
5075
        MOV     EAX,[ESI - CLimbSize]
5076
        DIV     EAX,EBX
5077
        MOV     [ECX - CLimbSize],EAX
5078
        MOV     EAX,[ESI - 2 * CLimbSize]
5079
        DIV     EAX,EBX
5080
        MOV     [ECX - 2 * CLimbSize],EAX
5081
        MOV     EAX,[ESI - 3 * CLimbSize]
5082
        DIV     EAX,EBX
5083
        MOV     [ECX - 3 * CLimbSize],EAX
5084
        LEA     ESI,[ESI - 4 * CLimbSize]
5085
        LEA     ECX,[ECX - 4 * CLimbSize]
5086
        DEC     EDI
5087
        JNE     @DivLoop
5088

5089
@Tail:
5090

5091
        MOV     EDI,LSize
5092
        AND     EDI,CUnrollMask
5093
        JE      @StoreRemainder
5094

5095
@TailLoop:
5096

5097
        MOV     EAX,[ESI]
5098
        DIV     EAX,EBX
5099
        MOV     [ECX],EAX
5100
        LEA     ESI,[ESI - CLimbSize]
5101
        LEA     ECX,[ECX - CLimbSize]
5102
        DEC     EDI
5103
        JNE     @TailLoop
5104

5105
@StoreRemainder:
5106

5107
        MOV     EBX,Remainder
5108
        OR      EBX,EBX
5109
        JE      @Exit
5110

5111
        MOV     [EBX],EDX
5112

5113
@Exit:
5114

5115
        POP     EBX
5116
        POP     EDI
5117
        POP     ESI
5118

5119
end;
5120
{$ELSE WIN64}
5121
asm
5122
        MOV     R10D,EDX
5123

5124
        MOV     R11D,LSize
5125
        LEA     RCX,[RCX + R11*CLimbSize]
5126
        LEA     R8,[R8 + R11*CLimbSize]
5127
        XOR     EDX,EDX
5128

5129
        SHR     R11D,CUnrollShift
5130
        JE      @Tail
5131

5132
@DivLoop:
5133

5134
        // Note: 64 bit division turned out to be considerably slower!
5135

5136
        MOV     EAX,[RCX - CLimbSize]
5137
        DIV     EAX,R10D                        // Uses DIV EAX,R10D syntax because of bug in XE 64 bit assembler.
5138
        MOV     [R8 - CLimbSize],EAX
5139

5140
        MOV     EAX,[RCX - 2 * CLimbSize]
5141
        DIV     EAX,R10D
5142
        MOV     [R8 - 2 * CLimbSize],EAX
5143

5144
        MOV     EAX,[RCX - 3 * CLimbSize]
5145
        DIV     EAX,R10D
5146
        MOV     [R8 - 3 * CLimbSize],EAX
5147

5148
        MOV     EAX,[RCX - 4 * CLimbSize]
5149
        DIV     EAX,R10D
5150
        MOV     [R8 - 4 * CLimbSize],EAX
5151

5152
        LEA     RCX,[RCX - 4 * CLimbSize]
5153
        LEA     R8,[R8 - 4 * CLimbSize]
5154
        DEC     R11D
5155
        JNE     @DivLoop
5156

5157
@Tail:
5158

5159
        MOV     R11D,LSize
5160
        AND     R11D,CUnrollMask
5161
        JE      @StoreRemainder
5162

5163
@TailLoop:
5164

5165
        MOV     EAX,[RCX - ClimbSize]
5166
        DIV     EAX,R10D
5167
        MOV     [R8 - CLimbSize],EAX
5168
        LEA     RCX,[RCX - CLimbSize]
5169
        LEA     R8,[R8 - CLimbSize]
5170
        DEC     R11D
5171
        JNE     @TailLoop
5172

5173
@StoreRemainder:
5174

5175
        OR      R9,R9
5176
        JE      @Exit
5177
        MOV     [R9],EDX
5178

5179
@Exit:
5180

5181
end;
5182
{$ENDIF}
5183
{$ENDIF PUREPASCAL}
5184

5185
class function BigInteger.InternalDivMod(Dividend, Divisor, Quotient, Remainder: PLimb; LSize, RSize: Integer): Boolean;
5186

5187
// Basecase division, see Knuth TAOCP, Vol. 2.
5188

5189
{$IF DEFINED(PUREPASCAL)}
5190
var
5191
  PDividend, PDivisor, PQuotient, PRemainder: PDivLimb;
5192
  NormDividend, NormDivisor: TArray<TDivLimb>;          // Normalized dividend and divisor
5193
  QHat: TDblLimb;                                       // Estimate quotient limb
5194
  RHat: TDblLimb;                                       // Remainder after calculating QHat
5195
  Product: TDblLimb;                                    // Product of limb and QHat
5196
  Shift, RevShift, I, J: Integer;                       // Help variables
5197
  NormDividendTop2, NormDivisorTop: TDblLimb;
5198
{$IF SizeOf(TDivLimb) = SizeOf(TLimb)}
5199
  Rem, Quot: UInt64;
5200
  Carry, Value: Int64;
5201
{$ELSE}
5202
//  Rem: TDivLimb;
5203
  Carry, Value: Integer;
5204
{$IFEND}
5205
begin
5206

5207
  Assert(SizeOf(TDblLimb) = 2 * SizeOf(TDivLimb));
5208
  PDividend := PDivLimb(Dividend);
5209
  PDivisor := PDivLimb(Divisor);
5210
  PQuotient := PDivLimb(Quotient);
5211
  PRemainder := PDivLimb(Remainder);
5212

5213
{$IF SizeOf(TLimb) > SizeOf(TDivLimb)}
5214
  LSize := LSize + LSize;
5215
  RSize := RSize + RSize;
5216

5217
  if PDivisor[RSize - 1] = 0 then
5218
    Dec(RSize);
5219
{$IFEND}
5220

5221
  // NOTE: In Win32, this uses 16-bit division (with 32-bit intermediate results) to avoid having to use
5222
  //       64-bit unsigned integers. This turned out to be (approx. 17%) faster than using 32-bit limbs.
5223
  //       In Win64, this uses 32-bit division with 64-bit intermediate results.
5224

5225
  if (LSize < RSize) then
5226
    Exit(False);
5227

5228
  while (RSize > 0) and (PDivisor[RSize - 1] = 0) do
5229
    Dec(RSize);
5230
  if RSize = 0 then
5231
    Exit(False);
5232

5233
  while (LSize > 0) and (PDividend[LSize - 1] = 0) do
5234
    Dec(LSize);
5235

5236

5237
  ////////////////////////////////////////////////////////////////////////////////////////////////////////////
5238
  /// Perhaps it makes sense to shift away common trailing zeroes, if divisor > certain size.              ///
5239
  /// Shifting should be pretty simple: simply remove any common zeroes in both dividend and divisor,      ///
5240
  /// generate an offset to the lowest non-zero limb and shift accordingly (when normalizing).             ///
5241
  /// Note that the remainder must be amended accordingly.                                                 ///
5242
  ////////////////////////////////////////////////////////////////////////////////////////////////////////////
5243

5244

5245
  if RSize = 1 then
5246
  begin
5247

5248
    // Handle single-digit divisor.
5249

5250
  {$IF SizeOf(TDivLimb) = SizeOf(TLimb)}
5251
    Exit(InternalDivMod32(Dividend, PDivisor[0], Quotient, Remainder, LSize));
5252
  {$ELSE}
5253
    Exit(InternalDivMod16(Dividend, PDivisor[0], Quotient, Remainder, (LSize + 1) div 2));
5254
  {$IFEND}
5255

5256
//    Rem := 0;
5257
//    for J := LSize - 1 downto 0 do
5258
//  {$IF SizeOf(TDivLimb) = SizeOf(TLimb)}
5259
//    begin
5260
//      // DivMod(UInt64, UInt64, var UInt64, var UInt64)
5261
//      System.Math.DivMod(Rem * CDivLimbBase + PDividend[J], PDivisor[0], Quot, Rem);
5262
//      PQuotient[J] := TDivLimb(Quot);
5263
//    end;
5264
//  {$ELSE}
5265
//      // DivMod(Cardinal, Word, var Word, var Word)
5266
//      System.Math.DivMod(Cardinal(Rem * CDivLimbBase + PDividend[J]), PDivisor[0], PQuotient[J], Rem);
5267
//  {$IFEND}
5268
//    if PRemainder <> nil then
5269
//      PRemainder[0] := TDivLimb(Rem);
5270
//    Exit(True);
5271
  end;
5272
  // Normalize by shifting divisor left just enough so that its high-order bit is set, and shift dividend left the
5273
  // same amount. A high-order digit is prepended to dividend unconditionally.
5274

5275
  // Get number of leading zeroes.
5276
  Shift := Velthuis.Numerics.NumberOfleadingZeros(PDivisor[RSize - 1]);            // 0 <= Shift < Bits.
5277
  RevShift := CDivLimbBits - Shift;
5278

5279
  // Normalize divisor and shift dividend left accordingly.
5280
  SetLength(NormDivisor, RSize);
5281
  SetLength(NormDividend, LSize + 1);
5282
  if Shift > 0 then
5283
  begin
5284
    for I := RSize - 1 downto 1 do
5285
      NormDivisor[I] := (PDivisor[I] shl Shift) or (PDivisor[I - 1] shr RevShift);
5286
    NormDivisor[0] := PDivisor[0] shl Shift;
5287

5288
    NormDividend[LSize] := PDividend[LSize - 1] shr RevShift;
5289
    for I := LSize - 1 downto 1 do
5290
      NormDividend[I] := (PDividend[I] shl Shift) or (PDividend[I - 1] shr RevShift);
5291
    NormDividend[0] := PDividend[0] shl Shift;
5292
  end
5293
  else
5294
  begin
5295
    // SizeOf(TDivLimb) is not always SizeOf(TLimb), so don't use MoveLimbs() here.
5296
    Move(PDivisor[0], NormDivisor[0], RSize * SizeOf(TDivLimb));
5297
    Move(PDividend[0], NormDividend[0], LSize * SizeOf(TDivLimb));
5298
  end;
5299

5300
  // Knuth's basecase algorithm.
5301

5302
  // Main loop.
5303
  for J := LSize - RSize downto 0 do
5304
  begin
5305
    NormDivisorTop := NormDivisor[RSize - 1];
5306
    NormDividendTop2 := PDblLimb(@NormDividend[J + RSize - 1])^;
5307

5308
    // QHat -- q^ in TAOCP -- is (first) estimate of Quotient[J]
5309
    QHat := NormDividendTop2 div NormDivisorTop;
5310

5311
    // RHat -- r^ in TAOCP -- is remainder belonging to q^.
5312
    RHat := NormDividendTop2 - QHat * NormDivisorTop;
5313

5314
    while (QHat * NormDivisor[RSize - 2] > RHat shl CDivLimbBits + NormDividend[J + RSize - 2]) or
5315
          (QHat >= CDivLimbBase) do
5316
    begin
5317
      Dec(QHat);
5318
      Inc(RHat, NormDivisorTop);
5319

5320
      if RHat >= CDivLimbBase then
5321
        Break;
5322
    end;
5323

5324
    // Multiply and subtract.
5325
    Carry := 0;
5326
    for I := 0 to RSize - 1 do
5327
    begin
5328
      Product := QHat * NormDivisor[I];
5329
      Value := NormDividend[I + J] - Carry - TDivLimb(Product);
5330
      NormDividend[I + J] := TDivLimb(Value);
5331
    {$IF SizeOf(TLimb) = SizeOf(TDivLimb)}
5332
      // Integer cast to force sign-extension of 'Value shr Bits'
5333
      Carry := Int64(Product shr CDivLimbBits) - Integer(Value shr CDivLimbBits);
5334
    {$ELSE}
5335
      // Smallint cast to force sign-extension of 'Value shr Bits'
5336
      Carry := Integer(Product shr CDivLimbBits) - Smallint(Value shr CDivLimbBits);
5337
    {$IFEND}
5338
    end;
5339
    Value := NormDividend[J + RSize] - Carry;
5340
    NormDividend[J + RSize] := Value;
5341

5342
    if Value < 0 then
5343
    begin
5344

5345
      // If too much was subtracted, add back.
5346
      Dec(QHat);
5347
      Value := 0;
5348
      for I := 0 to RSize - 1 do
5349
      begin
5350
        Value := NormDividend[I + J] + NormDivisor[I] + Value shr CDivLimbBits;
5351
        NormDividend[I + J] := TDivLimb(Value);
5352
      end;
5353
      Inc(NormDividend[J + RSize], Value shr CDivLimbBits);
5354
    end;
5355

5356
    PQuotient[J] := QHat;
5357
  end;
5358

5359
  // If the caller wants the remainder, unnormalize it and pass it back.
5360
  if PRemainder <> nil then
5361
    if Shift <> 0 then
5362
      for I := 0 to RSize - 1 do
5363
        PRemainder[I] := (TDblLimb(NormDividend[I]) shr Shift) or (TDblLimb(NormDividend[I + 1]) shl RevShift)
5364
    else
5365
      for I := 0 to RSize - 1 do
5366
        PRemainder[I] := NormDividend[I];
5367

5368
  Result := True;
5369
end;
5370
{$ELSEIF DEFINED(WIN32)}
5371
var
5372
  LDividend, LDivisor, LQuotient: PLimb;                // Local copies of passed registers
5373
  NormDividend, NormDivisor: PLimb;                     // Manually managed dynamic arrays
5374
  QHat, RHat, Product: TUInt64;                         // 64 bit intermediate results
5375
  Overflow: TLimb;                                      // "Carry" between multiplications
5376
  Shift: Integer;                                       // Normalization shift
5377
asm
5378
        PUSH    ESI
5379
        PUSH    EDI
5380
        PUSH    EBX
5381

5382
        // To avoid reference count problems with Delphi's dynamic array types, we do our own,
5383
        // "old school" dynarrays, using GetMem and FreeMem.
5384

5385
        XOR     EBX,EBX                         // Set "dynarrays" to nil, so the FreeMem calls won't fail.
5386
        MOV     NormDividend,EBX
5387
        MOV     NormDivisor,EBX
5388

5389
        MOV     LDividend,EAX
5390
        MOV     LDivisor,EDX
5391
        MOV     LQuotient,ECX
5392

5393
        MOV     ESI,LSize
5394
        MOV     EDI,RSize
5395
        CMP     ESI,EDI
5396
        JL      @ExitFalse
5397

5398
        DEC     EDI
5399
        JS      @ExitFalse
5400
        JNE     @MultiLimbDivisor
5401

5402
// Simple division
5403
//   Divisor only contains one single limb: simple division and exit.
5404

5405
@SingleLimbDivisor:
5406

5407
        MOV     EBX,[EDX]
5408
        DEC     ESI
5409
        MOV     EDI,EAX
5410
        XOR     EDX,EDX
5411

5412
@SingleDivLoop:
5413

5414
        MOV     EAX,[EDI + CLimbSize*ESI]
5415
        DIV     EAX,EBX
5416
        MOV     [ECX + CLimbSize*ESI],EAX
5417
        DEC     ESI
5418
        JNS     @SingleDivLoop
5419
        MOV     EAX,Remainder
5420
        TEST    EAX,EAX
5421
        JZ      @ExitTrue
5422
        MOV     [EAX],EDX
5423
        JMP     @ExitTrue
5424

5425
// Multilimb division
5426
//   Divisor contains more than one limb: basecase division as described in Knuth's TAoCP.
5427

5428
@MultiLimbDivisor:
5429

5430
        MOV     EAX,RSize                  // GetMem(NormDivisor, RSize * CLimbSize);
5431
        LEA     EAX,[EAX*CLimbSize]
5432
        CALL    System.AllocMem
5433
        MOV     NormDivisor,EAX
5434

5435
        MOV     EAX,LSize                 // GetMem(NormDividend, (LSize + 1) * CLimbSize);
5436
        INC     EAX
5437
        LEA     EAX,[EAX*CLimbSize]
5438
        CALL    System.AllocMem
5439
        MOV     NormDividend,EAX
5440

5441
// First: normalize Divisor by shifting left to eliminate leading zeroes
5442
//        and shift Dividend left by same number of bits.
5443

5444
        // Get number of leading Divisor zeros (into ECX).
5445

5446
        MOV     ESI,LDivisor
5447
        MOV     EBX,[ESI+CLimbSize*EDI]
5448
        BSR     EBX,EBX
5449
        MOV     ECX,31
5450
        SUB     ECX,EBX
5451
        MOV     Shift,ECX
5452

5453
        // Shift Divisor to NormDivisor by CL.
5454

5455
        MOV     EBX,EDI
5456
        MOV     EDI,NormDivisor
5457
        MOV     EAX,[ESI + CLimbSize*EBX]
5458
        JMP     @ShiftDivisor
5459

5460
@ShiftDivisorLoop:
5461

5462
        MOV     EDX,[ESI + CLimbSize*EBX]
5463
        SHLD    EAX,EDX,CL
5464
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
5465
        MOV     EAX,EDX
5466

5467
@ShiftDivisor:
5468

5469
        DEC     EBX
5470
        JNS     @ShiftDivisorLoop
5471

5472
        // Handle lowest limb.
5473

5474
        SHL     EAX,CL
5475
        MOV     [EDI],EAX
5476

5477
        // Shift Dividend to NormDividend by CL.
5478

5479
        MOV     EBX,LSize
5480
        MOV     ESI,LDividend
5481
        MOV     EDI,NormDividend
5482
        XOR     EAX,EAX
5483
        JMP     @ShiftDividend
5484

5485
@ShiftDividendLoop:
5486

5487
        MOV     EDX,[ESI + CLimbSize*EBX]
5488
        SHLD    EAX,EDX,CL
5489
        MOV     [EDI + CLimbSize*EBX + CLimbSize],EAX
5490
        MOV     EAX,EDX
5491

5492
@ShiftDividend:
5493

5494
        DEC     EBX
5495
        JNS     @ShiftDividendLoop
5496

5497
        // Handle lowest limb.
5498

5499
        SHL     EAX,CL
5500
        MOV     [EDI],EAX
5501

5502
        MOV     EBX,LSize
5503
        MOV     ECX,RSize
5504

5505
        MOV     ESI,NormDividend
5506
        MOV     EDI,NormDivisor
5507
        LEA     EDI,[EDI + CLimbSize*ECX - CLimbSize]
5508

5509
@MainLoop:
5510

5511
        XOR     EDX,EDX
5512
        MOV     EAX,[ESI + CLimbSize*EBX]
5513
        DIV     EAX,[EDI]
5514
        MOV     QHat.Hi,EAX
5515
        MOV     EAX,[ESI + CLimbSize*EBX - CLimbSize]
5516
        DIV     EAX,[EDI]
5517
        MOV     QHat.Lo,EAX
5518
        MOV     RHat.Lo,EDX
5519
        XOR     EDX,EDX
5520
        MOV     RHat.Hi,EDX
5521

5522
@CheckAdjust:
5523

5524
        CMP     QHat.Hi,0
5525
        JNE     @DoAdjust
5526
        MOV     EAX,QHat.Lo
5527
        MUL     EAX,[EDI - CLimbSize]
5528

5529
        CMP     EDX,RHat.Lo
5530
        JA      @DoAdjust
5531
        JB      @AdjustEnd
5532
        CMP     EAX,[ESI + CLimbSize*EBX - 2*CLimbSize]
5533
        JBE     @AdjustEnd
5534

5535
@DoAdjust:
5536

5537
        SUB     QHat.Lo,1
5538
        SBB     QHat.Hi,0
5539
        MOV     EAX,[EDI]
5540
        ADD     RHat.Lo,EAX
5541
        ADC     RHat.Hi,0
5542
        JZ      @CheckAdjust
5543

5544
@AdjustEnd:
5545

5546
        // Now multiply NormDivisor by QHat and subtract the product from NormDividend[J].
5547

5548
        // Save a few registers.
5549

5550
        PUSH    EDI
5551
        PUSH    EBX
5552
        PUSH    ECX
5553

5554
        MOV     ECX,EBX
5555
        SUB     ECX,RSize
5556
        LEA     EDI,[ESI + CLimbSize*ECX]
5557
        MOV     EAX,LQuotient
5558
        MOV     EDX,QHat.Lo
5559
        MOV     [EAX + CLimbSize*ECX],EDX
5560
        XOR     EBX,EBX
5561
        MOV     Overflow,EBX
5562

5563
@SubtractProduct:
5564

5565
        MOV     EAX,NormDivisor
5566
        MOV     EAX,[EAX + CLimbSize*EBX]
5567
        MUL     EAX,QHat.Lo
5568
        MOV     Product.Lo,EAX
5569
        MOV     Product.Hi,EDX
5570
        XOR     EDX,EDX
5571
        MOV     EAX,[EDI + CLimbSize*EBX]
5572
        SUB     EAX,Overflow
5573
        SBB     EDX,0
5574
        SUB     EAX,Product.Lo
5575
        SBB     EDX,0
5576
        MOV     [EDI + CLimbSize*EBX],EAX
5577
        MOV     EAX,Product.Hi
5578
        SUB     EAX,EDX
5579
        MOV     Overflow,EAX
5580
        INC     EBX
5581
        CMP     EBX,RSize
5582
        JL      @SubtractProduct
5583

5584
@SubtractProductEnd:
5585

5586
        MOV     EBX,[ESP + 4]
5587
        MOV     EDX,[ESI + CLimbSize*EBX]
5588
        SUB     EDX,Overflow
5589
        MOV     [ESI + CLimbSize*EBX],EDX
5590
        JNC     @SkipAddBack
5591

5592
        // Add normalized divisor back, if necessary:
5593

5594
        MOV     EAX,LQuotient
5595
        DEC     [EAX + CLimbSize*ECX]
5596
        XOR     EBX,EBX
5597
        MOV     Overflow,EBX
5598

5599
@AddBackLoop:
5600

5601
        CMP     EBX,RSize
5602
        JGE     @AddBackLoopEnd
5603
        XOR     EDX,EDX
5604
        MOV     EAX,NormDivisor
5605
        MOV     EAX,[EAX + CLimbSize*EBX]
5606
        ADD     EAX,Overflow
5607
        ADD     [EDI + CLimbSize*EBX],EAX
5608
        ADC     EDX,0
5609
        MOV     Overflow,EDX
5610
        INC     EBX
5611
        JMP     @AddBackLoop
5612

5613
@AddBackLoopEnd:
5614

5615
        MOV     EBX,[ESP + 4]
5616
        ADD     [ESI + CLimbSize*EBX],EDX
5617

5618
@SkipAddBack:
5619

5620
        POP     ECX
5621
        POP     EBX
5622
        POP     EDI
5623

5624
        // End of main loop; loop if required.
5625

5626
        DEC     EBX
5627
        CMP     EBX,ECX
5628
        JGE      @MainLoop
5629

5630
        // NormDividend now contains remainder, scaled by Shift.
5631
        // If Remainder <> nil, then shift NormDividend down into Remainder.
5632

5633
        MOV     EAX,Remainder
5634
        TEST    EAX,EAX
5635
        JE      @ExitTrue
5636
        XOR     EBX,EBX
5637
        MOV     ESI,NormDividend
5638
        MOV     EDI,EAX
5639
        MOV     ECX,Shift
5640
        MOV     EAX,[ESI + CLimbSize*EBX]
5641

5642
@RemainderLoop:
5643

5644
        MOV     EDX,[ESI + CLimbSize*EBX + CLimbSize]
5645
        SHRD    EAX,EDX,CL
5646
        MOV     [EDI + CLimbSize*EBX],EAX
5647
        MOV     EAX,EDX
5648
        INC     EBX
5649
        CMP     EBX,RSize
5650
        JL      @RemainderLoop
5651
        SHR     EDX,CL
5652
        MOV     [EDI + CLimbSize*EBX],EDX
5653
        JMP     @ExitTrue
5654

5655
@ExitFalse:
5656

5657
        MOV     BL,0
5658
        JMP     @Exit
5659

5660
@ExitTrue:
5661

5662
        MOV     BL,1
5663

5664
@Exit:
5665

5666
        // Clear dynamic arrays.
5667

5668
        MOV     EAX,NormDividend
5669
        CALL    System.@FreeMem
5670

5671
        MOV     EAX,NormDivisor
5672
        CALL    System.@FreeMem
5673

5674
        MOV     EAX,EBX
5675

5676
        POP     EBX
5677
        POP     EDI
5678
        POP     ESI
5679
end;
5680
{$ELSE}
5681
var
5682
  LDividend, LDivisor, LQuotient, LRemainder: PLimb;
5683
  NormDividend, NormDivisor: PLimb;
5684
  QHat, RHat, Product: TUInt64;
5685
  Overflow: TLimb;
5686
  Shift: Integer;
5687
  SaveRDI, SaveRBX, SaveRCX: NativeUInt;
5688
asm
5689
        .PUSHNV RSI
5690
        .PUSHNV RDI
5691
        .PUSHNV RBX
5692

5693
        // To avoid reference count problems with Delphi's dynamic array types, we do or own,
5694
        // "old school" dynarrays, using GetMem and FreeMem.
5695

5696
        XOR     EBX,EBX                 // Set "dynarrays" to nil, so FreeMem calls won't fail.
5697
        MOV     NormDividend,RBX
5698
        MOV     NormDivisor,RBX
5699

5700
        MOV     LDividend,RCX
5701
        MOV     LDivisor,RDX
5702
        MOV     LQuotient,R8
5703
        MOV     LRemainder,R9
5704

5705
        MOV     ESI,LSize
5706
        MOV     EDI,RSize
5707
        CMP     ESI,EDI
5708
        JL      @ExitFalse
5709

5710
        DEC     EDI
5711
        JS      @ExitFalse
5712
        JNE     @MultiLimbDivisor
5713

5714
// Simple division
5715
//   Divisor only contains one single limb: simple division and exit.
5716
//   NOTE: 32 bit division is easier and probably faster than 64 bit, even in 64 bit mode. This was tested for Decimals.pas.
5717

5718
@SingleLimbDivisor:
5719

5720
        MOV     EBX,[RDX]
5721

5722
        DEC     ESI
5723
        MOV     RDI,RCX
5724
        XOR     EDX,EDX
5725

5726
@SingleDivLoop:
5727

5728
        MOV     EAX,[RDI + CLimbSize*RSI]
5729

5730
        // ---------------------------------------------------------------------------------------------------------------------- //
5731
        // NOTE: In XE2, in 64 bit asm, "DIV <r/m32>" is generated as "DIV <r/m64>", but "DIV EAX,<r/m32>" is generated correctly. //
5732
        //       The same applies to "MUL <r/m32>".                                                                               //
5733
        // ---------------------------------------------------------------------------------------------------------------------- //
5734

5735
        DIV     EAX,EBX
5736
        MOV     [R8 + CLimbSize*RSI],EAX
5737
        DEC     ESI
5738
        JNS     @SingleDivLoop
5739
        MOV     RAX,LRemainder
5740
        TEST    RAX,RAX
5741
        JZ      @ExitTrue
5742
        MOV     [RAX],EDX
5743
        JMP     @ExitTrue
5744

5745
// MultiLimb division
5746
//   Divisor contains more than one limb: basecase division as described in Knuth's TAoCP Vol. 2.
5747

5748
@MultiLimbDivisor:
5749

5750
        MOV     ECX,RSize
5751
        ADD     ECX,ECX
5752
        ADD     ECX,ECX
5753
        CALL    System.AllocMem
5754
        MOV     NormDivisor,RAX
5755

5756
        MOV     ECX,LSize
5757
        INC     ECX
5758
        ADD     ECX,ECX
5759
        ADD     ECX,ECX
5760
        CALL    System.AllocMem
5761
        MOV     NormDividend,RAX
5762

5763
// First: normalize Divisor by shifting left to eliminate leading zeroes
5764
//        and shift Dividend left by same nubmer of bits.
5765

5766
        // Get number of leading Divisor zeroes (into ECX).
5767

5768
        MOV     RSI,LDivisor
5769
        MOV     EBX,[RSI + CLimbSize*RDI]
5770
        BSR     EBX,EBX
5771
        MOV     ECX,31
5772
        SUB     ECX,EBX
5773
        MOV     Shift,ECX
5774

5775
        // Shift Divisor to NormDivisor by CL.
5776

5777
        MOV     EBX,EDI
5778
        MOV     RDI,NormDivisor
5779
        MOV     EAX,[RSI + CLimbSize*RBX]
5780
        JMP     @ShiftDivisor
5781

5782
@ShiftDivisorLoop:
5783

5784
        MOV     EDX,[RSI + CLimbSize*RBX]
5785
        SHLD    EAX,EDX,CL
5786
        MOV     [RDI + CLimbSize*RBX + CLimbSize],EAX
5787
        MOV     EAX,EDX
5788

5789
@ShiftDivisor:
5790

5791
        DEC     EBX
5792
        JNS     @ShiftDivisorLoop
5793

5794
        // Handle lowest limb.
5795

5796
        SHL     EAX,CL
5797
        MOV     [RDI],EAX
5798

5799
        // Shift Dividend to NormDividend by CL.
5800

5801
        MOV     EBX,LSize
5802
        MOV     RSI,LDividend
5803
        MOV     RDI,NormDividend
5804
        XOR     EAX,EAX
5805
        JMP     @ShiftDividend
5806

5807
@ShiftDividendLoop:
5808

5809
        MOV     EDX,[RSI + CLimbSize*RBX]
5810
        SHLD    EAX,EDX,CL
5811
        MOV     [RDI + CLimbSize*RBX + CLimbSize],EAX
5812
        MOV     EAX,EDX
5813

5814
@ShiftDividend:
5815

5816
        DEC     EBX
5817
        JNS     @ShiftDividendLoop
5818

5819
        // Handle lowest limb.
5820

5821
        SHL     EAX,CL
5822
        MOV     [RDI],EAX
5823

5824
        MOV     EBX,LSize
5825
        MOV     ECX,RSize
5826

5827
        MOV     RSI,NormDividend
5828
        MOV     RDI,NormDivisor
5829
        LEA     RDI,[RDI + CLimbSize*RCX - CLimbSize]
5830

5831
@MainLoop:
5832

5833
        XOR     EDX,EDX
5834
        MOV     EAX,[RSI + CLimbSize*RBX]
5835
        DIV     EAX,[RDI]
5836
        MOV     QHat.Hi,EAX
5837
        MOV     EAX,[RSI + CLimbSize*RBX - CLimbSize]
5838
        DIV     EAX,[RDI]
5839
        MOV     QHat.Lo,EAX
5840
        MOV     RHat.Lo,EDX
5841
        XOR     EDX,EDX
5842
        MOV     RHat.Hi,EDX
5843

5844
@CheckAdjust:
5845

5846
        CMP     QHat.Hi,0
5847
        JNE     @DoAdjust
5848
        MOV     EAX,QHat.Lo
5849
        MUL     EAX,[RDI - CLimbSize]
5850

5851
        CMP     EDX,RHat.Lo
5852
        JA      @DoAdjust
5853
        JB      @AdjustEnd
5854
        CMP     EAX,[RSI + CLimbSize*RBX - 2*CLimbSize]
5855
        JBE     @AdjustEnd
5856

5857
@DoAdjust:
5858

5859
        SUB     QHat.Lo,1
5860
        SBB     QHat.Hi,0
5861
        MOV     EAX,[RDI]
5862
        ADD     RHat.Lo,EAX
5863
        ADC     RHat.Hi,0
5864
        JZ      @CheckAdjust
5865

5866
@AdjustEnd:
5867

5868
        MOV     SaveRDI,RDI
5869
        MOV     SaveRBX,RBX
5870
        MOV     SaveRCX,RCX
5871

5872
        MOV     ECX,EBX
5873
        SUB     ECX,RSize
5874
        LEA     RDI,[RSI + CLimbSize*RCX]
5875
        MOV     RAX,LQuotient
5876
        MOV     EDX,QHat.Lo
5877
        MOV     [RAX + CLimbSize*RCX],EDX
5878
        XOR     EBX,EBX
5879
        MOV     Overflow,EBX
5880

5881
@SubtractProduct:
5882

5883
        MOV     RAX,NormDivisor
5884
        MOV     EAX,[RAX + CLimbSize*RBX]
5885
        MUL     EAX,QHat.Lo
5886
        MOV     Product.Lo,EAX
5887
        MOV     Product.Hi,EDX
5888
        XOR     EDX,EDX
5889
        MOV     EAX,[RDI + CLimbSize*RBX]
5890
        SUB     EAX,Overflow
5891
        SBB     EDX,0
5892
        SUB     EAX,Product.Lo
5893
        SBB     EDX,0
5894
        MOV     [RDI + CLimbSize*RBX],EAX
5895
        MOV     EAX,Product.Hi
5896
        SUB     EAX,EDX
5897
        MOV     Overflow,EAX
5898
        INC     EBX
5899
        CMP     EBX,RSize
5900
        JL      @SubtractProduct
5901

5902
@SubtractProductEnd:
5903

5904
        MOV     RBX,SaveRBX
5905
        MOV     EDX,[RSI + CLimbSize*RBX]
5906
        SUB     EDX,Overflow
5907
        MOV     [RSI + CLimbSize*RBX],EDX
5908
        JNC     @SkipAddBack
5909

5910
        // Add normalized divisor back, if necessary:
5911

5912
        MOV     RAX,LQuotient
5913
        DEC     DWORD PTR [RAX + ClimbSize*RCX]
5914
        XOR     EBX,EBX
5915
        MOV     Overflow,EBX
5916

5917
@AddBackLoop:
5918

5919
        CMP     EBX,RSize
5920
        JGE     @AddBackLoopEnd
5921
        XOR     EDX,EDX
5922
        MOV     RAX,NormDivisor
5923
        MOV     EAX,[RAX + CLimbSize*RBX]
5924
        ADD     EAX,Overflow
5925
        ADD     [RDI + CLimbSize*RBX],EAX
5926
        ADC     EDX,0
5927
        MOV     Overflow,EDX
5928
        INC     EBX
5929
        JMP     @AddBackLoop
5930

5931
@AddBackLoopEnd:
5932

5933
        MOV     RBX,SaveRBX
5934
        ADD     [RSI + CLimbSize*RBX],EDX
5935

5936
@SkipAddBack:
5937

5938
        MOV     RCX,SaveRCX
5939
        MOV     RBX,SaveRBX
5940
        MOV     RDI,SaveRDI
5941

5942
        // End of main loop; loop if required
5943

5944
        DEC     EBX
5945
        CMP     EBX,ECX
5946
        JGE     @MainLoop
5947

5948
        // NormDividend now contains remainder, scaled by Shift.
5949
        // If Remainder <> nil, then shift NormDividend down into Remainder
5950

5951
        MOV     RAX,LRemainder
5952
        TEST    RAX,RAX
5953
        JE      @ExitTrue
5954
        XOR     EBX,EBX
5955
        MOV     RSI,NormDividend
5956
        MOV     RDI,RAX
5957
        MOV     ECX,Shift
5958
        MOV     EAX,[RSI + CLimbSize*RBX]
5959

5960
@RemainderLoop:
5961

5962
        MOV     EDX,[RSI + CLimbSize*RBX + CLimbSize]
5963
        SHRD    EAX,EDX,CL
5964
        MOV     [RDI + CLimbSize*RBX],EAX
5965
        MOV     EAX,EDX
5966
        INC     EBX
5967
        CMP     EBX,RSize
5968
        JL      @RemainderLoop
5969
        SHR     EDX,CL
5970
        MOV     [RDI + CLimbSize*RBX],EDX
5971
        JMP     @ExitTrue
5972

5973
@ExitFalse:
5974

5975
        MOV     BL,False
5976
        JMP     @Exit
5977

5978
@ExitTrue:
5979

5980
        MOV     BL,True
5981

5982
@Exit:
5983

5984
        // Clear dynamic arrays.
5985

5986
        MOV     RCX,NormDividend
5987
        CALL    System.@FreeMem
5988

5989
        MOV     RCX,NormDivisor
5990
        CALL    System.@FreeMem
5991

5992
        MOV     EAX,EBX
5993

5994
end;
5995
{$IFEND}
5996

5997
// Note: only handles Abs(Self) > 0.
5998
class procedure BigInteger.InternalIncrement(Limbs: PLimb; Size: Integer);
5999
{$IFDEF PUREPASCAL}
6000
var
6001
  N: TLimb;
6002
begin
6003
  N := MaxInt;
6004
  while Size > 0 do
6005
  begin
6006
    N := Limbs^;
6007
    Inc(N);
6008
    Limbs^ := N;
6009
    if N <> 0 then
6010
      Break;
6011
    Inc(Limbs);
6012
    Dec(Size);
6013
  end;
6014
  if N = 0 then
6015
  begin
6016
    Limbs^ := 1;
6017
  end;
6018
end;
6019
{$ELSE !PUREPASCAL}
6020
{$IFDEF WIN32}
6021
asm
6022

6023
        TEST    EDX,EDX
6024
        JE      @Exit
6025

6026
@Loop:
6027

6028
        MOV     ECX,[EAX]
6029
        INC     ECX
6030
        MOV     [EAX],ECX
6031
        TEST    ECX,ECX
6032
        JNE     @Exit
6033
        LEA     EAX,[EAX + CLimbSize]
6034
        DEC     EDX
6035
        JNE     @Loop
6036

6037
@Last:
6038

6039
        TEST    ECX,ECX
6040
        JNE     @Exit
6041
        MOV     TLimb PTR [EAX],1
6042

6043
@Exit:
6044

6045
end;
6046
{$ELSE !WIN32}
6047
asm
6048

6049
        TEST    EDX,EDX
6050
        JE      @Exit
6051

6052
@Loop:
6053

6054
        MOV     EAX,[RCX]
6055
        INC     EAX
6056
        MOV     [RCX],EAX
6057
        TEST    EAX,EAX
6058
        JNE     @Exit
6059
        LEA     RCX,[RCX + CLimbSize]
6060
        DEC     EDX
6061
        JNE     @Loop
6062

6063
@Last:
6064

6065
        TEST    EAX,EAX
6066
        JNE     @Exit
6067
        MOV     TLimb PTR [RCX],1
6068

6069
@Exit:
6070

6071
end;
6072
{$ENDIF !WIN32}
6073
{$ENDIF !PUREPASCAL}
6074

6075
// Note: only handles Abs(Self) > 1
6076
class procedure BigInteger.InternalDecrement(Limbs: PLimb; Size: Integer);
6077
{$IFDEF PUREPASCAL}
6078
begin
6079
  repeat
6080
    Dec(Limbs^);
6081
    if Limbs^ <> TLimb(-1) then
6082
      Break;
6083
    Inc(Limbs);
6084
    Dec(Size);
6085
  until Size = 0;
6086
end;
6087
{$ELSE !PUREPASCAL}
6088
{$IFDEF WIN32}
6089
asm
6090

6091
@Loop:
6092

6093
        MOV     ECX,[EAX]
6094
        DEC     ECX
6095
        MOV     [EAX],ECX
6096
        CMP     ECX,-1
6097
        JNE     @Exit
6098
        LEA     EAX,[EAX + CLimbSize]
6099
        DEC     EDX
6100
        JNE     @Loop
6101

6102
@Exit:
6103

6104
end;
6105
{$ELSE !WIN32}
6106
asm
6107

6108
@Loop:
6109

6110
        MOV     EAX,[RCX]
6111
        DEC     EAX
6112
        MOV     [RCX],EAX
6113
        CMP     EAX,-1
6114
        JNE     @Exit
6115
        LEA     RCX,[RCX + CLimbSize]
6116
        DEC     EDX
6117
        JNE     @Loop
6118

6119
@Exit:
6120

6121
end;
6122
{$ENDIF !WIN32}
6123
{$ENDIF !PUREPASCAL}
6124

6125
// Divides a magnitude (usually the FData of a TBigInteger) by Base and returns the remainder.
6126
class function BigInteger.InternalDivideByBase(Mag: PLimb; Base: Integer; var Size: Integer): UInt32;
6127
{$IF DEFINED(PUREPASCAL)}
6128

6129
// This routine uses DivMod(Cardinal, Word, Word, Word).
6130
// In Win32, that is 14 times faster than the previous version using the DivMod with UInt64 parameters.
6131
// In Win64, it is only a little bit slower.
6132

6133
type
6134
  UInt32Rec = record
6135
    Lo, Hi: UInt16;
6136
  end;
6137
  PUInt16 = ^UInt16;
6138

6139
var
6140
  P, PMag: PUInt16;
6141
  Remainder: UInt16;
6142
  CurrentWord: UInt32;
6143
begin
6144
  Result := 0;
6145
  if Size = 0 then
6146
    Exit;
6147
  PMag := PUInt16(Mag);
6148
  P := PMag + Size * 2;
6149
  Remainder := 0;
6150
  while P > PMag do
6151
  begin
6152
    Dec(P);
6153
    UInt32Rec(CurrentWord).Lo := P^;
6154
    UInt32Rec(CurrentWord).Hi := Remainder;
6155
    Math.DivMod(CurrentWord, Base, P^, Remainder);
6156
  end;
6157
  Result := Remainder;
6158
  if Mag[Size - 1] = 0 then
6159
    Dec(Size);
6160
end;
6161
{$ELSEIF DEFINED(WIN32)}
6162
asm
6163
        PUSH    ESI
6164
        PUSH    EDI
6165
        PUSH    EBX
6166
        MOV     EBX,ECX                         // var Size
6167
        MOV     ECX,EDX
6168
        MOV     ESI,EAX                         // PBase (= Mag)
6169
        MOV     EDX,[EBX]
6170
        XOR     EAX,EAX                         // Result
6171
        TEST    EDX,EDX
6172
        JE      @Exit
6173
        LEA     EDI,[ESI + CLimbSize*EDX]       // P
6174
        XOR     EDX,EDX                         // Remainder := 0;
6175
        CMP     EDI,ESI                         // while P > PBase do
6176
        JBE     @CheckSize
6177
@Loop:
6178
        SUB     EDI,4                           // Dec(P);
6179
        MOV     EAX,[EDI]                       // DivMod(P^ or (Remainder shl 32), 10, P^, Remainder);
6180
        DIV     EAX,ECX
6181
        MOV     [EDI],EAX
6182
        CMP     EDI,ESI                         // while P > PBase do
6183
        JA      @Loop
6184
@CheckSize:
6185
        MOV     EAX,EDX                         // if (PBase + Size - 1)^ = 0 then
6186
        MOV     EDX,[EBX]
6187
        LEA     ESI,[ESI + CLimbSize*EDX - CLimbSize]
6188
        CMP     [ESI],0
6189
        JNE     @Exit
6190
        DEC     DWORD PTR [EBX]                 //   Dec(Size);
6191
@Exit:
6192
        POP     EBX
6193
        POP     EDI
6194
        POP     ESI
6195
end;
6196
{$ELSE}
6197
asm
6198
        .NOFRAME
6199

6200
        MOV     R11,R8                          // var Size
6201
        MOV     R9,RCX                          // PBase := Mag;
6202
        MOV     ECX,EDX
6203
        XOR     EAX,EAX                         // Result := 0;
6204
        MOV     EDX,[R11]                       // if Size = 0 then Exit;
6205
        OR      EDX,EDX
6206
        JE      @Exit
6207
        LEA     R10,[R9 + CLimbSize*RDX]        // P
6208
        XOR     EDX,EDX                         // Remainder := 0;
6209
        CMP     R10,R9                          // while P > PBase do
6210
        JBE     @CheckSize
6211
@Loop:
6212
        SUB     R10,4                           // Dec(P)
6213
        MOV     EAX,[R10]                       // DivMod(P^ or (Remainder shl 32), 10, P^, Remainder);
6214
        DIV     EAX,ECX
6215
        MOV     [R10],EAX
6216
        CMP     R10,R9                          // while P > PBase do
6217
        JA      @Loop
6218
@CheckSize:
6219
        MOV     EAX,EDX
6220
        MOV     EDX,[R11]
6221
        CMP     [R9 + CLimbSize*RDX - CLimbSize],0   // if (PBase + Size - 1)^ = 0 then
6222
        JNE     @Exit
6223
        DEC     DWORD PTR [R11]                 //   Dec(Size);
6224
@Exit:
6225
end;
6226
{$IFEND}
6227

6228
class operator BigInteger.Equal(const Left, Right: BigInteger): Boolean;
6229
begin
6230
  Result := Compare(Left, Right) = 0;
6231
end;
6232

6233
class procedure BigInteger.Error(ErrorCode: TErrorCode; const ErrorInfo: string);
6234
begin
6235
  case ErrorCode of
6236
    ecParse:
6237
      raise EConvertError.CreateFmt(SErrorBigIntegerParsing, [ErrorInfo]);
6238
    ecDivbyZero:
6239
      raise EZeroDivide.Create(SDivisionByZero);
6240
    ecConversion:
6241
      raise EConvertError.CreateFmt(SConversionFailed, [ErrorInfo]);
6242
    ecOverflow:
6243
      raise EOverflow.Create(SOverflow);
6244
    ecInvalidArgument:
6245
      raise EInvalidArgument.Create(SInvalidArgumentBase);
6246
  else
6247
    raise EInvalidOp.Create(SInvalidOperation);
6248
  end;
6249
end;
6250

6251
class operator BigInteger.Explicit(const Int: BigInteger): Cardinal;
6252
begin
6253
  if Int.FData = nil then
6254
    Result := 0
6255
  else
6256
    Result := Int.FData[0] and High(Cardinal);
6257
end;
6258

6259
class operator BigInteger.Explicit(const Int: BigInteger): Integer;
6260
begin
6261
  if Int.FData = nil then
6262
    Result := 0
6263
  else
6264
  begin
6265
    Result := Int.FData[0] and High(Integer);
6266
    if Int.FSize < 0 then
6267
      Result := -Result;
6268
  end;
6269
end;
6270

6271
class operator BigInteger.Explicit(const Int: BigInteger): Int64;
6272
begin
6273
  if Int.FData = nil then
6274
    Result := 0
6275
  else
6276
  begin
6277
    TUInt64(Result).Lo := Int.FData[0];
6278
    if (Int.FSize and SizeMask) > 1 then
6279
      TUInt64(Result).Hi := Int.FData[1] and High(Integer)
6280
    else
6281
      TUInt64(Result).Hi := 0;
6282
    if Int.FSize < 0 then
6283
      Result := -Result;
6284
  end;
6285
end;
6286

6287
function BigInteger.AsCardinal: Cardinal;
6288
begin
6289
  Result := 0;
6290
  if not IsNegative and (BitLength <= CCardinalBits) then
6291
    Result := Cardinal(Self)
6292
  else
6293
    Error(ecConversion, 'Cardinal');
6294
end;
6295

6296
function GetBitAt(FData: PLimb; BitNum: Integer): Boolean;
6297
begin
6298
  Result := (FData[BitNum div 32] and (1 shl (BitNum and 31))) <> 0
6299
end;
6300

6301
function BigInteger.AsDouble: Double;
6302
const
6303
  BitMasks: array[0..31] of Cardinal = // $FFFFFFFF shl (31 - Index)
6304
  (
6305
    $00000001, $00000003, $00000007, $0000000F, $0000001F, $0000003F, $0000007F, $000000FF,
6306
    $000001FF, $000003FF, $000007FF, $00000FFF, $00001FFF, $00003FFF, $00007FFF, $0000FFFF,
6307
    $0001FFFF, $0003FFFF, $0007FFFF, $000FFFFF, $001FFFFF, $003FFFFF, $007FFFFF, $00FFFFFF,
6308
    $01FFFFFF, $03FFFFFF, $07FFFFFF, $0FFFFFFF, $1FFFFFFF, $3FFFFFFF, $7FFFFFFF, $FFFFFFFF
6309
  );
6310

6311
  // The four values below will result in exactly the same value as: Result := StrToFloat(Self.ToString);
6312
  ExponentBias = 1023;                  // DO NOT CHANGE!!!
6313
  SignificandBits = 52;                 // DO NOT CHANGE!!!
6314
  GuardOffset = SignificandBits + 2;    // DO NOT CHANGE!!!
6315
  ExponentBits = 11;                    // DO NOT CHANGE!!!
6316

6317
  ExponentShift = SignificandBits - CUInt32Bits;
6318
  ExponentMask = Pred(1 shl ExponentBits);
6319
  SignificandMask = Pred(1 shl ExponentShift);
6320
var
6321
  BitLen: Integer;
6322
  StickyIndex: Integer;
6323
  StickyBits: TLimb;
6324
  Guard, Round: Boolean;
6325
  NumLeadingZeroes, K, I: Integer;
6326
  LSize: Integer;
6327
  Res: packed record
6328
    case Byte of
6329
      0: (Dbl: Double);
6330
      1: (Bits: UInt64);
6331
      2: (Lo, Hi: UInt32);
6332
  end;
6333
begin
6334
  BitLen := BitLength;
6335
  if BitLen > 1025 then
6336
    if FSize < 0 then
6337
      Exit(NegInfinity)
6338
    else
6339
      Exit(Infinity);
6340
//    Error(ecConversion, 'Double');
6341
  if BitLen <= CInt64Bits then
6342
    Result := AsInt64
6343
  else
6344
  begin
6345
    LSize := Size;
6346

6347
    // Form significand from top 53 bits of BigInteger.
6348
    NumLeadingZeroes := (CLimbBits - BitLen) and 31;
6349
    if NumLeadingZeroes > 11 then
6350
    begin
6351

6352
      // 53 bits spread over 3 limbs, e.g.:
6353
      // FData[LSize-1]                   FData[LSize-2]                   FData[LSize-3]
6354
      // 10----5----0----5----0----5----0 10----5----0----5----0----5----0 10----5----0----5----0----5----0
6355
      // 000000000000000000000000000AAAAA BBBBBBBBBBBBBBBbbbbbbbbbbbbbbbbb CCCCCCCCCCCCCCCC****************
6356

6357
      K := NumLeadingZeroes - 11;
6358
      Res.Hi := (FData[LSize - 1] shl K) or (FData[LSize - 2] shr (CLimbBits - K)); { a shl K or b shr (31 - K) }
6359
      Res.Lo := (FData[LSize - 2] shl K) or (FData[LSize - 3] shr (CLimbBits - K)); { b shl K or c shr (31 - K) }
6360

6361
      // Res.Hi                           Res.Lo
6362
      // 10----5----0----5----0----5----0 10----5----0----5----0----5----0
6363
      // 00000000000AAAAABBBBBBBBBBBBBBBB bbbbbbbbbbbbbbbbCCCCCCCCCCCCCCCC
6364

6365
    end
6366
    else
6367
    begin
6368

6369
      // 53 bits spread over 2 limbs, e.g.:
6370
      // FData[LSize-1]                   FData[LSize-2]
6371
      // 10----5----0----5----0----5----0 10----5----0----5----0----5----0
6372
      // 000000AAAAAAAAAAAAAAAAAAAAAaaaaa BBBBBBBBBBBBBBBBBBBBBBBBBBB*****
6373

6374
      Res.Hi := FData[LSize - 1];
6375
      Res.Lo := FData[LSize - 2];
6376
      if NumLeadingZeroes < 11 then
6377
        Res.Bits := Res.Bits shr (11 - NumLeadingZeroes);
6378

6379
      // Res.Hi                           Res.Lo
6380
      // 10----5----0----5----0----5----0 10----5----0----5----0----5----0
6381
      // 00000000000AAAAAAAAAAAAAAAAAAAAA aaaaaBBBBBBBBBBBBBBBBBBBBBBBBBBB
6382

6383
    end;
6384

6385
    // Rounding, using guard, round and sticky bit.
6386
    // Guard is below lowest bit of significand, Round bit one below that, and Sticky bit is accumulation of all bits
6387
    // below the other two.
6388

6389
    // GRSB - Action (slightly modified; B is lowest bit of significand)
6390
    // 0xxx - round down = do nothing (x means any bit value, 0 or 1)
6391
    // 1000 - round down = do nothing
6392
    // 1001 - round up
6393
    // 101x - round up
6394
    // 110x - round up
6395
    // 111x - round up
6396

6397
    // Collect all bits below round bit into sticky bit.
6398
    StickyIndex := BitLen - GuardOffset - 2;
6399

6400
    StickyBits := 0;
6401
    // First collect from limbs below sticky bit.
6402
    for I := 0 to StickyIndex div 32 - 1 do
6403
      StickyBits := StickyBits or FData[I];
6404
    // Then include bits up to the sticky bit.
6405
    StickyBits := StickyBits or (FData[StickyIndex div CLimbBits] and BitMasks[StickyIndex and (ClimbBits - 1)]);
6406

6407
    // Get guard and round bits.
6408
    Round := GetBitAt(PLimb(FData), StickyIndex + 1);
6409
    Guard := GetBitAt(PLimb(FData), StickyIndex + 2);
6410

6411
    // See table above.
6412
    if Guard and (Odd(Res.Lo) or Round or (StickyBits <> 0)) then
6413
      Res.Bits := Res.Bits + 1;
6414

6415
    // Beware of overflowing the significand!
6416
    if Res.Bits > $1FFFFFFFFFFFFF then
6417
    begin
6418
      Res.Bits := Res.Bits shr 1;
6419
      Inc(BitLen);
6420
    end;
6421

6422
    // Remove hidden bit and place exponent and sign bit to form a complete Double.
6423
    Res.Hi := (Res.Hi and SignificandMask) or                           // top of significand, hidden bit removed
6424
              UInt32(((BitLen - 1 + ExponentBias) and ExponentMask) shl ExponentShift) or  // exponent, unbiased
6425
              UInt32(SignBitOf(FSize));                                                    // sign bit
6426

6427
    Result := Res.Dbl;
6428
  end;
6429
end;
6430

6431
function BigInteger.AsInt64: Int64;
6432
begin
6433
  Result := 0;
6434
  if BitLength <= CInt64Bits then
6435
    Result := Int64(Self)
6436
  else
6437
    Error(ecConversion, 'Int64');
6438
end;
6439

6440
function BigInteger.AsInteger: Integer;
6441
begin
6442
  Result := 0;
6443
  if BitLength <= CIntegerBits then
6444
    Result := Integer(Self)
6445
  else
6446
    Error(ecConversion, 'Integer');
6447
end;
6448

6449
function BigInteger.AsUInt64: UInt64;
6450
begin
6451
  Result := 0;
6452
  if not IsNegative and (BitLength <= CUInt64Bits) then
6453
    Result := UInt64(Self)
6454
  else
6455
    Error(ecConversion, 'UInt64');
6456
end;
6457

6458
class operator BigInteger.Explicit(const Int: BigInteger): UInt64;
6459
begin
6460
  if Int.FData = nil then
6461
    Result := 0
6462
  else
6463
  begin
6464
    TUInt64(Result).Lo := Int.FData[0];
6465
    if (Int.FSize and SizeMask) > 1 then
6466
      TUInt64(Result).Hi := Int.FData[1] and High(Cardinal)
6467
    else
6468
      TUInt64(Result).Hi := 0;
6469
  end;
6470
end;
6471

6472
class function BigInteger.InternalCompare(Left, Right: PLimb; LSize, RSize: Integer): TValueSign;
6473
{$IFDEF PUREPASCAL}
6474
var
6475
  L, R: PLimb;
6476
begin
6477
  if Left = nil then
6478
  begin
6479
    if Right = nil then
6480
      Exit(0)
6481
    else
6482
      Exit(-1);
6483
  end;
6484
  if Right = nil then
6485
    Exit(1);
6486
  if LSize > RSize then
6487
    Result := 1
6488
  else if LSize < RSize then
6489
    Result := -1
6490
  else
6491
  // Same size, so compare values. Start at the "top" (most significant limb).
6492
  begin
6493
    L := Left + LSize - 1;
6494
    R := Right + LSize - 1;
6495
    while L >= Left do
6496
    begin
6497
      if L^ > R^  then
6498
        Exit(1)
6499
      else if L^ < R^ then
6500
        Exit(-1);
6501
      Dec(L);
6502
      Dec(R);
6503
    end;
6504
    Exit(0);
6505
  end;
6506
end;
6507
{$ELSE !PUREPASCAL}
6508
{$IFDEF WIN32}
6509
asm
6510
        PUSH    ESI
6511

6512
        TEST    EAX,EAX
6513
        JNE     @LeftNotNil
6514
        TEST    EDX,EDX
6515
        JZ      @ExitZero
6516
        JMP     @ExitNeg
6517

6518
@LeftNotNil:
6519

6520
        TEST    EDX,EDX
6521
        JZ      @ExitPos
6522

6523
        CMP     ECX,RSize
6524
        JA      @ExitPos
6525
        JB      @ExitNeg
6526

6527
        MOV     ESI,EAX
6528

6529
@Loop:
6530

6531
        MOV     EAX,[ESI + ECX*CLimbSize - CLimbSize]
6532
        CMP     EAX,[EDX + ECX*CLimbSize - CLimbSize]
6533
        JA      @ExitPos
6534
        JB      @ExitNeg
6535
        DEC     ECX
6536
        JNE     @Loop
6537

6538
@ExitZero:
6539

6540
        XOR     EAX,EAX
6541
        JMP     @Exit
6542

6543
@ExitPos:
6544

6545
        MOV     EAX,1
6546
        JMP     @Exit
6547

6548
@ExitNeg:
6549

6550
        MOV     EAX,-1
6551

6552
@Exit:
6553

6554
        POP     ESI
6555
end;
6556
{$ELSE WIN64}
6557
asm
6558
        TEST    RCX,RCX
6559
        JNZ     @LeftNotNil
6560

6561
        // Left is nil
6562
        TEST    RDX,RDX
6563
        JZ      @ExitZero                       // if Right nil too, then equal
6564
        JMP     @ExitNeg                        // Otherwise, Left < Right
6565

6566
@LeftNotNil:
6567

6568
        TEST    RDX,RDX
6569
        JZ      @ExitPos
6570

6571
        CMP     R8D,R9D
6572
        JA      @ExitPos
6573
        JB      @ExitNeg
6574

6575
        // R8D and R9D are same.
6576

6577
        LEA     RCX,[RCX + R8*CLimbSize]
6578
        LEA     RDX,[RDX + R8*CLimbSize]
6579

6580
        TEST    R8D,1
6581
        JZ      @NotOdd
6582

6583
        LEA     RCX,[RCX - CLimbSize]
6584
        LEA     RDX,[RDX - CLimbSize]
6585
        MOV     EAX,[RCX]
6586
        CMP     EAX,[RDX]
6587
        JA      @ExitPos
6588
        JB      @ExitNeg
6589
        DEC     R8D
6590

6591
@NotOdd:
6592

6593
        SHR     R8D,1
6594
        JZ      @ExitZero
6595

6596
@Loop:
6597

6598
        LEA     RCX,[RCX - DLimbSize]
6599
        LEA     RDX,[RDX - DLimbSize]
6600
        MOV     RAX,[RCX]
6601
        CMP     RAX,[RDX]
6602
        JA      @ExitPos
6603
        JB      @ExitNeg
6604
        DEC     R8D
6605
        JNE     @Loop
6606

6607
@ExitZero:
6608

6609
        XOR     EAX,EAX
6610
        JMP     @Exit
6611

6612
@ExitPos:
6613

6614
        MOV     EAX,1
6615
        JMP     @Exit
6616

6617
@ExitNeg:
6618

6619
        MOV     EAX,-1
6620

6621
@Exit:
6622

6623
end;
6624
{$ENDIF WIN64}
6625
{$ENDIF !PUREPASCAL}
6626

6627
//class function BigInteger.InternalCompareMagnitudes(Left, Right: PLimb; LSize, RSize: Integer): TValueSign;
6628
//begin
6629
//  Result := InternalCompare(Left, Right, LSize, RSize);
6630
//end;
6631
//
6632
{$IFNDEF PUREPASCAL}
6633
class procedure BigInteger.InternalSubtractModified(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
6634
{$IFDEF WIN32}
6635
asm
6636
        PUSH    ESI
6637
        PUSH    EDI
6638
        PUSH    EBX
6639

6640
        MOV     ESI,EAX                         // Left
6641
        MOV     EDI,EDX                         // Right
6642
        MOV     EBX,ECX                         // Result
6643

6644
        MOV     ECX,SSize
6645
        MOV     EDX,LSize
6646

6647
        SUB     EDX,ECX
6648
        PUSH    EDX
6649
        XOR     EDX,EDX
6650

6651
        XOR     EAX,EAX
6652

6653
        MOV     EDX,ECX
6654
        AND     EDX,CUnrollMask
6655
        SHR     ECX,CUnrollShift
6656

6657
        CLC
6658
        JE      @MainTail
6659

6660
@MainLoop:
6661

6662
        MOV     EAX,[ESI]
6663
        SBB     EAX,[EDI]
6664
        MOV     [EBX],EAX
6665

6666
        MOV     EAX,[ESI + CLimbSize]
6667
        SBB     EAX,[EDI + CLimbSize]
6668
        MOV     [EBX + CLimbSize],EAX
6669

6670
        MOV     EAX,[ESI + 2*CLimbSize]
6671
        SBB     EAX,[EDI + 2*CLimbSize]
6672
        MOV     [EBX + 2*CLimbSize],EAX
6673

6674
        MOV     EAX,[ESI + 3*CLimbSize]
6675
        SBB     EAX,[EDI + 3*CLimbSize]
6676
        MOV     [EBX + 3*CLimbSize],EAX
6677

6678
        LEA     ESI,[ESI + 4*CLimbSize]
6679
        LEA     EDI,[EDI + 4*CLimbSize]
6680
        LEA     EBX,[EBX + 4*CLimbSize]
6681

6682
        LEA     ECX,[ECX - 1]
6683
        JECXZ   @MainTail
6684
        JMP     @Mainloop
6685

6686
@MainTail:
6687

6688
        LEA     ESI,[ESI + EDX*CLimbSize]
6689
        LEA     EDI,[EDI + EDX*CLimbSize]
6690
        LEA     EBX,[EBX + EDX*CLimbSize]
6691

6692
        LEA     ECX,[@JumpsMain]
6693
        JMP     [ECX + EDX*TYPE Pointer]
6694

6695
        // Align jump table manually, with NOPs. Update if necessary.
6696

6697
        NOP
6698

6699
@JumpsMain:
6700

6701
        DD      @DoRestLoop
6702
        DD      @Main1
6703
        DD      @Main2
6704
        DD      @Main3
6705

6706
@Main3:
6707

6708
        MOV     EAX,[ESI - 3*CLimbSize]
6709
        SBB     EAX,[EDI - 3*CLimbSize]
6710
        MOV     [EBX - 3*CLimbSize],EAX
6711

6712
@Main2:
6713

6714
        MOV     EAX,[ESI - 2*CLimbSize]
6715
        SBB     EAX,[EDI - 2*CLimbSize]
6716
        MOV     [EBX - 2*CLimbSize],EAX
6717

6718
@Main1:
6719

6720
        MOV     EAX,[ESI - CLimbSize]
6721
        SBB     EAX,[EDI - CLimbSize]
6722
        MOV     [EBX - CLimbSize],EAX
6723

6724
@DoRestLoop:
6725

6726
        SETC    AL                      // Save Carry Flag
6727

6728
        XOR     EDI,EDI
6729

6730
        POP     ECX
6731
        MOV     EDX,ECX
6732
        AND     EDX,CUnrollMask
6733
        SHR     ECX,CUnrollShift
6734

6735
        ADD     AL,255                  // Restore Carry Flag.
6736

6737
        JECXZ   @RestLast3
6738

6739
@RestLoop:
6740

6741
        MOV     EAX,[ESI]
6742
        SBB     EAX,EDI
6743
        MOV     [EBX],EAX
6744

6745
        MOV     EAX,[ESI + CLimbSize]
6746
        SBB     EAX,EDI
6747
        MOV     [EBX + CLimbSize],EAX
6748

6749
        MOV     EAX,[ESI + 2*CLimbSize]
6750
        SBB     EAX,EDI
6751
        MOV     [EBX + 2*CLimbSize],EAX
6752

6753
        MOV     EAX,[ESI + 3*CLimbSize]
6754
        SBB     EAX,EDI
6755
        MOV     [EBX + 3*CLimbSize],EAX
6756

6757
        LEA     ESI,[ESI + 4*CLimbSize]
6758
        LEA     EBX,[EBX + 4*CLimbSize]
6759

6760
        LEA     ECX,[ECX - 1]
6761
        JECXZ   @RestLast3
6762
        JMP     @RestLoop
6763

6764
@RestLast3:
6765

6766
        LEA     ESI,[ESI + EDX*CLimbSize]
6767
        LEA     EBX,[EBX + EDX*CLimbSize]
6768

6769
        LEA     ECX,[@RestJumps]
6770
        JMP     [ECX + EDX*TYPE Pointer]
6771

6772
        // If necessary, align second jump table with NOPs
6773

6774
        NOP
6775
        NOP
6776
        NOP
6777

6778
@RestJumps:
6779

6780
        DD      @Exit
6781
        DD      @Rest1
6782
        DD      @Rest2
6783
        DD      @Rest3
6784

6785
@Rest3:
6786

6787
        MOV     EAX,[ESI - 3*CLimbSize]
6788
        SBB     EAX,EDI
6789
        MOV     [EBX - 3*CLimbSize],EAX
6790

6791
@Rest2:
6792

6793
        MOV     EAX,[ESI - 2*CLimbSize]
6794
        SBB     EAX,EDI
6795
        MOV     [EBX - 2*CLimbSize],EAX
6796

6797
@Rest1:
6798

6799
        MOV     EAX,[ESI - CLimbSize]
6800
        SBB     EAX,EDI
6801
        MOV     [EBX - CLimbSize],EAX
6802

6803
@Exit:
6804

6805
        POP     EBX
6806
        POP     EDI
6807
        POP     ESI
6808
end;
6809
{$ELSE WIN32/WIN64}
6810
asm
6811
        MOV     R10,RCX
6812
        MOV     ECX,SSize
6813

6814
        // R10 = Left, RDX = Right, R8 = Result, R9D = LSize, ECX = SSize
6815

6816
        CMP     R9D,ECX
6817
        JAE     @SkipSwap
6818
        XCHG    ECX,R9D
6819
        XCHG    R10,RDX
6820

6821
@SkipSwap:
6822

6823
        SUB     R9D,ECX
6824
        PUSH    R9
6825

6826
        MOV     R9D,ECX
6827
        AND     R9D,CUnrollMask
6828
        SHR     ECX,CUnrollShift
6829

6830
        CLC
6831
        JE      @MainTail
6832

6833
@MainLoop:
6834

6835
        MOV     RAX,[R10]
6836
        SBB     RAX,[RDX]
6837
        MOV     [R8],RAX
6838

6839
        MOV     RAX,[R10 + DLimbSize]
6840
        SBB     RAX,[RDX + DLimbSize]
6841
        MOV     [R8 + DLimbSize],RAX
6842

6843
        LEA     R10,[R10 + 2*DLimbSize]
6844
        LEA     RDX,[RDX + 2*DLimbSize]
6845
        LEA     R8,[R8 + 2*DLimbSize]
6846

6847
        LEA     RCX,[RCX - 1]
6848
        JRCXZ   @MainTail
6849
        JMP     @MainLoop
6850

6851
@MainTail:
6852

6853
// Here, code does not add index*CLimbSize and then use negative offsets, because that would take away the advantage of using 64 bit registers.
6854
// Each block is separate, no fall through.
6855

6856
        LEA     RCX,[@MainJumps]
6857
        JMP     [RCX + R9*TYPE Pointer]
6858

6859
        // Align jump table. Update if necessary!
6860

6861
        DB      $90,$90,$90,$90,$90
6862

6863
@MainJumps:
6864

6865
        DQ      @DoRestLoop
6866
        DQ      @Main1
6867
        DQ      @Main2
6868
        DQ      @Main3
6869

6870
@Main3:
6871

6872
        MOV     RAX,[R10]
6873
        SBB     RAX,[RDX]
6874
        MOV     [R8],RAX
6875

6876
        MOV     EAX,[R10 + 2*CLimbSize]
6877
        SBB     EAX,[RDX + 2*CLimbSize]
6878
        MOV     [R8 + 2*CLimbSize],EAX
6879

6880
        LEA     R10,[R10 + 3*CLimbSize]
6881
        LEA     RDX,[RDX + 3*CLimbSize]
6882
        LEA     R8,[R8 + 3*CLimbSize]
6883

6884
        JMP     @DoRestLoop
6885

6886
@Main2:
6887

6888
        MOV     RAX,[R10]
6889
        SBB     RAX,[RDX]
6890
        MOV     [R8],RAX
6891

6892
        LEA     R10,[R10 + 2*CLimbSize]
6893
        LEA     RDX,[RDX + 2*CLimbSize]
6894
        LEA     R8,[R8 + 2*CLimbSize]
6895

6896
        JMP     @DoRestLoop
6897

6898
@Main1:
6899

6900
        MOV     EAX,[R10]
6901
        SBB     EAX,[RDX]
6902
        MOV     [R8],EAX
6903

6904
        LEA     R10,[R10 + CLimbSize]
6905
        LEA     RDX,[RDX + CLimbSize]
6906
        LEA     R8,[R8 + CLimbSize]
6907

6908
@DoRestLoop:
6909

6910
        SETC    AL                      // Save Carry Flag
6911

6912
        XOR     EDX,EDX
6913

6914
        POP     RCX
6915
        MOV     R9D,ECX
6916
        AND     R9D,CUnrollMask
6917
        SHR     ECX,CUnrollShift
6918

6919
        ADD     AL,255                  // Restore Carry Flag.
6920

6921
        JECXZ   @RestLast3
6922

6923
@RestLoop:
6924

6925
        MOV     RAX,[R10]
6926
        SBB     RAX,RDX
6927
        MOV     [R8],RAX
6928

6929
        MOV     RAX,[R10 + DLimbSize]
6930
        SBB     RAX,RDX
6931
        MOV     [R8 + DLimbSize],RAX
6932

6933
        LEA     R10,[R10 + 2*DLimbSize]
6934
        LEA     R8,[R8 + 2*DLimbSize]
6935

6936
        LEA     RCX,[RCX - 1]
6937
        JRCXZ   @RestLast3
6938
        JMP     @RestLoop
6939

6940
@RestLast3:
6941

6942
        LEA     RCX,[@RestJumps]
6943
        JMP     [RCX + R9*TYPE Pointer]
6944

6945
        // If necessary, align second jump table with NOPs
6946

6947
        DB      $90,$90,$90,$90,$90,$90,$90
6948

6949
@RestJumps:
6950

6951
        DQ      @Exit
6952
        DQ      @Rest1
6953
        DQ      @Rest2
6954
        DQ      @Rest3
6955

6956
@Rest3:
6957

6958
        MOV     RAX,[R10]
6959
        SBB     RAX,RDX
6960
        MOV     [R8],RAX
6961

6962
        MOV     EAX,[R10 + DLimbSize]
6963
        SBB     EAX,EDX
6964
        MOV     [R8 + DLimbSize],EAX
6965

6966
        JMP     @Exit
6967

6968
@Rest2:
6969

6970
        MOV     RAX,[R10]
6971
        SBB     RAX,RDX
6972
        MOV     [R8],RAX
6973

6974
        JMP     @Exit
6975

6976
@Rest1:
6977

6978
        MOV     EAX,[R10]
6979
        SBB     EAX,EDX
6980
        MOV     [R8],EAX
6981

6982
@Exit:
6983

6984
end;
6985
{$ENDIF}
6986

6987
class procedure BigInteger.InternalSubtractPlain(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
6988
{$IFDEF WIN32}
6989
asm
6990
        PUSH    ESI
6991
        PUSH    EDI
6992
        PUSH    EBX
6993

6994
        MOV     ESI,EAX                         // Left
6995
        MOV     EDI,EDX                         // Right
6996
        MOV     EBX,ECX                         // Result
6997

6998
        MOV     ECX,SSize
6999
        MOV     EDX,LSize
7000

7001
        SUB     EDX,ECX
7002
        PUSH    EDX
7003
        XOR     EDX,EDX
7004

7005
        XOR     EAX,EAX
7006

7007
        MOV     EDX,ECX
7008
        AND     EDX,CUnrollMask
7009
        SHR     ECX,CUnrollShift
7010

7011
        CLC
7012
        JE      @MainTail
7013

7014
@MainLoop:
7015

7016
        // Unrolled 4 times. More times will not improve speed anymore.
7017

7018
        MOV     EAX,[ESI]
7019
        SBB     EAX,[EDI]
7020
        MOV     [EBX],EAX
7021

7022
        MOV     EAX,[ESI + CLimbSize]
7023
        SBB     EAX,[EDI + CLimbSize]
7024
        MOV     [EBX + CLimbSize],EAX
7025

7026
        MOV     EAX,[ESI + 2*CLimbSize]
7027
        SBB     EAX,[EDI + 2*CLimbSize]
7028
        MOV     [EBX + 2*CLimbSize],EAX
7029

7030
        MOV     EAX,[ESI + 3*CLimbSize]
7031
        SBB     EAX,[EDI + 3*CLimbSize]
7032
        MOV     [EBX + 3*CLimbSize],EAX
7033

7034
        // Update pointers.
7035

7036
        LEA     ESI,[ESI + 4*CLimbSize]
7037
        LEA     EDI,[EDI + 4*CLimbSize]
7038
        LEA     EBX,[EBX + 4*CLimbSize]
7039

7040
        // Update counter and loop if required.
7041

7042
        DEC     ECX                             // Note: if INC/DEC must be emulated: LEA ECX,[ECX - 1]; JECXZ @MainTail; JMP @MainLoop
7043
        JNE     @MainLoop
7044

7045
@MainTail:
7046

7047
        // Add index*CLimbSize so @MainX branches can fall through.
7048

7049
        LEA     ESI,[ESI + EDX*CLimbSize]
7050
        LEA     EDI,[EDI + EDX*CLimbSize]
7051
        LEA     EBX,[EBX + EDX*CLimbSize]
7052

7053
        // Indexed jump.
7054

7055
        LEA     ECX,[@JumpsMain]
7056
        JMP     [ECX + EDX*TYPE Pointer]
7057

7058
        // Align jump table manually, with NOPs. Update if necessary.
7059

7060
        NOP
7061

7062
        // Jump table.
7063

7064
@JumpsMain:
7065

7066
        DD      @DoRestLoop
7067
        DD      @Main1
7068
        DD      @Main2
7069
        DD      @Main3
7070

7071
@Main3:
7072

7073
        MOV     EAX,[ESI - 3*CLimbSize]         // negative offset, because index*CLimbSize was already added.
7074
        SBB     EAX,[EDI - 3*CLimbSize]
7075
        MOV     [EBX - 3*CLimbSize],EAX
7076

7077
@Main2:
7078

7079
        MOV     EAX,[ESI - 2*CLimbSize]
7080
        SBB     EAX,[EDI - 2*CLimbSize]
7081
        MOV     [EBX - 2*CLimbSize],EAX
7082

7083
@Main1:
7084

7085
        MOV     EAX,[ESI - CLimbSize]
7086
        SBB     EAX,[EDI - CLimbSize]
7087
        MOV     [EBX - CLimbSize],EAX
7088

7089
@DoRestLoop:
7090

7091
        SETC    AL                      // Save Carry Flag
7092

7093
        XOR     EDI,EDI
7094

7095
        POP     ECX
7096
        MOV     EDX,ECX
7097
        AND     EDX,CUnrollMask
7098
        SHR     ECX,CUnrollShift
7099

7100
        ADD     AL,255                  // Restore Carry Flag.
7101

7102
        INC     ECX
7103
        DEC     ECX
7104
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
7105

7106
@RestLoop:
7107

7108
        MOV     EAX,[ESI]
7109
        SBB     EAX,EDI
7110
        MOV     [EBX],EAX
7111

7112
        MOV     EAX,[ESI + CLimbSize]
7113
        SBB     EAX,EDI
7114
        MOV     [EBX + CLimbSize],EAX
7115

7116
        MOV     EAX,[ESI + 2*CLimbSize]
7117
        SBB     EAX,EDI
7118
        MOV     [EBX + 2*CLimbSize],EAX
7119

7120
        MOV     EAX,[ESI + 3*CLimbSize]
7121
        SBB     EAX,EDI
7122
        MOV     [EBX + 3*CLimbSize],EAX
7123

7124
        LEA     ESI,[ESI + 4*CLimbSize] // LEA does not affect the flags, so carry will not be changed.
7125
        LEA     EBX,[EBX + 4*CLimbSize]
7126

7127
        DEC     ECX                     // DEC does not affect carry flag, but causes partial-flags stall (e.g. when using SBB) on older CPUs.
7128
        JNE     @RestLoop
7129

7130
@RestLast3:
7131

7132
        LEA     ESI,[ESI + EDX*CLimbSize]
7133
        LEA     EBX,[EBX + EDX*CLimbSize]
7134

7135
        LEA     ECX,[@RestJumps]
7136
        JMP     [ECX + EDX*TYPE Pointer]
7137

7138
        // If necessary, align second jump table with NOPs
7139

7140
        NOP
7141
        NOP
7142
        NOP
7143

7144
@RestJumps:
7145

7146
        DD      @Exit
7147
        DD      @Rest1
7148
        DD      @Rest2
7149
        DD      @Rest3
7150

7151
@Rest3:
7152

7153
        MOV     EAX,[ESI - 3*CLimbSize]
7154
        SBB     EAX,EDI
7155
        MOV     [EBX - 3*CLimbSize],EAX
7156

7157
@Rest2:
7158

7159
        MOV     EAX,[ESI - 2*CLimbSize]
7160
        SBB     EAX,EDI
7161
        MOV     [EBX - 2*CLimbSize],EAX
7162

7163
@Rest1:
7164

7165
        MOV     EAX,[ESI - CLimbSize]
7166
        SBB     EAX,EDI
7167
        MOV     [EBX - CLimbSize],EAX
7168

7169
@Exit:
7170

7171
        POP     EBX
7172
        POP     EDI
7173
        POP     ESI
7174
end;
7175
{$ELSE WIN32/WIN64}
7176
asm
7177
        MOV     R10,RCX         // in emulating code, ECX must be used as loop counter! So do not exchange RCX and R10 in the editor.
7178
        MOV     ECX,SSize
7179

7180
        // R10 = Left, RDX = Right, R8 = Result, R9D = LSize, ECX = SSize
7181

7182
        CMP     R9D,ECX
7183
        JAE     @SkipSwap
7184
        XCHG    ECX,R9D
7185
        XCHG    R10,RDX
7186

7187
@SkipSwap:
7188

7189
        SUB     R9D,ECX
7190
        PUSH    R9
7191

7192
        MOV     R9D,ECX
7193
        AND     R9D,CUnrollMask
7194
        SHR     ECX,CUnrollShift
7195

7196
        CLC
7197
        JE      @MainTail               // ECX = 0, so fewer than 3 limbs to be processed in main
7198

7199
@MainLoop:
7200

7201
        MOV     RAX,[R10]               // Add two limbs at once, taking advantage of 64 bit registers.
7202
        SBB     RAX,[RDX]
7203
        MOV     [R8],RAX
7204

7205
        MOV     RAX,[R10 + DLimbSize] // And next two limbs too.
7206
        SBB     RAX,[RDX + DLimbSize]
7207
        MOV     [R8 + DLimbSize],RAX
7208

7209
        LEA     R10,[R10 + 2*DLimbSize]
7210
        LEA     RDX,[RDX + 2*DLimbSize]
7211
        LEA     R8,[R8 + 2*DLimbSize]
7212

7213
        DEC     ECX                     // if INC/DEC must be emulated: LEA ECX,[ECX - 1]; JECXZ @MainTail; JMP @MainLoop
7214
        JNE     @MainLoop
7215

7216
@MainTail:
7217

7218
// Here, code does not add index*CLimbSize and then use negative offsets, because that would take away the advantage of using 64 bit registers.
7219
// Each block is separate, no fall through.
7220

7221
        LEA     RCX,[@MainJumps]
7222
        JMP     [RCX + R9*TYPE Pointer]
7223

7224
        // Align jump table. Update if necessary!
7225

7226
        NOP
7227

7228
@MainJumps:
7229

7230
        DQ      @DoRestLoop
7231
        DQ      @Main1
7232
        DQ      @Main2
7233
        DQ      @Main3
7234

7235
@Main3:
7236

7237
        MOV     RAX,[R10]
7238
        SBB     RAX,[RDX]
7239
        MOV     [R8],RAX
7240

7241
        MOV     EAX,[R10 + DLimbSize]
7242
        SBB     EAX,[RDX + DLimbSize]
7243
        MOV     [R8 + 2*CLimbSize],EAX
7244

7245
        LEA     R10,[R10 + 3*CLimbSize]
7246
        LEA     RDX,[RDX + 3*CLimbSize]
7247
        LEA     R8,[R8 + 3*CLimbSize]
7248

7249
        JMP     @DoRestLoop
7250

7251
@Main2:
7252

7253
        MOV     RAX,[R10]
7254
        SBB     RAX,[RDX]
7255
        MOV     [R8],RAX
7256

7257
        LEA     R10,[R10 + DLimbSize]
7258
        LEA     RDX,[RDX + DLimbSize]
7259
        LEA     R8,[R8 + DLimbSize]
7260

7261
        JMP     @DoRestLoop
7262

7263
@Main1:
7264

7265
        MOV     EAX,[R10]
7266
        SBB     EAX,[RDX]
7267
        MOV     [R8],EAX
7268

7269
        LEA     R10,[R10 + CLimbSize]
7270
        LEA     RDX,[RDX + CLimbSize]
7271
        LEA     R8,[R8 + CLimbSize]
7272

7273
@DoRestLoop:
7274

7275
        SETC    AL                      // Save Carry Flag
7276

7277
        XOR     EDX,EDX
7278

7279
        POP     RCX
7280
        MOV     R9D,ECX
7281
        AND     R9D,CUnrollMask
7282
        SHR     ECX,CUnrollShift
7283

7284
        ADD     AL,255                  // Restore Carry Flag.
7285

7286
        INC     ECX
7287
        DEC     ECX
7288
        JE      @RestLast3              // JECXZ is slower than INC/DEC/JE
7289

7290
@RestLoop:
7291

7292
        MOV     RAX,[R10]               // Do two limbs at once.
7293
        SBB     RAX,RDX
7294
        MOV     [R8],RAX
7295

7296
        MOV     RAX,[R10 + DLimbSize] // And the next two limbs.
7297
        SBB     RAX,RDX
7298
        MOV     [R8 + DLimbSize],RAX
7299

7300
        LEA     R10,[R10 + 2*DLimbSize]
7301
        LEA     R8,[R8 + 2*DLimbSize]
7302

7303
        DEC     ECX
7304
        JNE     @RestLoop
7305

7306
@RestLast3:
7307

7308
        LEA     RCX,[@RestJumps]
7309
        JMP     [RCX + R9*TYPE Pointer]
7310

7311
        // If necessary, align second jump table with NOPs
7312

7313
@RestJumps:
7314

7315
        DQ      @Exit
7316
        DQ      @Rest1
7317
        DQ      @Rest2
7318
        DQ      @Rest3
7319

7320
@Rest3:
7321

7322
        MOV     RAX,[R10]
7323
        SBB     RAX,RDX
7324
        MOV     [R8],RAX
7325

7326
        MOV     EAX,[R10 + 2*CLimbSize]
7327
        SBB     EAX,EDX
7328
        MOV     [R8 + 2*CLimbSize],EAX
7329

7330
        LEA     R8,[R8 + 3*CLimbSize]
7331

7332
        JMP     @Exit
7333

7334
@Rest2:
7335

7336
        MOV     RAX,[R10]
7337
        SBB     RAX,RDX
7338
        MOV     [R8],RAX
7339

7340
        LEA     R8,[R8 + 2*CLimbSize]
7341

7342
        JMP     @Exit
7343

7344
@Rest1:
7345

7346
        MOV     EAX,[R10]
7347
        SBB     EAX,EDX
7348
        MOV     [R8],EAX
7349

7350
        LEA     R8,[R8 + CLimbSize]
7351

7352
@Exit:
7353

7354
end;
7355
{$ENDIF !WIN32}
7356
{$ENDIF !PUREPASCAL}
7357

7358
{$IFDEF PUREPASCAL}
7359
class procedure BigInteger.InternalSubtractPurePascal(Larger, Smaller, Result: PLimb; LSize, SSize: Integer);
7360
var
7361
  Diff: TLimb;
7362
  Borrow, InterBorrow: TLimb;
7363
  LTail: Integer;
7364
  LCount: Integer;
7365
{$IFDEF CPUX64}
7366
  Diff64, Borrow64, InterBorrow64, Larger64: UInt64;
7367
{$ENDIF}
7368
begin
7369
{$IFDEF CPUX64}
7370
  Borrow64 := 0;
7371
{$ELSE}
7372
  Borrow := 0;
7373
{$ENDIF}
7374

7375
  Dec(LSize, SSize);
7376
  LTail := SSize and CUnrollMask;
7377
  LCount := SSize shr CUnrollShift;
7378

7379
  // Subtract, with borrow, Smallest from Largest and store result in Result.
7380
  while LCount > 0 do
7381
  begin
7382

7383
    ///////////////////////////////////////////////////////////////////////////////////
7384
    // Tests with 64 bit intermediate results like:                                  //
7385
    //                                                                               //
7386
    //   LResult := Int64(Larger[0]) - Smaller[0] + Integer(TUInt64(LResult).Hi);    //
7387
    //   Result[0] := TLimb(LResult);                                                //
7388
    //                                                                               //
7389
    //   LResult := Int64(Larger[1]) - Smaller[1] + Integer(TUInt64(LResult).Hi);    //
7390
    //   Result[1] := TLimb(LResult);                                                //
7391
    //   // etc...                                                                   //
7392
    //                                                                               //
7393
    // ... turned out to be slower than the following carry emulating code, even     //
7394
    // for 64 bit targets.                                                           //
7395
    ///////////////////////////////////////////////////////////////////////////////////
7396

7397
    ///////////////////////////////////////////////////////////////////////////////////
7398
    // Tests with loop unrolling by a factor > 4 did not improve results at all.     //
7399
    ///////////////////////////////////////////////////////////////////////////////////
7400

7401
  {$IFDEF CPUX64}
7402
    // add UInt64s instead of limbs.
7403
    Larger64 := PUInt64(Larger)[0];
7404
    Diff64 := Larger64 - PUInt64(Smaller)[0];
7405
    InterBorrow64 := Ord(Diff64 > Larger64);
7406
    Diff64 := Diff64 - Borrow64;
7407
    PUInt64(Result)[0] := Diff64;
7408
    Borrow64 := InterBorrow64 or Ord(Diff64 = UInt64(-1)) and Borrow64;
7409

7410
    Larger64 := PUInt64(Larger)[1];
7411
    Diff64 := Larger64 - PUInt64(Smaller)[1];
7412
    InterBorrow64 := Ord(Diff64 > Larger64);
7413
    Diff64 := Diff64 - Borrow64;
7414
    PUInt64(Result)[1] := Diff64;
7415
    Borrow64 := InterBorrow64 or Ord(Diff64 = UInt64(-1)) and Borrow64;
7416
  {$ELSE}
7417
    Diff := Larger[0] - Smaller[0];
7418
    InterBorrow := Ord(Diff > Larger[0]);   // there was a borrow if R0 > Larger[0].
7419
    Diff := Diff - Borrow;
7420
    Result[0] := Diff;
7421
    Borrow := InterBorrow or Ord(Diff = $FFFFFFFF) and Borrow; // there was a borrow if R > R0.
7422

7423
    Diff := Larger[1] - Smaller[1];
7424
    InterBorrow := Ord(Diff > Larger[1]);
7425
    Dec(Diff, Borrow);
7426
    Result[1] := Diff;
7427
    Borrow := InterBorrow or Ord(Diff = $FFFFFFFF) and Borrow;
7428

7429
    Diff := Larger[2] - Smaller[2];
7430
    InterBorrow := Ord(Diff > Larger[2]);
7431
    Dec(Diff, Borrow);
7432
    Result[2] := Diff;
7433
    Borrow := InterBorrow or Ord(Diff = $FFFFFFFF) and Borrow;
7434

7435
    Diff := Larger[3] - Smaller[3];
7436
    InterBorrow := Ord(Diff > Larger[3]);
7437
    Dec(Diff, Borrow);
7438
    Result[3] := Diff;
7439
    Borrow := InterBorrow or Ord(Diff = $FFFFFFFF) and Borrow;
7440
  {$ENDIF}
7441

7442
    Inc(Larger, CUnrollIncrement);
7443
    Inc(Smaller, CUnrollIncrement);
7444
    Inc(Result, CUnrollIncrement);
7445
    Dec(LCount);
7446
  end;
7447

7448
{$IFDEF CPUX64}
7449
  Borrow := TLimb(Borrow64);
7450
{$ENDIF}
7451

7452
  while LTail > 0 do
7453
  begin
7454
    Diff := Larger[0] - Smaller[0];
7455
    InterBorrow := Ord(Diff > Larger[0]);
7456
    Dec(Diff, Borrow);
7457
    Result[0] := Diff;
7458
    Borrow := InterBorrow or Ord(Diff = $FFFFFFFF) and Borrow;
7459

7460
    Inc(Larger);
7461
    Inc(Smaller);
7462
    Inc(Result);
7463
    Dec(LTail);
7464
  end;
7465

7466
  LTail := LSize and CUnrollMask;
7467
  LCount := LSize shr CUnrollShift;
7468

7469
{$IFDEF CPUX64}
7470
  Borrow64 := Borrow;
7471
{$ENDIF}
7472

7473
  // Subtract, with borrow, 0 from Largest and store result in Result.
7474
  while LCount > 0 do
7475
  begin
7476
  {$IFDEF CPUX64}
7477
    Diff64 := PUInt64(Larger)[0] - Borrow64;
7478
    PUInt64(Result)[0] := Diff64;
7479
    Borrow64 := Ord(Diff64 = UInt64(-1)) and Borrow64;
7480

7481
    Diff64 := PUInt64(Larger)[1] - Borrow64;
7482
    PUInt64(Result)[1] := Diff64;
7483
    Borrow64 := Ord(Diff64 = UInt64(-1)) and Borrow64;
7484
  {$ELSE}
7485
    Diff := Larger[0] - Borrow;
7486
    Result[0] := Diff;
7487
    Borrow := Ord(Diff = $FFFFFFFF) and Borrow;
7488

7489
    Diff := Larger[1] - Borrow;
7490
    Result[1] := Diff;
7491
    Borrow := Ord(Diff = $FFFFFFFF) and Borrow;
7492

7493
    Diff := Larger[2] - Borrow;
7494
    Result[2] := Diff;
7495
    Borrow := Ord(Diff = $FFFFFFFF) and Borrow;
7496

7497
    Diff := Larger[3] - Borrow;
7498
    Result[3] := Diff;
7499
    Borrow := Ord(Diff = $FFFFFFFF) and Borrow;
7500
  {$ENDIF}
7501

7502
    Inc(Larger, CUnrollIncrement);
7503
    Inc(Result, CUnrollIncrement);
7504
    Dec(LCount);
7505
  end;
7506

7507
{$IFDEF CPUX64}
7508
  Borrow := TLimb(Borrow64);
7509
{$ENDIF}
7510

7511
  while LTail > 0 do
7512
  begin
7513
    Diff := Larger[0] - Borrow;
7514
    Result[0] := Diff;
7515
    Borrow := Ord(Diff = $FFFFFFFF) and Borrow;
7516

7517
    Inc(Larger);
7518
    Inc(Result);
7519
    Dec(LTail);
7520
  end;
7521
end;
7522
{$ENDIF}
7523

7524
function BigInteger.IsZero: Boolean;
7525
begin
7526
  Result := FData = nil;
7527
end;
7528

7529
class operator BigInteger.LeftShift(const Value: BigInteger; Shift: Integer): BigInteger;
7530
var
7531
  LimbShift: Integer;
7532
  LSign: TLimb;
7533
begin
7534
  if Value.FData = nil then
7535
    Exit(Zero);
7536
  LSign := SignBitOf(Value.FSize);
7537
  LimbShift := Shift div CLimbBits;
7538
  Shift := Shift mod CLimbBits;
7539
  Result.MakeSize((Value.FSize and SizeMask) + LimbShift + 1);
7540
  if Shift > 0 then
7541
    InternalShiftLeft(PLimb(Value.FData), PLimb(Result.FData) + LimbShift, Shift, (Value.FSize and SizeMask))
7542
  else
7543
    CopyLimbs(PLimb(Value.FData), PLimb(Result.FData) + LimbShift, (Value.FSize and SizeMask));
7544
//    Move(Value.FData[0], Result.FData[LimbShift], (Value.FSize and SizeMask) * CLimbSize);
7545
  Result.FSize := (Result.FSize and SizeMask) or Integer(LSign);
7546
  Result.Compact;
7547

7548
  // The following can probably be omitted.
7549
//  if LimbShift > 0 then
7550
//    FillChar(Result.FData[0], CLimbSize * LimbShift, 0);
7551
end;
7552

7553
class operator BigInteger.LessThan(const Left, Right: BigInteger): Boolean;
7554
begin
7555
  Result := Compare(Left, Right) < 0;
7556
end;
7557

7558
class operator BigInteger.LessThanOrEqual(const Left, Right: BigInteger): Boolean;
7559
begin
7560
  Result := Compare(left, Right) <= 0;
7561
end;
7562

7563
function BigInteger.BitLength: Integer;
7564
begin
7565
  if Self.FData = nil then
7566
    Result := 0
7567
  else
7568
  begin
7569
    Result := CLimbBits * (Size - 1) + Velthuis.Numerics.BitLength(FData[Size - 1]);
7570

7571
    // IsPowerOfTwo is expensive, but probably less expensive than a copy and
7572
    // subsequent decrement, like in BitCount.
7573
    if (FSize < 0) and (Self.IsPowerOfTwo) then
7574
      Dec(Result);
7575
  end;
7576
end;
7577

7578
function BigInteger.BitCount: Integer;
7579
var
7580
  Mag: TMagnitude;
7581
  I: Integer;
7582
begin
7583
  if FData = nil then
7584
    Exit(0);
7585

7586
  if FSize > 0 then
7587
    Mag := FData
7588
  else
7589
  begin
7590
    Mag := Copy(FData);
7591
    InternalDecrement(PLimb(Mag), FSize and SizeMask);
7592
  end;
7593

7594
  Result := 0;
7595
  for I := 0 to Size - 1 do
7596
    Result := Result + Velthuis.Numerics.BitCount(Mag[I]);
7597
end;
7598

7599
// http://stackoverflow.com/a/7982137/95954
7600
class function BigInteger.Ln(const Int: BigInteger): Double;
7601
var
7602
  BLex: Integer;
7603
  NewInt: BigInteger;
7604
begin
7605
  if Int.IsNegative then
7606
    Exit(Math.NaN)
7607
  else if Int.IsZero then
7608
    Exit(Math.NegInfinity);
7609
  BLex := Int.BitLength - 1022;
7610
  if BLex > 0 then
7611
    NewInt := Int shr BLex
7612
  else
7613
    NewInt := Int;
7614
  Result := System.Ln(NewInt.AsDouble);
7615
  if BLex > 0 then
7616
    Result := Result + BLex * System.Ln(2.0);
7617
end;
7618

7619
class function BigInteger.Log(const Int: BigInteger; Base: Double): Double;
7620
begin
7621
  Result := BigInteger.Ln(Int) / System.Ln(Base);
7622
end;
7623

7624
class function BigInteger.Log10(const Int: BigInteger): Double;
7625
begin
7626
  Result := Log(Int, 10.0);
7627
end;
7628

7629
class function BigInteger.Log2(const Int: BigInteger): Double;
7630
begin
7631
  Result := Log(Int, 2.0);
7632
end;
7633

7634
class operator BigInteger.LogicalNot(const Int: BigInteger): BigInteger;
7635
begin
7636
  Result := Int;
7637
  Inc(Result);
7638
  if Result.FSize <> 0 then
7639
    Result.FSize := Result.FSize xor SignMask;
7640
end;
7641

7642
class function BigInteger.Max(const Left, Right: BigInteger): BigInteger;
7643
begin
7644
  if Left > Right then
7645
    ShallowCopy(Left, Result)
7646
  else
7647
    ShallowCopy(Right, Result);
7648
end;
7649

7650
class function BigInteger.Min(const Left, Right: BigInteger): BigInteger;
7651
begin
7652
  if Left < Right then
7653
    ShallowCopy(Left, Result)
7654
  else
7655
    ShallowCopy(Right, Result);
7656
end;
7657

7658
// http://stackoverflow.com/questions/8496182/calculating-powa-b-mod-n
7659
class function BigInteger.ModPow(const ABase, AExponent, AModulus: BigInteger): BigInteger;
7660
var
7661
  Base: BigInteger;
7662
  Exp: BigInteger;
7663
begin
7664
  Exp := AExponent;
7665
  Base := ABase mod AModulus;
7666
  Result := BigInteger.One;
7667
  while Exp > Zero do
7668
  begin
7669
    if not Exp.IsEven then
7670
      Result := (Result * Base) mod AModulus;
7671
    Base := (Base * Base) mod AModulus;
7672
    Exp := Exp shr 1;
7673
  end;
7674
end;
7675

7676
class operator BigInteger.Modulus(const Left, Right: BigInteger): BigInteger;
7677
begin
7678
  Result := Remainder(Left, Right);
7679
end;
7680

7681
class operator BigInteger.Modulus(const Left: BigInteger; Right: UInt32): BigInteger;
7682
begin
7683
  Result := Remainder(Left, Right);
7684
end;
7685

7686
class operator BigInteger.Modulus(const Left: BigInteger; Right: UInt16): BigInteger;
7687
begin
7688
  Result := Remainder(Left, Right);
7689
end;
7690

7691
class procedure BigInteger.InternalMultiplyAndAdd(const Multiplicand: TMagnitude; Multiplicator, Addend: Word; const Res: TMagnitude);
7692
{$IF DEFINED(PUREPASCAL)}
7693
type
7694
  WordRec = packed record
7695
    Lo, Hi: Word;
7696
  end;
7697
var
7698
  I: Cardinal;
7699
  LProduct: Cardinal;
7700
  LHighWord: Word;
7701
  LLength: Cardinal;
7702
begin
7703
  LLength := Cardinal(Length(Multiplicand)) * 2;
7704
  LHighWord := 0;
7705
  I := 0;
7706
  while I < LLength-1 do
7707
  begin
7708
    LProduct := PWord(Multiplicand)[I] * Multiplicator + LHighWord;
7709
    PWord(Res)[I] := WordRec(LProduct).Lo;
7710
    LHighWord := WordRec(LProduct).Hi;
7711
    Inc(I);
7712
  end;
7713
  PWord(Res)[I] := LHighWord;
7714
  I := 0;
7715
  LHighword := 0;
7716
  while LLength > 0 do
7717
  begin
7718
    Res[I] := Res[I] + Addend + LHighword;
7719
    LHighWord := Word(Res[I] < Addend + LHighword);
7720
    Addend := 0;
7721
    Dec(LLength);
7722
    Inc(I);
7723
  end;
7724
end;
7725
{$ELSEIF DEFINED(WIN32)}
7726
var
7727
  LLength: Integer;
7728
  LExtra: Word;
7729
  LMultiplicator: Word;
7730
  LProduct: Cardinal;
7731
asm
7732
       PUSH    EBX
7733
       PUSH    ESI
7734
       PUSH    EDI
7735

7736
       MOV     LExtra,CX
7737
       MOV     LMultiplicator,DX
7738

7739
       MOV     ESI,EAX
7740
       MOV     EDI,Res
7741

7742
       TEST    EAX,EAX
7743
       JZ      @NotNil
7744
       MOV     EAX,[EAX - TYPE NativeInt]
7745

7746
@NotNil:
7747

7748
       MOV     LLength,EAX
7749
       XOR     ECX,ECX                          // ECX used for overflow.
7750
       XOR     EBX,EBX                          // EBX = I
7751
       CMP     EBX,LLength
7752
       JNB     @SkipMult
7753

7754
@MultLoop:
7755

7756
       MOV     EAX,[ESI + CLimbSize*EBX]        // EAX,EDX required for multiplication.
7757
       MOVZX   EDX,LMultiplicator
7758
       MUL     EDX
7759
       ADD     EAX,ECX                          // Add in overflow of previous multiplication.
7760
       ADC     EDX,0
7761
       MOV     [EDI + CLimbSize*EBX],EAX
7762
       MOV     ECX,EDX                          // Overflow.
7763
       LEA     EBX,[EBX + 1]
7764
       CMP     EBX,LLength
7765
       JB      @MultLoop
7766

7767
@SkipMult:
7768

7769
       MOV     [EDI + CLimbSize*EBX],EDX
7770

7771
       MOV     ECX,LLength
7772
       XOR     EBX,EBX
7773
       MOVZX   EAX,LExtra
7774

7775
@AddLoop:
7776

7777
       ADC     [EDI + CLimbSize*EBX],EAX
7778
       JNC     @Exit
7779
       MOV     EAX,0
7780
       LEA     EBX,[EBX + 1]
7781
       LEA     ECX,[ECX - 1]
7782
       JECXZ   @Exit
7783
       JMP     @AddLoop
7784

7785
@Exit:
7786

7787
       POP     EDI
7788
       POP     ESI
7789
       POP     EBX
7790
end;
7791
{$ELSE WIN64}
7792
asm
7793
      .PUSHNV RBX
7794

7795
       PUSH    R8                       // PUSH Extra
7796
       MOVZX   R8D,DX                   // R8W = Multiplicator
7797
       MOV     R10,RCX
7798
       TEST    R10,R10
7799
       JZ      @@1
7800
       MOV     R10,[R10-8]              // R10D = Length(Multiplicand)
7801
@@1:
7802
       XOR     R11D,R11D                // R11D = I
7803
       XOR     EBX,EBX
7804
       CMP     R11D,R10D
7805
       JNB     @@3
7806
@@2:
7807
       MOV     EAX,[RCX + CLimbSize*R11]
7808
       MUL     EAX,R8D
7809
       ADD     EAX,EBX
7810
       ADC     EDX,0
7811
       MOV     [R9 + CLimbSize*R11],EAX
7812
       MOV     EBX,EDX
7813
       INC     R11D
7814
       CMP     R11D,R10D
7815
       JB      @@2
7816
@@3:
7817
       MOV     [R9 + CLimbSize*R11],EDX
7818
       POP     RDX                      // POP Extra
7819
       MOVZX   EDX,DX
7820
       XOR     EBX,EBX
7821
@@4:
7822
       ADC     [R9 + CLimbSize*RBX],EDX
7823
       MOV     EDX,0                    //
7824
       INC     EBX                      // These 3 instructions should not modify the carry flag!
7825
       DEC     R10D                     //
7826
       JNE     @@4
7827
end;
7828
{$IFEND}
7829

7830
class operator BigInteger.Multiply(const Left: BigInteger; Right: Word): BigInteger;
7831
begin
7832
  if (Right = 0) or ((Left.FSize and SizeMask) = 0) then
7833
    Exit(Zero);
7834
  Result.MakeSize((Left.FSize and SizeMask) + 2);
7835
  InternalMultiplyAndAdd(Left.FData, Right, 0, Result.FData);
7836
  Result.FSize := (Left.FSize and SignMask) or (Result.FSize and SizeMask);
7837
  Result.Compact;
7838
end;
7839

7840
class operator BigInteger.Multiply(Left: Word; const Right: BigInteger): BigInteger;
7841
begin
7842
  Result := Right * Left;
7843
end;
7844

7845
class function BigInteger.MultiplyKaratsuba(const Left, Right: BigInteger): BigInteger;
7846
var
7847
  k, LSign: Integer;
7848
  z0, z1, z2: BigInteger;
7849
  x, y: TArray<BigInteger>;
7850
begin
7851
  if ((Left.FSize and SizeMask) < KaratsubaThreshold) or ((Right.FSize and SizeMask) < KaratsubaThreshold) then
7852
    Exit(MultiplyBaseCase(Left, Right));
7853

7854
  //////////////////////////////////////////////////////////////////////////////////////////////////
7855
  ///  This is a so called divide and conquer algorithm, solving a big task by dividing it up    ///
7856
  ///  into easier (and hopefully faster, in total) smaller tasks.                               ///
7857
  ///                                                                                            ///
7858
  ///  Let's treat a BigInteger as a polynomial, i.e. x = x1 * B + x0, where B is chosen thus,   ///
7859
  ///  that the top and the low part of the BigInteger are almost the same in size.              ///
7860
  ///  The result R of the multiplication of two such polynomials can be seen as:                ///
7861
  ///                                                                                            ///
7862
  ///  R = (x1 * B + x0) * (y1 * B + y0) = x1 * y1 * B^2 + (x1 * y0 + x0 * y1) * B + x0 * y0     ///
7863
  ///                                                                                            ///
7864
  ///  say, z0 = x0 * y0                                                                         ///
7865
  ///       z1 = x1 * y0 + x0 * y1                                                               ///
7866
  ///       z2 = x1 * y1                                                                         ///
7867
  ///                                                                                            ///
7868
  ///  then                                                                                      ///
7869
  ///  R = z2 * B^2 + z1 * B + z0                                                                ///
7870
  ///                                                                                            ///
7871
  ///  Karatsuba noted that:                                                                     ///
7872
  ///                                                                                            ///
7873
  ///  (x1 + x0) * (y1 + y0) = z2 + z1 + z0, so z1 = (x1 + x0) * (y1 + y0) - (z2 + z0)           ///
7874
  ///                                                                                            ///
7875
  ///  That reduced four multiplications and a few additions to three multiplications, a few     ///
7876
  ///  additions and a subtraction. Surely the parts will be multilimb, but this is called       ///
7877
  ///  recursively down until the sizes are under a threshold, and then simple base case         ///
7878
  ///  (a.k.a. "schoolbook") multiplication is performed.                                        ///
7879
  //////////////////////////////////////////////////////////////////////////////////////////////////
7880

7881
  //////////////////////////////////////////////////////////////////////////////////////////////////
7882
  ///  Note: it may look tempting to use pointers into the original operands, to use one large   ///
7883
  ///  buffer for all results, and to use InternalMultiply directly, but remember that           ///
7884
  ///  InternalMultiply performs a basecase multiplication and it does NOT resurse into a        ///
7885
  ///  deeper level of MultiplyKaratsuba, so after one level, the advantage gained by reducing   ///
7886
  ///  the number of multiplications would be minimal.                                           ///
7887
  ///                                                                                            ///
7888
  ///  There is an overhead caused by using complete BigIntegers, but it is not as high as it    ///
7889
  ///  may look.                                                                                 ///
7890
  //////////////////////////////////////////////////////////////////////////////////////////////////
7891

7892
  LSign := (Left.FSize xor Right.FSize) and SignMask;
7893

7894
  k := (IntMax(Left.FSize and SizeMask, Right.FSize and SizeMask) + 1) shr 1;
7895

7896
  x := Left.Split(k, 2);
7897
  y := Right.Split(k, 2);
7898

7899
  // Recursion further reduces the number of multiplications!
7900
  z2 := MultiplyKaratsuba(x[1], y[1]);
7901
  z0 := MultiplyKaratsuba(x[0], y[0]);
7902
  z1 := MultiplyKaratsuba(x[1] - x[0], y[0] - y[1]) + (z2 + z0);
7903

7904
  Result := z0;
7905
  Result.AddWithOffset(z2, k * 2);
7906
  Result.AddWithOffset(z1, k);
7907

7908
  Result.FSize := (Result.FSize and SizeMask) or LSign;
7909
end;
7910

7911
// Used by Karatsuba, Toom-Cook and Burnikel-Ziegler algorithms.
7912
// Splits Self into BlockCount pieces of (at most) BlockSize limbs, starting with the least significant part.
7913
function BigInteger.Split(BlockSize, BlockCount: Integer): TArray<BigInteger>;
7914
var
7915
  I: Integer;
7916
begin
7917
  SetLength(Result, BlockCount);
7918
  for I := 0 to BlockCount - 1 do
7919
  begin
7920
    if (Self.FSize and BigInteger.SizeMask) > I * BlockSize then
7921
    begin
7922
      Result[I].MakeSize(IntMin(BlockSize, (Self.FSize and SizeMask) - I * BlockSize));
7923
      CopyLimbs(PLimb(Self.FData) + I * BlockSize, PLimb(Result[I].FData), IntMin(BlockSize, (Self.FSize and SizeMask) - I * BlockSize));
7924
      Result[I].Compact;
7925
    end
7926
    else
7927
      ShallowCopy(Zero, Result[I]);
7928
  end;
7929
end;
7930

7931
{$IFNDEF PUREPASCAL}
7932
class procedure BigInteger.InternalDivideBy3(Value, Result: PLimb; ASize: Integer);
7933
const
7934
  MultConst = $AAAAAAAB;
7935
  MultConst2 = $55555556;
7936
{$IFDEF WIN32}
7937
asm
7938
        PUSH    ESI
7939
        PUSH    EDI
7940
        PUSH    EBX
7941

7942
        MOV     ESI,EAX
7943
        MOV     EDI,EDX
7944
        XOR     EBX,EBX
7945

7946
@Loop:
7947

7948
        MOV     EAX,[ESI]
7949
        SUB     EAX,EBX
7950
        SETC    BL
7951

7952
        MOV     EDX,MultConst
7953
        MUL     EAX,EDX
7954
        MOV     [EDI],EAX
7955

7956
        CMP     EAX,MultConst2
7957
        JB      @SkipInc
7958
        INC     EBX
7959
        CMP     EAX,MultConst
7960
        JB      @SkipInc
7961
        INC     EBX
7962

7963
@SkipInc:
7964

7965
        LEA     ESI,[ESI + CLimbSize]
7966
        LEA     EDI,[EDI + CLimbSize]
7967
        DEC     ECX
7968
        JNE     @Loop
7969

7970
@Exit:
7971

7972
        POP     EBX
7973
        POP     EDI
7974
        POP     ESI
7975
end;
7976
{$ELSE WIN64}
7977
asm
7978
        XOR     R9D,R9D
7979
        MOV     R10,RDX
7980

7981
@Loop:
7982

7983
        MOV     EAX,[RCX]
7984
        SUB     EAX,R9D
7985
        SETC    R9B
7986

7987
        MOV     EDX,MultConst
7988
        MUL     EAX,EDX
7989
        MOV     [R10],EAX
7990

7991
        CMP     EAX,MultConst2
7992
        JB      @SkipInc
7993
        INC     R9D
7994
        CMP     EAX,MultConst
7995
        JB      @SkipInc
7996
        INC     R9D
7997

7998
@SkipInc:
7999

8000
        LEA     RCX,[RCX + CLimbSize]
8001
        LEA     R10,[R10 + CLimbSize]
8002
        DEC     R8D
8003
        JNE     @Loop
8004
end;
8005
{$ENDIF WIN64}
8006
{$ENDIF !PUREPASCAL}
8007

8008
// Only works if it is known that there is no remainder and A is positive.
8009
class function BigInteger.DivideBy3Exactly(const A: BigInteger): BigInteger;
8010
const
8011
  ModInverse3 = $AAAAAAAB; // Modular inverse of 3 modulo $100000000.
8012
  ModInverse3t2 = $55555556; // 2 * ModInverse3
8013
{$IFDEF PUREPASCAL}
8014
var
8015
  i: Integer;
8016
  ai, w, qi, borrow: Int64;
8017
begin
8018
  if A.FData = nil then
8019
  begin
8020
    ShallowCopy(Zero, Result);
8021
    Exit;
8022
  end;
8023

8024
  Result.MakeSize(A.FSize and SizeMask);
8025
  borrow := 0;
8026
  for i := 0 to (A.FSize and SizeMask) - 1 do
8027
  begin
8028
    ai := A.FData[i];
8029
    w := ai - borrow;
8030
    if borrow > ai then
8031
      borrow := 1
8032
    else
8033
      borrow := 0;
8034

8035
    qi := (w * ModInverse3) and $FFFFFFFF;
8036
    Result.FData[i] := UInt32(qi);
8037

8038
    if qi >= ModInverse3t2 then
8039
    begin
8040
      Inc(borrow);
8041
      if qi >= ModInverse3 then
8042
        Inc(borrow);
8043
    end;
8044
  end;
8045

8046
  Result.Compact;
8047
end;
8048
{$ELSE !PUREPASCAL}
8049
begin
8050
  if A.FData = nil then
8051
  begin
8052
    ShallowCopy(Zero, Result);
8053
    Exit;
8054
  end;
8055

8056
  Result.MakeSize(A.FSize and SizeMask);
8057
  InternalDivideBy3(PLimb(A.FData), PLimb(Result.FData), A.FSize and SizeMask);
8058
  Result.Compact;
8059
end;
8060
{$ENDIF !PUREPASCAL}
8061

8062
class function BigInteger.MultiplyToomCook3(const Left, Right: BigInteger): BigInteger;
8063
var
8064
  k: Integer;
8065
  a, b: TArray<BigInteger>;
8066
  a02, b02: BigInteger;
8067
  v0, v1, vm1, v2, vinf: BigInteger;
8068
  t1, t2: BigInteger;
8069
  Sign: Integer;
8070
begin
8071
  // Step 1: if n < threshold then return KaratsubaMultiply(A, B)
8072
  if ((Left.FSize and SizeMask) < ToomCook3Threshold) and ((Right.FSize and SizeMask) < ToomCook3Threshold) then
8073
    Exit(MultiplyKaratsuba(Left, Right));
8074

8075
  Sign := (Left.FSize xor Right.FSize) and SignMask;
8076

8077
  // Richard P. Brent and Paul Zimmermann,
8078
  // "Modern Computer Arithmetic", version 0.5.1 of April 28, 2010
8079
  // http://arxiv.org/pdf/1004.4710v1.pdf
8080

8081
  //////////////////////////////////////////////////////////////////////////////
8082
  // Hint to myself: If necessary, take a look at Bodrato's improved version. //
8083
  // But be aware that most of his *code* is GPL-ed and now part of GMP.      //
8084
  //////////////////////////////////////////////////////////////////////////////
8085

8086
  // Step 2: write A = a0 +a1*x + a2*x^2, B = b0 + b1*x + b2*x^2, with x = ß^k.
8087
  k := (IntMax(Left.FSize and SizeMask, Right.FSize and SizeMask) + 2) div 3;
8088

8089
  a := Left.Split(k, 3);
8090
  b := Right.Split(k, 3);
8091

8092
  // Evaluation at x = -1, 0, 1, 2 and +inf.
8093

8094
  // Step 3: v0 <- ToomCook3(a0, b0)
8095
  v0 := MultiplyToomCook3(a[0], b[0]);
8096

8097
  // Step 4a: a02 <- a0 + a2, b02 <- b0 + b2
8098
  a02 := a[0] + a[2];
8099
  b02 := b[0] + b[2];
8100

8101
  // Step 5: v(-1) <- ToomCook3(a02 - a1, b02 - b1) = ToomCook3(a0 + a2 - a1, b0 + b2 - b1)
8102
  vm1 := MultiplyToomCook3(a02 - a[1], b02 - b[1]);
8103

8104
  // Intermediate step: a'02 = a02 + a1, b'02 = b02 + b1
8105
  a02 := a02 + a[1];
8106
  b02 := b02 + b[1];
8107

8108
  // Step 4b: v1 <- ToomCook3(a02 + a1, b02 + b1) = ToomCook3(a'02, b'02)
8109
  v1 := MultiplyToomCook3(a02, b02);
8110

8111
  // Step 6: v2 <- ToomCook3(a0 + 2*a1 + 4*a2, b0 + 2*b1 + 4*b2)
8112
  // Note: first operand is a0 + a1 + a1 + a2 + a2 + a2 + a2 = 2*(a0 + a1 + a2 + a2) - a0 = 2*(a'02 + a2) - a0
8113
  v2 := MultiplyToomCook3((a02 + a[2]) shl 1 - a[0], (b02 + b[2]) shl 1 - b[0]);
8114

8115
  // Step 7: v(inf) <- ToomCook3(a2, b2)
8116
  vinf := MultiplyToomCook3(a[2], b[2]);
8117

8118
  // Step 8: t1 <- (3*v0 + 2*v(−1) + v2)/6 − 2 * v(inf), t2 <- (v1 + v(−1))/2
8119
  t1 := DivideBy3Exactly(((v0 + vm1) shl 1 + v2 + v0) shr 1) - (vinf shl 1);
8120
  t2 := (v1 + vm1) shr 1;
8121

8122
  // Step 9: c0 <- v0, c1 <- v1 - t1, c2 <- t2 - v0 - vinf, c3 <- t1 - t2, c4 <- vinf
8123
  ShallowCopy(v0, Result);
8124
  Result.AddWithOffset(vinf, 4*k);
8125
  Result.AddWithOffset(t1 - t2, 3*k);
8126
  Result.AddWithOffset(t2 - v0 - vinf, 2*k);
8127
  Result.AddWithOffset(v1 - t1, k);
8128

8129
  Result.FSize := (Result.FSize and SizeMask) or Sign;
8130

8131
end;
8132

8133
{$IFDEF Experimental}
8134
class function BigInteger.MultiplyToomCook3Threshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger;
8135
var
8136
  k: Integer;
8137
  a, b: TArray<BigInteger>;
8138
  a02, b02: BigInteger;
8139
  v0, v1, vm1, v2, vinf: BigInteger;
8140
  t1, t2: BigInteger;
8141
  c0, c1, c2, c3, c4: BigInteger;
8142
  Sign: Integer;
8143
begin
8144
  Sign := (Left.FSize xor Right.FSize) and SignMask;
8145

8146
  // Richard P. Brent and Paul Zimmermann,
8147
  // "Modern Computer Arithmetic", version 0.5.1 of April 28, 2010
8148
  // http://arxiv.org/pdf/1004.4710v1.pdf
8149

8150
  // Hint to myself: If necessary, take a look at Bodrato's improved version.
8151
  // But be aware that most of his *code* is GPL-ed and now part of GMP.
8152

8153
  // Step 1: if n < threshold then return KaratsubaMultiply(A, B)
8154
  if ((Left.FSize and SizeMask) < Threshold) or ((Right.FSize and SizeMask) < Threshold) then
8155
    Exit(MultiplyKaratsuba(Left, Right));
8156

8157
  // Step 2: write A = a0 +a1*x + a2*x^2, B = b0 + b1*x + b2*x^2, with x = ß^k.
8158
  k := (IntMax(Left.FSize and SizeMask, Right.FSize and SizeMask) + 2) div 3;
8159

8160
  a := Left.Split(k, 3);
8161
  b := Right.Split(k, 3);
8162

8163
  // Step 3: v0 <- ToomCook3(a0, b0)
8164
  v0 := MultiplyToomCook3Threshold(a[0], b[0], Threshold);
8165

8166
  // Step 4a: a02 <- a0 + a2, b02 <- b0 + b2
8167
  a02 := a[0] + a[2];
8168
  b02 := b[0] + b[2];
8169

8170
  // Step 4b: v1 <- ToomCook3(a02 + a1, b02 + b1)
8171
  v1 := MultiplyToomCook3Threshold(a02 + a[1], b02 + b[1], Threshold);
8172

8173
  // Step 5: v(-1) <- ToomCook3(a02 - a1, b02 - b1)
8174
  vm1 := MultiplyToomCook3Threshold(a02 - a[1], b02 - b[1], Threshold);
8175

8176
  // Step 6: v2 <- ToomCook3(a0 + 2*a1 + 4*a2, b0 + 2*b1 + 4*b2)
8177
  v2 := MultiplyToomCook3Threshold(a[0] + a[1] shl 1 + a[2] shl 2, b[0] + b[1] shl 1 + b[2] shl 2, Threshold);
8178

8179
  // Step 7: v(inf) <- ToomCook3(a2, b2)
8180
  vinf := MultiplyToomCook3Threshold(a[2], b[2], Threshold);
8181

8182
  // Step 8: t1 <- (3*v0 + 2*v(-1) + v2) / 6 - 2*v(inf), t2 <- (v1 + v(-1)) / 2
8183
  t1 := ((v0 shl 1 + v0 + vm1 shl 1 + v2) shr 1) div BigInteger(3) - vinf shl 1;  // $$RV make exactdiv3 or divbyword with constant
8184
  t2 := (v1 + vm1) shr 1;
8185

8186
  // Step 9:
8187
  c0 := v0;
8188
  c1 := v1 - t1;
8189
  c2 := t2 - v0 - vinf;
8190
  c3 := t1 - t2;
8191
  c4 := vinf;
8192

8193
  // Output: AB = c0 + c1*ß^k + c2*ß^2*k + c3*ß^3*k + c4*ß^4*k
8194
  Result := c0;
8195
  if c4.FData <> nil then
8196
    Result.AddWithOffset(c4, 4 * k);
8197
  if c1.FData <> nil then
8198
    Result.AddWithOffset(c1, k);
8199
  if c2.FData <> nil then
8200
    Result.AddWithOffset(c2, 2 * k);
8201
  if c3.FData <> nil then
8202
    Result.AddWithOffset(c3, 3 * k);
8203

8204
  Result.FSize := (Result.FSize and SizeMask) or Sign;
8205
end;
8206

8207
class function BigInteger.MultiplyKaratsubaThreshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger;
8208
var
8209
  NDiv2Shift, NDiv2: Integer;
8210
  LeftUpper, RightUpper: BigInteger;
8211
  LeftLower, RightLower: BigInteger;
8212
  Upper, Middle, Lower: BigInteger;
8213
  LSize, LSign: Integer;
8214
begin
8215
  if (Left.Size < Threshold) or (Right.Size < Threshold) then
8216
    Exit(MultiplyBaseCase(Left, Right));
8217

8218
  LSign := (Left.FSize xor Right.FSize) and SignMask;
8219
  LSize := IntMax((Left.FSize and SizeMask), (Right.FSize and SizeMask));
8220
  NDiv2Shift := (LSize and $FFFFFFFE) shl 4; // := LSize div 2 * SizeOf(TLimb);
8221
  NDiv2 := LSize div 2;
8222

8223
  // Split Left
8224
  if (Left.FSize and SizeMask) > NDiv2 then
8225
  begin
8226
    LeftLower.MakeSize(NDiv2);
8227
    CopyLimbs(PLimb(Left.FData), PLimb(LeftLower.FData), NDiv2);
8228
    LeftUpper.MakeSize((Left.FSize and SizeMask) - NDiv2);
8229
    CopyLimbs(PLimb(Left.FData) + NDiv2, PLimb(LeftUpper.FData), (Left.FSize and SizeMask) - NDiv2);
8230
    LeftLower.Compact;
8231
  end
8232
  else
8233
  begin
8234
    ShallowCopy(Zero, LeftUpper);
8235
    ShallowCopy(Left, LeftLower);
8236
  end;
8237

8238
  // Split Right
8239
  if (Right.FSize and SizeMask) > NDiv2 then
8240
  begin
8241
    RightLower.MakeSize(NDiv2);
8242
    CopyLimbs(PLimb(Right.FData), PLimb(RightLower.FData), NDiv2);
8243
    RightUpper.MakeSize((Right.FSize and SizeMask) - NDiv2);
8244
    CopyLimbs(PLimb(Right.FData) + NDiv2, PLimb(RightUpper.FData), (Right.FSize and SizeMask) - NDiv2);
8245
    RightLower.Compact;
8246
  end
8247
  else
8248
  begin
8249
    ShallowCopy(Zero, RightUpper);
8250
    ShallowCopy(Right, RightLower)
8251
  end;
8252

8253
  Upper := MultiplyKaratsubaThreshold(LeftUpper, RightUpper, Threshold);
8254
  Lower := MultiplyKaratsubaThreshold(LeftLower, RightLower, Threshold);
8255
  Middle := MultiplyKaratsubaThreshold(LeftUpper - LeftLower, RightLower - RightUpper, Threshold) + (Lower + Upper);
8256

8257
  // Can't just move these values into place, because they still overlap when shifted.
8258
  Result := Upper shl (NDiv2Shift + NDiv2Shift) + Middle shl NDiv2Shift + Lower;
8259
  Result.FSize := (Result.FSize and SizeMask) or LSign;
8260
end;
8261
{$ENDIF Experimental}
8262

8263
class function BigInteger.SqrKaratsuba(const Value: BigInteger): BigInteger;
8264
var
8265
  NDiv2Shift, NDiv2: Integer;
8266
  ValueUpper: BigInteger;
8267
  ValueLower: BigInteger;
8268
  Upper, Middle, Lower: BigInteger;
8269
  LSize: Integer;
8270
begin
8271
  LSize := (Value.FSize and SizeMask);
8272
  NDiv2Shift := (LSize and $FFFFFFFE) shl 4; // := LSize div 2 * SizeOf(TLimb);
8273
  NDiv2 := LSize div 2;
8274

8275
  ValueLower.MakeSize(NDiv2);
8276
  CopyLimbs(PLimb(Value.FData), PLimb(ValueLower.FData), NDiv2);
8277
  ValueUpper.MakeSize((Value.FSize and SizeMask) - NDiv2);
8278
  CopyLimbs(PLimb(Value.FData) + NDiv2, PLimb(ValueUpper.FData), (Value.FSize and SizeMask) - NDiv2);
8279
  ValueLower.Compact;
8280

8281
  Upper := Sqr(ValueUpper);
8282
  Lower := Sqr(ValueLower);
8283
  Middle := (ValueUpper * ValueLower) shl 1;
8284

8285
  // Can't simply move these values into place, because they still overlap when shifted.
8286
  Result := Upper shl (NDiv2Shift + NDiv2Shift) + Middle shl NDiv2Shift + Lower;
8287
  Result.FSize := Result.FSize and SizeMask;
8288
end;
8289

8290
class function BigInteger.SqrKaratsubaThreshold(const Value: BigInteger; Threshold: Integer): BigInteger;
8291
var
8292
  k: Integer;
8293
//  x0, x1: BigInteger;
8294
  x: TArray<BigInteger>;
8295
  z2, z1, z0: BigInteger;
8296
  LSize: Integer;
8297
begin
8298
  LSize := (Value.FSize and SizeMask);
8299
  if LSize < Threshold then
8300
  begin
8301
    Exit(MultiplyKaratsuba(Value, Value));
8302
  end;
8303

8304
  k := LSize div 2;
8305

8306
  x := Value.Split(k, 2);
8307

8308
  z2 := SqrKaratsubaThreshold(x[1], Threshold);
8309
  z0 := SqrKaratsubaThreshold(x[0], Threshold);
8310
  z1 := (x[1] * x[0]) shl 1;
8311

8312
  Result := z0;
8313
  if z2.FData <> nil then
8314
    Result.AddWithOffset(z2, 2*k);
8315
  if z1.FData <> nil then
8316
    Result.AddWithOffset(z1, k);
8317

8318
  Result.FSize := Result.FSize and SizeMask;
8319
end;
8320

8321
class function BigInteger.Multiply(const Left, Right: BigInteger): BigInteger;
8322
var
8323
  LResult: BigInteger; // Avoid prematurely overwriting result when it is same as one of the operands.
8324
begin
8325
  if (Left.FData = nil) or (Right.FData = nil) then
8326
  begin
8327
    ShallowCopy(BigInteger.Zero, Result);
8328
    Exit;
8329
  end;
8330

8331
  if ((Left.FSize and SizeMask) < KaratsubaThreshold) or ((Right.FSize and SizeMask) < KaratsubaThreshold) then
8332
  begin
8333
    // The following block is "Result := MultiplyBaseCase(Left, Right);" written out in full.
8334
    LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 1);
8335
    InternalMultiply(PLimb(Left.FData), PLimb(Right.FData), PLimb(LResult.FData), (Left.FSize and SizeMask), (Right.FSize and SizeMask));
8336
    LResult.Compact;
8337
    LResult.FSize := (LResult.FSize and SizeMask) or ((Left.FSize xor Right.FSize) and SignMask);
8338
    ShallowCopy(LResult, Result);
8339
  end
8340
  else
8341
  begin
8342
    if ((Left.FSize and SizeMask) < ToomCook3Threshold) and ((Right.FSize and SizeMask) < ToomCook3Threshold) then
8343
      Result := MultiplyKaratsuba(Left, Right)
8344
    else
8345
      Result := MultiplyToomCook3(Left, Right);
8346
  end;
8347
end;
8348

8349
class function BigInteger.MultiplyThreshold(const Left, Right: BigInteger; Threshold: Integer): BigInteger;
8350
var
8351
  LResult: BigInteger; // Avoid prematurely overwriting result when it is same as one of the operands.
8352
begin
8353
  if (Left.FData = nil) or (Right.FData = nil) then
8354
  begin
8355
    ShallowCopy(BigInteger.Zero, Result);
8356
    Exit;
8357
  end;
8358

8359
  if ((Left.FSize and SizeMask) < Threshold) or ((Right.FSize and SizeMask) < Threshold) then
8360
  begin
8361
    LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 1);
8362
    InternalMultiply(PLimb(Left.FData), PLimb(Right.FData), PLimb(LResult.FData), (Left.FSize and SizeMask), (Right.FSize and SizeMask));
8363
    LResult.Compact;
8364
    LResult.SetSign(SignBitOf(Left.FSize) xor SignBitOf(Right.FSize));
8365
    ShallowCopy(LResult, Result);
8366
  end
8367
  else
8368
    Result := MultiplyKaratsubaThreshold(Left, Right, Threshold);
8369
end;
8370

8371
class function BigInteger.MultiplyBaseCase(const Left, Right: BigInteger): BigInteger;
8372
var
8373
  LResult: BigInteger; // Avoid prematurely overwriting result when it is same as one of the operands.
8374
begin
8375
  if (Left.FData = nil) or (Right.FData = nil) then
8376
  begin
8377
    ShallowCopy(Zero, Result);
8378
    Exit;
8379
  end;
8380

8381
  LResult.MakeSize((Left.FSize and SizeMask) + (Right.FSize and SizeMask) + 1);
8382
  InternalMultiply(PLimb(Left.FData), PLimb(Right.FData), PLimb(LResult.FData), (Left.FSize and SizeMask), (Right.FSize and SizeMask));
8383
  LResult.Compact;
8384
  LResult.SetSign(SignBitOf(Left.FSize) xor SignBitOf(Right.FSize));
8385
  ShallowCopy(LResult, Result);
8386
end;
8387

8388
class operator BigInteger.Multiply(const Left, Right: BigInteger): BigInteger;
8389
begin
8390
  Result := Multiply(Left, Right);
8391
end;
8392

8393
class procedure BigInteger.SetBase(const Value: TNumberBase);
8394
begin
8395
  FBase := Value;
8396
end;
8397

8398
procedure BigInteger.SetSign(Value: Integer);
8399
begin
8400
  FSize := (FSize and SizeMask) or (Ord(Value < 0) * SignMask);
8401
end;
8402

8403
function BigInteger.Subtract(const Other: BigInteger): PBigInteger;
8404
var
8405
  MinusOther: BigInteger;
8406
begin
8407
  ShallowCopy(Other, MinusOther);
8408
  MinusOther.FSize := MinusOther.FSize xor SignMask;
8409
  Result := Add(MinusOther);
8410
end;
8411

8412
class function BigInteger.Subtract(const Left, Right: BigInteger): BigInteger;
8413
const
8414
  BoolMasks: array[Boolean] of Integer = (SignMask, 0);
8415
var
8416
  Largest, Smallest: PBigInteger;
8417
  Res: BigInteger;
8418
  Comparison: TValueSign;
8419
begin
8420
  if Left.FData = nil then
8421
  begin
8422
    ShallowCopy(Right, Result);
8423
    if Result.FSize <> 0 then
8424
      Result.FSize := Result.FSize xor SignMask;
8425
    Exit;
8426
  end;
8427
  if Right.FData = nil then
8428
  begin
8429
    ShallowCopy(Left, Result);
8430
    Exit;
8431
  end;
8432

8433
  Comparison := InternalCompare(PLimb(Left.FData), PLimb(Right.FData), (Left.FSize and SizeMask), (Right.FSize and SizeMask));
8434
  if (Comparison = 0) and (Left.Sign = Right.Sign) then
8435
  begin
8436
    ShallowCopy(Zero, Result);
8437
    Exit;
8438
  end;
8439

8440
  if Comparison > 0 then
8441
  begin
8442
    Largest := @Left;
8443
    Smallest := @Right;
8444
  end
8445
  else
8446
  begin
8447
    Largest := @Right;
8448
    Smallest := @Left;
8449
  end;
8450

8451
  Res.MakeSize((Largest^.FSize and SizeMask) + 1);
8452
  if Largest^.Sign = Smallest^.Sign then
8453
    FInternalSubtract(PLimb(Largest^.FData), PLimb(Smallest^.FData), PLimb(Res.FData), (Largest^.FSize and SizeMask), (Smallest^.FSize and SizeMask))
8454
  else
8455
    FInternalAdd(PLimb(Largest^.FData), PLimb(Smallest^.FData), PLimb(Res.FData), (Largest^.FSize and SizeMask), (Smallest^.FSize and SizeMask));
8456
  Res.FSize := (Res.FSize and SizeMask) or BoolMasks[(Largest^.FSize < 0) xor (Largest = @Left)];
8457
  Res.Compact;
8458
  Result := Res;
8459
end;
8460

8461
class operator BigInteger.Subtract(const Left, Right: BigInteger): BigInteger;
8462
begin
8463
  Result := Subtract(Left, Right);
8464
end;
8465

8466
procedure BigInteger.EnsureSize(RequiredSize: Integer);
8467
begin
8468
  RequiredSize := RequiredSize and SizeMask;
8469
  if RequiredSize > Length(FData) then
8470
    SetLength(FData, (RequiredSize + 4) and CapacityMask);
8471
  FSize := (FSize and SignMask) or RequiredSize;
8472
end;
8473

8474
procedure BigInteger.MakeSize(RequiredSize: Integer);
8475
begin
8476
  SetLength(FData, (RequiredSize + 4) and CapacityMask);
8477
  FillChar(FData[0], Length(FData) * CLimbSize, 0);
8478
  FSize := (FSize and SignMask) or RequiredSize;
8479
end;
8480

8481
// In Win32, we keep what we have. In Win64, we switch, depending on Size. At 25 limbs or above, the unrolled loop version is faster.
8482
class procedure BigInteger.InternalNegate(Source, Dest: PLimb; Size: Integer);
8483
{$IFDEF PUREPASCAL}
8484
var
8485
  R: TLimb;
8486
begin
8487
  R := 0;
8488
  while R = 0 do
8489
  begin
8490
    R := (not Source^) + 1;
8491
    Dest^ := R;
8492
    Inc(Source);
8493
    Inc(Dest);
8494
    Dec(Size);
8495
    if Size = 0 then
8496
      Exit;
8497
  end;
8498
  while Size > 0 do
8499
  begin
8500
    Dest^ := not Source^;
8501
    Inc(Source);
8502
    Inc(Dest);
8503
    Dec(Size);
8504
  end;
8505
end;
8506
{$ELSE}
8507
{$IFDEF WIN32}
8508

8509
// This is faster than an unrolled loop with NOT and ADC, especially for smaller BigIntegers.
8510

8511
asm
8512
        PUSH    ESI
8513

8514
@Loop:
8515

8516
        MOV     ESI,[EAX]
8517
        NOT     ESI
8518
        INC     ESI
8519
        MOV     [EDX],ESI
8520
        LEA     EAX,[EAX + CLimbSize]
8521
        LEA     EDX,[EDX + CLimbSize]
8522
        DEC     ECX
8523
        JE      @Exit
8524
        TEST    ESI,ESI                 // Only if ESI is 0, a carry occurred.
8525
        JE      @Loop
8526

8527
@RestLoop:                              // No more carry. We can stop incrementing.
8528

8529
        MOV     ESI,[EAX]
8530
        NOT     ESI
8531
        MOV     [EDX],ESI
8532
        LEA     EAX,[EAX + CLimbSize]
8533
        LEA     EDX,[EDX + CLimbSize]
8534
        DEC     ECX
8535
        JNE     @RestLoop
8536

8537
@Exit:
8538

8539
        POP     ESI
8540
end;
8541
{$ELSE WIN64}
8542
asm
8543

8544
        CMP     R8D,25
8545
        JA      @Unrolled
8546

8547
// Plain version. Faster for small BigIntegers (<= 25 limbs).
8548

8549
@Loop:
8550

8551
        MOV     EAX,[RCX]
8552
        NOT     EAX
8553
        INC     EAX
8554
        MOV     [RDX],EAX
8555
        LEA     RCX,[RCX + CLimbSize]
8556
        LEA     RDX,[RDX + CLimbSize]
8557
        DEC     R8D
8558
        JE      @Exit
8559
        TEST    EAX,EAX
8560
        JE      @Loop
8561

8562
@RestLoop:
8563

8564
        MOV     EAX,[RCX]
8565
        NOT     EAX
8566
        MOV     [RDX],EAX
8567
        LEA     RCX,[RCX + CLimbSize]
8568
        LEA     RDX,[RDX + CLimbSize]
8569
        DEC     R8D
8570
        JNE     @RestLoop
8571
        JMP     @Exit
8572

8573
// Unrolled version. Faster for larger BigIntegers.
8574

8575
@Unrolled:
8576

8577
        TEST    RCX,RCX
8578
        JE      @Exit
8579
        XCHG    R8,RCX
8580
        MOV     R9,RDX
8581
        XOR     EDX,EDX
8582
        MOV     R10D,ECX
8583
        AND     R10D,CUnrollMask
8584
        SHR     ECX,CUnrollShift
8585
        STC
8586
        JE      @Rest
8587

8588
@LoopU:
8589

8590
        MOV     RAX,[R8]
8591
        NOT     RAX
8592
        ADC     RAX,RDX
8593
        MOV     [R9],RAX
8594

8595
        MOV     RAX,[R8 + DLimbSize]
8596
        NOT     RAX
8597
        ADC     RAX,RDX
8598
        MOV     [R9 + DLimbSize],RAX
8599

8600
        LEA     R8,[R8 + 2*DLimbSize]
8601
        LEA     R9,[R9 + 2*DLimbSize]
8602
        LEA     ECX,[ECX - 1]
8603
        JECXZ   @Rest
8604
        JMP     @LoopU
8605

8606
@Rest:
8607

8608
        LEA     RAX,[@JumpTable]
8609
        JMP     [RAX + R10*TYPE Pointer]
8610

8611
        // Align jump table with NOPs
8612

8613
        NOP
8614

8615
@JumpTable:
8616

8617
        DQ      @Exit
8618
        DQ      @Rest1
8619
        DQ      @Rest2
8620
        DQ      @Rest3
8621

8622
@Rest3:
8623

8624
        MOV     RAX,[R8]
8625
        NOT     RAX
8626
        ADC     RAX,RDX
8627
        MOV     [R9],RAX
8628

8629
        MOV     EAX,[R8 + DLimbSize]
8630
        NOT     EAX
8631
        ADC     EAX,EDX
8632
        MOV     [R9 + DLimbSize],EAX
8633

8634
        JMP     @Exit
8635

8636
@Rest2:
8637

8638
        MOV     RAX,[R8]
8639
        NOT     RAX
8640
        ADC     RAX,RDX
8641
        MOV     [R9],RAX
8642

8643
        JMP     @Exit
8644

8645
@Rest1:
8646

8647
        MOV     EAX,[R8]
8648
        NOT     EAX
8649
        ADC     EAX,EDX
8650
        MOV     [R9],EAX
8651

8652
@Exit:
8653
end;
8654
{$ENDIF WIN64}
8655
{$ENDIF !PUREPASCAL}
8656

8657
// Needed for Karatsuba, ToomCook and Burnikel-Ziegler
8658
// Assumes non-negative parameters and non-negative self.
8659
procedure BigInteger.AddWithOffset(const Addend: BigInteger; Offset: Integer);
8660
begin
8661
  Self.EnsureSize(IntMax(Offset + (Addend.FSize and SizeMask), Self.FSize and SizeMask));
8662
  if Offset >= (Self.FSize and SizeMask) then
8663
    CopyLimbs(PLimb(Addend.FData), PLimb(Self.FData) + Offset, Addend.FSize and SizeMask)
8664
  else
8665
    FInternalAdd(PLimb(Self.FData) + Offset, PLimb(Addend.FData), PLimb(Self.FData) + Offset, (Self.FSize and SizeMask) - Offset, Addend.FSize and SizeMask);
8666
  Self.Compact;
8667
end;
8668

8669
class procedure BigInteger.InternalBitwise(const Left, Right: BigInteger; var Result: BigInteger; PlainOp, OppositeOp, InversionOp: TDyadicOperator);
8670

8671
//---------------------------------------------------------------------------------------------------------------//
8672
//                                                                                                               //
8673
//  The code for the bitwise operators AND, OR and XOR does not differ much.                                     //
8674
//  Since the results should be the results for two's complement, two's complement semantics are emulated.       //
8675
//  Originally, this meant that the magnitudes of negative bigintegers were negated, then the                    //
8676
//  operation was performed and if the result had to be negative, the magnitude of the result was negated.       //
8677
//  These negation steps were slow, so now this code uses some logical shortcuts.                                //
8678
//                                                                                                               //
8679
//  The rules used are like follows.                                                                             //
8680
//                                                                                                               //
8681
//  In the following, A and B represent positive integer values, so -A and -B represent negative values.         //
8682
//  Note that, to keep this simple, 0 -- i.e. FData = nil -- is not handled at all. That is handled              //
8683
//  by the caller and then this routine is not called.                                                           //
8684
//                                                                                                               //
8685
//  Relation between negation and inversion of an integer/magnitude:                                             //
8686
//  -A = not A + 1    => not A = -A - 1                                                                          //
8687
//  -A = not (A - 1)                                                                                             //
8688
//                                                                                                               //
8689
//  Note: A and B are magnitudes here. Negating a BigInteger is as simple as flipping the sign bit. That         //
8690
//  does not work for magnitudes.                                                                                //
8691
//                                                                                                               //
8692
//  Boolean (and bitwise) rules followed:                                                                        //
8693
//  not not A       = A                                                                                          //
8694
//  not (A and B)   = not A or not B                                                                             //
8695
//  not (A or B)    = not A and not B                                                                            //
8696
//  not (A xor B)   = not A xor B = A xor not B                                                                  //
8697
//  not A xor not B = A xor B                                                                                    //
8698
//                                                                                                               //
8699
//  Expressions used here:                                                                                       //
8700
//                                                                                                               //
8701
//  A and B      = A and B                               ; both positive, plain operation                        //
8702
//  A and -B     = A and not (B - 1)                     ; one positive, one negative, result positive           //
8703
//  -(-A and -B) = -(not (A - 1) and not (B - 1))        ; both negative, result is negative too                 //
8704
//               = - not ((A - 1) or (B - 1)))                                                                   //
8705
//               = (A - 1) or (B - 1) + 1                                                                        //
8706
//                                                                                                               //
8707
//  A or B       = A or B                                ; both positive                                         //
8708
//  -(A or -B)   = -(A or not (B - 1))                   ; one positive, one negative, result is negative too    //
8709
//               = - not (not A and (B - 1))                                                                     //
8710
//               = ((B - 1) and not A) + 1                                                                       //
8711
//  -(-A or -B)  = -(not (A - 1) or not (B - 1))         ; both negative, result is negative too                 //
8712
//               = not (not (A - 1) or not (B - 1) + 1                                                           //
8713
//               = (A - 1) and (B - 1) + 1                                                                       //
8714
//                                                                                                               //
8715
//  A xor B      = A xor B                               ; both positive                                         //
8716
//  -(A xor -B)  = -(A xor not (B - 1))                  ; one positive, one negative, result is negative too    //
8717
//               = not (A xor not (B - 1)) + 1                                                                   //
8718
//               = A xor (B - 1) + 1                                                                             //
8719
//  -A xor -B    = not (A - 1) xor not (B - 1)           ; both negative, result is positive                     //
8720
//               = (A - 1) xor (B - 1)                                                                           //
8721
//                                                                                                               //
8722
//  So the only "primitives" required are routines for AND, OR, XOR and AND NOT. The latter is not really        //
8723
//  a primitive, but it is so easy to implement, that it can be considered one. NOT is cheap, does not require   //
8724
//  complicated carry handling.                                                                                  //
8725
//  Routines like Inc and Dec are cheap too: you only loop as long as there is a carry (or borrow). Often, that  //
8726
//  is only over very few limbs.                                                                                 //
8727
//                                                                                                               //
8728
//  Primitives (InternalAnd(), etc.) routines were optimized too. Loops were unrolled, 64 bit registers used     //
8729
//  where possible, both sizes are passed, so the operations can be done on the original data. The latter        //
8730
//  reduces the need for copying into internal buffers.                                                          //
8731
//                                                                                                               //
8732
//  These optimizations made bitwise operators 2-3 times as fast as with the simple implementations before.      //
8733
//                                                                                                               //
8734
//---------------------------------------------------------------------------------------------------------------//
8735

8736
var
8737
  LSize, RSize, MinSize, MaxSize: Integer;
8738
  LPtr, RPtr: PLimb;
8739
begin
8740
  LSize := Left.FSize and SizeMask;
8741
  RSize := Right.FSize and SizeMask;
8742
  MinSize := IntMin(LSize, RSize);
8743
  MaxSize := IntMax(LSize, RSize);
8744

8745
  if ((Left.FSize xor Right.FSize) and SignMask) = 0 then
8746
  begin
8747
    if (Left.FSize > 0) then
8748
    begin
8749
      if @PlainOp = @InternalAnd then
8750
        Result.MakeSize(MinSize)
8751
      else
8752
        Result.MakeSize(MaxSize);
8753
      PlainOp(PLimb(Left.FData), PLimb(Right.FData), PLimb(Result.FData), LSize, RSize);
8754
    end
8755
    else
8756
    begin
8757
      LPtr := AllocLimbs(LSize + RSize);                        // LPtr := Copy(Left);
8758
      RPtr := LPtr + LSize;                                     // RPtr := Coyp(Right);
8759
      CopyLimbs(PLimb(Left.FData), LPtr, LSize);
8760
      CopyLimbs(PLimb(Right.FData), RPtr, RSize);
8761
      InternalDecrement(LPtr, LSize);                           // LPtr^ := LPtr^ - 1
8762
      InternalDecrement(RPtr, RSize);                           // RPtr^ := RPtr^ - 1
8763
      Result.FSize := 0;
8764
      Result.MakeSize(MaxSize);
8765
      OppositeOp(LPtr, RPtr, PLimb(Result.FData), LSize, RSize);        // Opposite op: AND --> OR, OR --> AND, XOR --> XOR
8766
      if @PlainOp = @InternalXor then
8767
        Result.FSize := Result.FSize and SizeMask               // Make positive.
8768
      else
8769
      begin
8770
        InternalIncrement(PLimb(Result.FData), MaxSize);                // Result := Result + 1
8771
        Result.FSize := Result.FSize or SignMask;               // Make negative.
8772
      end;
8773
      FreeMem(LPtr);
8774
    end;
8775
  end
8776
  else
8777
  begin
8778
    if (Left.FSize > 0) then
8779
    begin
8780
      RPtr := AllocLimbs(RSize);
8781
      CopyLimbs(PLimb(Right.FData), RPtr, RSize);
8782
      InternalDecrement(RPtr, RSize);
8783
      Result.FSize := 0;
8784
      if @PlainOp = @InternalOr then
8785
        Result.MakeSize(RSize)
8786
      else
8787
        Result.MakeSize(MaxSize);
8788
      InversionOp(PLimb(Left.FData), RPtr, PLimb(Result.FData), LSize, RSize);  // Inversion op: AND --> AND NOT, OR --> NOT AND, XOR --> XOR
8789
      if @PlainOp = @InternalAnd then
8790
        Result.FSize := Result.FSize and SizeMask               // Make positive.
8791
      else
8792
      begin
8793
         InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
8794
         Result.FSize := Result.FSize or SignMask;              // Make negative.
8795
      end;
8796
      FreeMem(RPtr);
8797
    end
8798
    else
8799
    begin
8800
      LPtr := AllocLimbs(LSize);
8801
      CopyLimbs(PLimb(Left.FData), LPtr, LSize);
8802
      InternalDecrement(LPtr, LSize);
8803
      Result.FSize := 0;
8804
      if @PlainOp = @InternalOr then
8805
        Result.MakeSize(LSize)
8806
      else
8807
        Result.MakeSize(MaxSize);
8808
      InversionOp(PLimb(Right.FData), LPtr, PLimb(Result.FData), RSize, LSize);
8809
      if @PlainOp = @InternalAnd then
8810
        Result.FSize := Result.FSize and SizeMask
8811
      else
8812
      begin
8813
         InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
8814
         Result.FSize := Result.FSize or SignMask;
8815
      end;
8816
      FreeMem(LPtr);
8817
    end;
8818
  end;
8819
  Result.Compact;
8820
end;
8821

8822
class operator BigInteger.Negative(const Int: BigInteger): BigInteger;
8823
begin
8824
  // Magnitude is not modified, so a shallow copy is enough!
8825
  ShallowCopy(Int, Result);
8826
  if Result.FSize <> 0 then
8827
    Result.FSize := Result.FSize xor SignMask;
8828
end;
8829

8830
class function BigInteger.Parse(const S: string; aBase : Integer): BigInteger;
8831
var
8832
  TryResult: BigInteger;
8833
begin
8834
  if TryParse(S, TryResult, aBase) then
8835
    Result := TryResult
8836
  else
8837
    Error(ecParse, S);
8838
end;
8839

8840
class function BigInteger.Pow(const ABase: BigInteger; AExponent: Integer): BigInteger;
8841
var
8842
  Base: BigInteger;
8843
begin
8844
  Base := ABase;
8845
  Result := One;
8846
  while AExponent > 0 do
8847
  begin
8848
    if Odd(AExponent) then
8849
      Result := Result * Base;
8850
    Base := Sqr(Base);
8851
    AExponent := AExponent shr 1;
8852
  end;
8853
end;
8854

8855
class operator BigInteger.NotEqual(const Left, Right: BigInteger): Boolean;
8856
begin
8857
  Result := Compare(Left, Right) <> 0;
8858
end;
8859

8860
class procedure BigInteger.Octal;
8861
begin
8862
  FBase := 8;
8863
end;
8864

8865
class function BigInteger.Remainder(const Left: BigInteger; Right: UInt16): BigInteger;
8866
var
8867
  LQuotient: TMagnitude;
8868
begin
8869
  if Right = 0 then
8870
    Error(ecDivByZero);
8871
  Result.MakeSize(1);
8872
  SetLength(LQuotient, (Left.FSize and SizeMask));
8873
  if not InternalDivMod32(PLimb(Left.FData), Right, PLimb(LQuotient), PLimb(Result.FData), (Left.FSize and SizeMask)) then
8874
    Error(ecInvalidArg);
8875
  Result.Compact;
8876
  if Result.FSize <> 0 then
8877
    Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
8878
end;
8879

8880
class function BigInteger.Remainder(const Left: BigInteger; Right: UInt32): BigInteger;
8881
var
8882
  LQuotient: TMagnitude;
8883
begin
8884
  if Right = 0 then
8885
    Error(ecDivByZero);
8886
  Result.MakeSize(1);
8887
  SetLength(LQuotient, (Left.FSize and SizeMask));
8888
  if not InternalDivMod32(PLimb(Left.FData), Right, PLimb(LQuotient), PLimb(Result.FData), (Left.FSize and SizeMask)) then
8889
    Error(ecInvalidArg);
8890
  Result.Compact;
8891
  if Result.FSize <> 0 then
8892
    Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
8893
end;
8894

8895
class function BigInteger.Remainder(const Left, Right: BigInteger): BigInteger;
8896
var
8897
  Quotient: BigInteger;
8898
  LSize, RSize: Integer;
8899
begin
8900
  if Right.FData = nil then
8901
    Error(ecDivByZero);
8902

8903
  LSize := Left.FSize and SizeMask;
8904
  RSize := Right.FSize and SizeMask;
8905

8906
  case InternalCompare(PLimb(Left.FData), PLimb(Right.FData), LSize, RSize) of
8907
    -1:
8908
      begin
8909
        ShallowCopy(Left, Result);
8910
        Exit;
8911
      end;
8912
    0:
8913
      begin
8914
        ShallowCopy(Zero, Result);
8915
        Exit;
8916
      end;
8917
    else
8918
      begin
8919
        if ShouldUseBurnikelZiegler(LSize, RSize) then
8920
          DivModBurnikelZiegler(Left, Right, Quotient, Result)
8921
        else
8922
          DivModKnuth(Left, Right, Quotient, Result);
8923

8924
        // In Delphi, sign of remainder is sign of dividend.
8925
        if Result.FSize <> 0 then
8926
          Result.FSize := (Result.FSize and SizeMask) or SignBitOf(Left.FSize);
8927
      end;
8928
  end;
8929
end;
8930

8931
function BigInteger.Remainder(const Other: BigInteger): PBigInteger;
8932
begin
8933
  Result := @Self;
8934
  Self := Self mod Other;
8935
end;
8936

8937
class operator BigInteger.RightShift(const Value: BigInteger; Shift: Integer): BigInteger;
8938
// Note: this emulates two's complement, more or less like the bitwise operators.
8939
var
8940
  LSize: Integer;
8941
  ShiftOffset: Integer;
8942
  RSize: Integer;
8943
  P: PLimb;
8944
begin
8945
  if Value.FData = nil then
8946
  begin
8947
    ShallowCopy(Zero, Result);
8948
    Exit;
8949
  end;
8950

8951
  if Value.FSize > 0 then
8952
  begin
8953
    LSize := (Value.FSize and SizeMask);
8954
    ShiftOffset := Shift shr 5;
8955
    RSize := LSize - ShiftOffset;
8956
    if RSize <= 0 then
8957
    begin
8958
      ShallowCopy(Zero, Result);
8959
      Exit;
8960
    end;
8961
    Shift := Shift and $1F;
8962
    Result.MakeSize(RSize);
8963
    if Shift > 0 then
8964
      InternalShiftRight(PLimb(Value.FData) + ShiftOffset, PLimb(Result.FData), Shift, RSize)
8965
    else
8966
      CopyLimbs(PLimb(Value.FData) + ShiftOffset, PLimb(Result.FData), RSize);
8967
    Result.Compact;
8968
  end
8969
  else
8970
  begin
8971

8972
    ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8973
    //  This branch had to be written out completely. Using any local BigInteger, even a hidden BigInteger (to do     //
8974
    //  something like "Inc(Result);" a hidden BigInteger is allocated) will slow this down enormously.               //
8975
    //  The mere presence of a BigInteger causes InitializeArray and FinalizeArray to be compiled in,                 //
8976
    //  and a hidden try-finally to be placed around the routine.                                                     //
8977
    //  Removing all local BigIntegers sped up this branch by a factor of 3 and the entire routine by a factor of 2.  //
8978
    //                                                                                                                //
8979
    //  Original code:                                                                                                //
8980
    //  Result := MinusOne - ((MinusOne - Value) shr Shift);                                                          //
8981
    //                                                                                                                //
8982
    //  See: http://blogs.teamb.com/rudyvelthuis/2015/10/04/27826                                                     //
8983
    ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8984

8985
    LSize := (Value.FSize and SizeMask);
8986
    P := AllocLimbs(LSize);
8987
    // try
8988
    CopyLimbs(PLimb(Value.FData), P, LSize);
8989
    InternalDecrement(P, LSize);
8990
    while (LSize > 0) and (P[LSize - 1] = 0) do
8991
      Dec(LSize);
8992
    if LSize = 0 then
8993
    begin
8994
      ShallowCopy(MinusOne, Result);
8995
      Exit;
8996
    end;
8997
    ShiftOffset := Shift shr 5;
8998
    if ShiftOffset >= LSize then
8999
    begin
9000
      ShallowCopy(MinusOne, Result);
9001
      Exit;
9002
    end;
9003
    Shift := Shift and $1F;
9004
    Result.FSize := 0;
9005
    Result.MakeSize(LSize - ShiftOffset);
9006
    if Shift = 0 then
9007
      CopyLimbs(P + ShiftOffset, PLimb(Result.FData), LSize - ShiftOffset)
9008
    else
9009
      BigInteger.InternalShiftRight(P + ShiftOffset, PLimb(Result.FData), Shift, LSize - ShiftOffset);
9010
    // finally
9011
    FreeMem(P);
9012
    // end;
9013

9014
    Result.Compact;
9015
    if Result.FData = nil then
9016
    begin
9017
      ShallowCopy(MinusOne, Result);
9018
      Exit;
9019
    end;
9020
    InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
9021
    Result.FSize := (Result.FSize and SizeMask) or SignMask;
9022
  end;
9023
end;
9024

9025
class operator BigInteger.Implicit(const Value: string): BigInteger;
9026
begin
9027
  if not TryParse(Value, Result, FBase) then
9028
    Error(ecParse, Value);
9029
end;
9030

9031
class operator BigInteger.Explicit(const Int: BigInteger): Double;
9032
begin
9033
  Result := Int.AsDouble;
9034
end;
9035

9036
class operator BigInteger.Explicit(const ADouble: Double): BigInteger;
9037
begin
9038
  Result.Create(ADouble);
9039
end;
9040

9041
class operator BigInteger.Inc(const Int: BigInteger): BigInteger;
9042
begin
9043
  if Int.FData = nil then
9044
  begin
9045
    ShallowCopy(One, Result);
9046
    Exit;
9047
  end;
9048
  Result.FData := Copy(Int.FData);
9049
  Result.FSize := Int.FSize;
9050
  if Result.FSize > 0 then
9051
  begin
9052
    Result.EnsureSize((Result.FSize and SizeMask) + 1);
9053
    InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
9054
  end
9055
  else
9056
    InternalDecrement(PLimb(Result.FData), (Result.FSize and SizeMask));
9057
  Result.Compact;
9058
end;
9059

9060
class operator BigInteger.Dec(const Int: BigInteger): BigInteger;
9061
begin
9062
  if Int.FData = nil then
9063
  begin
9064
    ShallowCopy(MinusOne, Result);
9065
    Exit;
9066
  end;
9067
  Result.FData := Copy(Int.FData);
9068
  Result.FSize := Int.FSize;
9069
  if Result.FSize < 0 then
9070
  begin
9071
    Result.EnsureSize((Result.FSize and SizeMask) + 1);
9072
    InternalIncrement(PLimb(Result.FData), (Result.FSize and SizeMask));
9073
  end
9074
  else
9075
    InternalDecrement(PLimb(Result.FData), (Result.FSize and SizeMask));
9076
  Result.Compact;
9077
end;
9078

9079
procedure BigInteger.FromString(const Value: string; aBase : Integer);
9080
begin
9081
  if not TryParse(Value, Self, aBase) then
9082
  begin
9083
    Self.FData := nil;
9084
    Self.FSize := 0;
9085
  end;
9086
end;
9087

9088
function BigInteger.Add(const Other: BigInteger): PBigInteger;
9089
var
9090
  SelfSize, OtherSize: Integer;
9091
  Comparison: TValueSign;
9092
begin
9093
  Result := @Self;
9094
  if Other.IsZero then
9095
    Exit;
9096
  if Self.IsZero then
9097
  begin
9098
    Self := Other;
9099
    Exit;
9100
  end;
9101
  FData := Copy(FData);
9102
  SelfSize := FSize and SizeMask;
9103
  OtherSize := Other.FSize and SizeMask;
9104
  if Self.IsNegative = Other.IsNegative then
9105
  begin
9106
    EnsureSize(IntMax(SelfSize, OtherSize) + 1);
9107
    FInternalAdd(PLimb(Self.FData), PLimb(Other.FData), PLimb(Self.FData), SelfSize, OtherSize);
9108
  end
9109
  else
9110
  begin
9111
    // Different signs, so subtract.
9112
    EnsureSize(IntMax(SelfSize, OtherSize));
9113
    Comparison := InternalCompare(PLimb(Self.FData), PLimb(Other.FData), (Self.FSize and SizeMask), (Other.FSize and SizeMask));
9114
    if Comparison = 0 then
9115
    begin
9116
      Self := Zero;
9117
      Exit;
9118
    end;
9119

9120
    if Comparison > 0 then
9121
    begin
9122
      FInternalSubtract(PLimb(Self.FData), PLimb(Other.FData), PLimb(Self.FData), SelfSize, OtherSize);
9123
    end
9124
    else
9125
    begin
9126
      FInternalSubtract(PLimb(Other.FData), PLimb(Self.FData), PLimb(Self.FData), OtherSize, SelfSize);
9127
      Self.FSize := Self.FSize xor SignMask;
9128
    end;
9129
  end;
9130
  Compact;
9131
end;
9132

9133
class procedure BigInteger.AvoidPartialFlagsStall(Value: Boolean);
9134
{$IFDEF PUREPASCAL}
9135
begin
9136
  FInternalAdd := InternalAddPurePascal;
9137
  FInternalSubtract := InternalSubtractPurePascal;
9138
end;
9139
{$ELSE}
9140
begin
9141
  FAvoidStall := Value;
9142
  if Value then
9143
  begin
9144
    FInternalAdd := InternalAddModified;
9145
    FInternalSubtract := InternalSubtractModified;
9146
  end
9147
  else
9148
  begin
9149
    FInternalAdd := InternalAddPlain;
9150
    FInternalSubtract := InternalSubtractPlain;
9151
  end;
9152
end;
9153
{$ENDIF}
9154

9155
function BigInteger.Multiply(const Other: BigInteger): PBigInteger;
9156
begin
9157
  Result := @Self;
9158
  Self := Self * Other;
9159
end;
9160

9161
procedure FlipBigIntegerBit(var B: BigInteger; Index: Integer); inline;
9162
begin
9163
  B.FData := Copy(B.FData);
9164
  B.EnsureSize(IntMax(Index shr 5 + 1, B.FSize and BigInteger.SizeMask));
9165
  B.FData[Index shr 5] := B.FData[Index shr 5] xor (1 shl (Index and $1F));
9166
  B.Compact;
9167
end;
9168

9169
function BigInteger.TestBit(Index: Integer): Boolean;
9170

9171
///////////////////////////////////////////////////////////////////////
9172
//  Two's complement semantics are required.                         //
9173
//                                                                   //
9174
//  Note: -A = not (A - 1) = not A + 1                               //
9175
//                                                                   //
9176
//  Example, assuming 16 bit limbs, negating goes like follows:      //
9177
//                                                                   //
9178
//    -$1234 5678 9ABC 0000 0000 -> $EDCB A987 6544 0000 0000        //
9179
//  0:                      0000 ->                      FFFF + 1    //
9180
//  1:                 0000      ->                 FFFF + 1         //
9181
//  2:            9ABC           ->            6543 + 1              //
9182
//  3:       5678                ->       A987                       //
9183
//  4:  1234                     ->  EDCB                            //
9184
//                                                                   //
9185
//  So accessing limb 4 or 3:    Data := not Data                    //
9186
//     accessing limb 2, 1 or 0: Data := not Data + 1                //
9187
///////////////////////////////////////////////////////////////////////
9188

9189
var
9190
  I: Integer;
9191
  Mask: TLimb;
9192
  Data: TLimb;
9193
begin
9194
  if FData = nil then
9195

9196
    // Zero, so no bit set. Return False.
9197
    Result := False
9198
  else if Index >= BitLength then
9199

9200
    // Beyond bit length, so return sign
9201
    Result := (FSize and SignMask) <> 0
9202
  else
9203
  begin
9204
    Mask := 1 shl (Index and $1F);
9205
    Index := Index shr 5;
9206
    Data := FData[Index];
9207

9208
    // Emulate negation if this BigInteger is negative.
9209
    // Not necessary if BigInteger is positive.
9210
    if (FSize and SignMask) <> 0 then
9211
    begin
9212

9213
      // -A = not A + 1.
9214
      Data := not Data; // Wait with the + 1, see below.
9215
      I := 0;
9216

9217
      // See if carry propagates from lowest limb to limb containing the bit. If so, increment Data.
9218
      while (I <= Index) and (FData[I] = 0) do
9219
        Inc(I);
9220
      if Index <= I then
9221
        Inc(Data);
9222
    end;
9223

9224
    // Get the bit.
9225
    Result := (Data and Mask) <> 0;
9226
  end;
9227
end;
9228

9229
function BigInteger.SetBit(Index: Integer): BigInteger;
9230
begin
9231
  Result := Self;
9232
  if not TestBit(Index) then
9233
    FlipBigIntegerBit(Result, Index);
9234
end;
9235

9236
function BigInteger.ClearBit(Index: Integer): BigInteger;
9237
begin
9238
  Result := Self;
9239
  if TestBit(Index) then
9240
    FlipBigIntegerBit(Result, Index);
9241
end;
9242

9243
function BigInteger.FlipBit(Index: Integer): BigInteger;
9244
begin
9245
  Result := Self;
9246
  FlipBigIntegerBit(Result, Index);
9247
end;
9248

9249
class function BigInteger.NthRoot(const Radicand: BigInteger; Nth: Integer): BigInteger;
9250

9251
// http://stackoverflow.com/a/32541958/95954
9252

9253
var
9254
  Estimate, EstimateToNthPower, NewEstimateToNthPower, TwoToNthPower: BigInteger;
9255
  AdditionalBit: Integer;
9256
begin
9257
  if Radicand = BigInteger.One then
9258
    Exit(BigInteger.One);
9259
  if Nth = 0 then
9260
    Exit(BigInteger.Zero);                      // Error: there is no zeroth root.
9261
  if Nth = 1 then
9262
    Exit(Radicand);
9263

9264
  TwoToNthPower := BigInteger.Pow(2, Nth);
9265

9266
  // First estimate. Very likely closer to final value than the original BigInteger.One.
9267
  Estimate := BigInteger.One shl (Radicand.BitLength div Nth);
9268
  // EstimateToNthPower is Estimate ^ Nth
9269
  EstimateToNthPower := BigInteger.Pow(Estimate, Nth);
9270

9271
  // Shift Estimate right until Estimate ^ Nth >= Value.
9272
  while EstimateToNthPower < Radicand do
9273
  begin
9274
    Estimate := Estimate shl 1;
9275
    EstimateToNthPower := TwoToNthPower * EstimateToNthPower;
9276
  end;
9277

9278
  // EstimateToNthPower is the lowest power of two such that EstimateToNthPower >= Value
9279
  if EstimateToNthPower = Radicand then            // Answer is a power of two.
9280
    Exit(Estimate);
9281

9282
   // Estimate is highest power of two such that Estimate ^ Nth < Value
9283
  Estimate := Estimate shr 1;
9284
  AdditionalBit := Estimate.BitLength - 2;
9285
  if AdditionalBit < 0 then
9286
    Exit(Estimate);
9287
  EstimateToNthPower := BigInteger.Pow(Estimate, Nth);
9288

9289
  // We already have the top bit. Now repeatedly add decreasingly significant bits and check if
9290
  // that addition is not too much. If so, remove the bit again.
9291
  while Radicand > EstimateToNthPower do
9292
  begin
9293
    Estimate := Estimate.SetBit(AdditionalBit);
9294
    NewEstimateToNthPower := BigInteger.Pow(Estimate, Nth);
9295
    if NewEstimateToNthPower > Radicand then                        // Did we add too much? If so, remove bit.
9296
      Estimate := Estimate.ClearBit(AdditionalBit)
9297
    else
9298
      EstimateToNthPower := NewEstimateToNthPower;               // Otherwise update EstimateToNthPower (= Estimate^Nth).
9299
    Dec(AdditionalBit);
9300
    if AdditionalBit < 0 then
9301
      Break;
9302
  end;
9303

9304
  // All bits covered, so we have our result.
9305
  Result := Estimate;
9306
end;
9307

9308
class procedure BigInteger.NthRootRemainder(const Radicand: BigInteger; Nth: Integer; var Root, Remainder: BigInteger);
9309
begin
9310
  Root := NthRoot(Radicand, Nth);
9311
  Remainder := Radicand - Pow(Root, Nth);
9312
end;
9313

9314
class function BigInteger.Sqr(const Value: BigInteger): BigInteger;
9315
begin
9316
  if (Value.FSize and SizeMask) < KaratsubaSqrThreshold then
9317
    Result := Value * Value
9318
  else
9319
    Result := SqrKaratsuba(Value);
9320
end;
9321

9322
class function BigInteger.Sqrt(const Radicand: BigInteger): BigInteger;
9323
var
9324
  Estimate: BigInteger;
9325
  AdditionalBit: Integer;
9326
  EstimateSquared: BigInteger;
9327
  Temp: BigInteger;
9328
begin
9329
  if Radicand = BigInteger.One then
9330
    Exit(BigInteger.One);
9331

9332
  if Radicand.IsNegative then
9333
    raise EInvalidOp.Create(SSqrtBigInteger);
9334

9335
  Estimate := BigInteger.One shl ((Radicand.BitLength) shr 1);
9336

9337
  EstimateSquared := Sqr(Estimate);
9338
  while EstimateSquared < Radicand do
9339
  begin
9340
    Estimate := Estimate shl 1;
9341
    EstimateSquared := EstimateSquared shl 2;
9342
  end;
9343

9344
  if EstimateSquared = Radicand then
9345
    Exit(Estimate);
9346

9347
  Estimate := Estimate shr 1;
9348
  EstimateSquared := EstimateSquared shr 2;
9349
  AdditionalBit := Estimate.BitLength - 2;
9350
  if AdditionalBit < 0 then
9351
    Exit(Estimate);
9352

9353
  while Radicand > EstimateSquared do
9354
  begin
9355

9356
    //////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9357
    // Instead of multiplying two large BigIntegers, i.e. (Estimate + 2 ^ AdditionalBit) ^ 2, we try to be clever:  //
9358
    // If A = Estimate; B = 2 ^ AdditionalBit then:                                                                 //
9359
    // sqr(A + B) = A*A + 2*A*B + B*B = sqrA + (A * 2 + B)*B, so                                                    //
9360
    // Temp := EstimateSquared + (Estimate * 2 + 2 ^ AdditionalBit) * 2 ^ AdditionalBit                             //
9361
    // Since 2 ^ AdditionalBit and the multiplication can be done with shifts, we finally get the following.        //
9362
    //////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9363

9364
    Temp := Estimate shl 1;
9365
    Temp := Temp.SetBit(AdditionalBit);
9366
    Temp := Temp shl AdditionalBit + EstimateSquared;
9367
    if Temp <= Radicand then
9368
    begin
9369
      ShallowCopy(Temp, EstimateSquared);
9370
      Estimate := Estimate.SetBit(AdditionalBit);
9371
    end;
9372
    Dec(AdditionalBit);
9373
    if AdditionalBit < 0 then
9374
      Break;
9375
  end;
9376
  Result := Estimate;
9377
end;
9378

9379
class procedure BigInteger.SqrtRemainder(const Radicand: BigInteger; var Root, Remainder: BigInteger);
9380
begin
9381
  Root := Sqrt(Radicand);
9382
  Remainder := Radicand - Root * Root;
9383
end;
9384

9385
class procedure BigInteger.DivThreeHalvesByTwo(const LeftUpperMid, LeftLower, Right, RightUpper, RightLower: BigInteger;
9386
  N: Integer; var Quotient, Remainder: BigInteger);
9387
var
9388
  Q, R: BigInteger;
9389
begin
9390
  Q := BigInteger.Zero;
9391
  R := BigInteger.Zero;
9392
  if (LeftUpperMid shr N) = RightUpper then
9393
  begin
9394
    Q := (BigInteger.One shl N) - BigInteger.One;
9395
    R := LeftUpperMid - (RightUpper shl N) + RightUpper;
9396
  end
9397
  else
9398
    DivTwoDigitsByOne(LeftUpperMid, RightUpper, N, Q, R);
9399

9400
  Quotient := Q;
9401
  Remainder := ((R shl N) or LeftLower) - Q * RightLower;
9402
  while Remainder < 0 do
9403
  begin
9404
    Dec(Quotient);
9405
    Remainder := Remainder + Right;
9406
  end;
9407
end;
9408

9409
class procedure BigInteger.DivTwoDigitsByOne(const Left, Right: BigInteger; N: Integer; var Quotient, Remainder: BigInteger);
9410
var
9411
  NIsOdd: Boolean;
9412
  LeftCopy, RightCopy: BigInteger;
9413
  HalfN: Integer;
9414
  HalfMask: BigInteger;
9415
  RightUpper, RightLower: BigInteger;
9416
  QuotientUpper, QuotientLower: BigInteger;
9417
  Quot, Rem: BigInteger;
9418
begin
9419
  Quot := BigInteger.Zero;
9420
  Rem := BigInteger.Zero;
9421
  if N <= BigInteger.BurnikelZieglerThreshold * 32 then
9422
  begin
9423
    BigInteger.DivModKnuth(Left, Right, Quot, Rem);
9424
    Quotient := Quot;
9425
    Remainder := Rem;
9426
    Exit;
9427
  end;
9428

9429
  NIsOdd := Odd(N);
9430
  if NIsOdd then
9431
  begin
9432
    LeftCopy := Left shl 1;
9433
    RightCopy := Right shl 1;
9434
    Inc(N);
9435
  end
9436
  else
9437
  begin
9438
    LeftCopy := Left;
9439
    RightCopy := Right;
9440
  end;
9441
  HalfN := N shr 1;
9442
  HalfMask := (BigInteger.One shl HalfN) - BigInteger.One;
9443

9444
  RightUpper := RightCopy shr HalfN;
9445
  RightLower := RightCopy and HalfMask;
9446

9447
  DivThreeHalvesByTwo(LeftCopy shr N, (LeftCopy shr HalfN) and HalfMask, RightCopy, RightUpper, RightLower, HalfN, QuotientUpper, Rem);
9448
  DivThreeHalvesByTwo(Rem, LeftCopy and HalfMask, RightCopy, RightUpper, RightLower, HalfN, QuotientLower, Rem);
9449

9450
  /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9451
  //                                                                                                                 //
9452
  //  Grade school division, but with (very) large digits, dividing [a1,a2,a3,a4] by [b1,b2]:                        //
9453
  //                                                                                                                 //
9454
  //    +----+----+----+----+     +----+----+     +----+                                                             //
9455
  //    | a1 | a2 | a3 | a4 |  /  | b1 | b2 |  =  | q1 |        DivideThreeHalvesByTwo(a1a2, a3, b1b2, n, q1, r1r2)  //
9456
  //    +----+----+----+----+     +----+----+     +----+                                                             //
9457
  //    +--------------+  |                          |                                                               //
9458
  //    |   b1b2 * q1  |  |                          |                                                               //
9459
  //    +--------------+  |                          |                                                               //
9460
  //  - ================  v                          |                                                               //
9461
  //         +----+----+----+     +----+----+        | +----+                                                        //
9462
  //         | r1 | r2 | a4 |  /  | b1 | b2 |  =       | q2 |   DivideThreeHalvesByTwo(r1r2, a4, b1b2, n, q1, r1r2)  //
9463
  //         +----+----+----+     +----+----+        | +----+                                                        //
9464
  //         +--------------+                        |    |                                                          //
9465
  //         |   b1b2 * q2  |                        |    |                                                          //
9466
  //         +--------------+                        |    |                                                          //
9467
  //       - ================                        v    v                                                          //
9468
  //              +----+----+                     +----+----+                                                        //
9469
  //              | r1 | r2 |                     | q1 | q2 |   r1r2 = a1a2a3a4 mod b1b2, q1q2 = a1a2a3a4 div b1b2   //
9470
  //              +----+----+                     +----+----+ ,                                                      //
9471
  //                                                                                                                 //
9472
  //  Note: in the diagram above, a1, b1, q1, r1 etc. are the most significant "digits" of their numbers.            //
9473
  //                                                                                                                 //
9474
  /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9475

9476
  if NIsOdd then
9477
    Rem := Rem shr 1;
9478
  Remainder := Rem;
9479
  Quotient := (QuotientUpper shl HalfN) or QuotientLower;
9480
end;
9481

9482
class procedure BigInteger.InternalDivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
9483
var
9484
  LCopy: BigInteger;
9485
  N: Integer;
9486
  DigitMask: BigInteger;
9487
  LeftDigits: array of BigInteger;
9488
  LeftDigitsIndex : Integer;
9489
  QuotientDigit: BigInteger;
9490
begin
9491
  LCopy := Left;
9492
  N := Right.BitLength;
9493
  DigitMask := (BigInteger.One shl N) - BigInteger.One;
9494
  LeftDigitsIndex := 0;
9495

9496
   while not LCopy.IsZero do begin
9497
      if LeftDigitsIndex=Length(LeftDigits) then
9498
         SetLength(LeftDigits, LeftDigitsIndex+8);
9499
      LeftDigits[LeftDigitsIndex] := LCopy and DigitMask;
9500
      Inc(LeftDigitsIndex);
9501
      LCopy := LCopy shr N;
9502
   end;
9503

9504
   if (LeftDigitsIndex > 0) and (LeftDigits[LeftDigitsIndex-1] >= Right) then
9505
      Remainder := BigInteger.Zero
9506
   else begin
9507
      Remainder := LeftDigits[LeftDigitsIndex-1];
9508
      Dec(LeftDigitsIndex);
9509
   end;
9510

9511
   QuotientDigit := BigInteger.Zero;
9512
   Quotient := BigInteger.Zero;
9513
   while LeftDigitsIndex > 0 do
9514
   begin
9515
      DivTwoDigitsByOne((Remainder shl N) + LeftDigits[LeftDigitsIndex-1], Right, N, QuotientDigit, Remainder);
9516
      Dec(LeftDigitsIndex);
9517
      Quotient := (Quotient shl N) + QuotientDigit;
9518
   end;
9519
end;
9520

9521
class procedure BigInteger.DivModBurnikelZiegler(const Left, Right: BigInteger; var Quotient, Remainder: BigInteger);
9522
var
9523
  Q, R: BigInteger;
9524
begin
9525
  if Right.IsZero then
9526
    raise Exception.Create('Division by zero')
9527
  else if Right.IsNegative then
9528
  begin
9529
    DivModBurnikelZiegler(-Left, -Right, Q, R);
9530
    Quotient := Q;
9531
    Remainder := -R;
9532
    Exit;
9533
  end
9534
  else if Left.IsNegative then
9535
  begin
9536
    DivModBurnikelZiegler(not Left, Right, Q, R);
9537
    Quotient := not Q;
9538
    Remainder := Right + not R;
9539
    Exit;
9540
  end
9541
  else if Left.IsZero then
9542
  begin
9543
    Quotient := BigInteger.Zero;
9544
    Remainder := BigInteger.Zero;
9545
    Exit;
9546
  end
9547
  else
9548
  begin
9549
    InternalDivModBurnikelZiegler(Left, Right, Q, R);
9550
    Quotient := Q;
9551
    Remainder := R;
9552
    Exit;
9553
  end;
9554
end;
9555

9556
end.
9557