fcl-hash: added fprsa

packages/fcl-hash/fpmake.pp

@@ -49,6 +49,8 @@ begin
     T.Dependencies.AddUnit('fphashutils');
     T.Dependencies.AddUnit('fpecc');
     T.Dependencies.AddUnit('fpsha256');
+    T:=P.Targets.AddUnit('src/fptlsbigint.pas');
+    T:=P.Targets.AddUnit('src/fprsa.pas');
     T:=P.Targets.AddUnit('src/onetimepass.pp');
     
     T:=P.Targets.AddExampleunit('examples/demosha256.pp');

packages/fcl-hash/src/fprsa.pas

@@ -0,0 +1,393 @@
+unit fprsa;
+
+{$mode ObjFPC}
+{$H+}
+{$ModeSwitch advancedrecords}
+
+interface
+
+uses
+  sysutils, fpTLSBigInt, fphashutils, fpasn;
+
+type
+  TRSA = record
+    M: PBigInt;             // Modulus
+    E: PBigInt;             // Public exponent
+    D: PBigInt;             // Private exponent
+    P: PBigInt;             // p in m = pq
+    Q: PBigInt;             // q in m = pq
+    DP: PBigInt;            // d mod (p-1)
+    DQ: PBigInt;            // d mod (q-1)
+    QInv: PBigInt;          // q^-1 mod p
+    ModulusLen: Integer;
+    Context: TBigIntContext;
+  end;
+
+procedure RSACreate(var RSA: TRSA);
+procedure RSAFree(var RSA: TRSA);
+procedure RsaPublicKeyToHexa(const Modulus, Exponent: String; var PublicKeyHexa: String);
+procedure RsaPublicKeyFromHexa(const PublicKeyHexa: String; out Modulus, Exponent: String);
+{$IFDEF TLS}
+procedure RSAInitFromPrivateKey(var RSA: TRSA; const RSAPrivateKey: TX509RSAPrivateKey);
+procedure RSAInitFromPublicKey(var RSA: TRSA; const RSAPublicKey: TX509RSAPublicKey); overload;
+{$ENDIF}
+procedure RsaInitFromPublicKey(var RSA: TRSA; const Modulus, Exponent: String); overload;
+function RSAEncryptSign(var RSA: TRSA; const Input: PByte; Len: Integer; Output: PByte; Sign: Boolean): Integer;
+function RSADecryptVerify(var RSA: TRSA; const Input: PByte; Output: PByte; Len: Integer; Verify: Boolean): Integer;
+function RS256VerifyFromPublicKeyHexa(const PublicKeyHexa, SignatureBaseHash, Signature: String): Boolean;
+function TestRS256Verify: Boolean;
+
+implementation
+
+const
+  RSA_MODULUS_BYTES_MAX = 512; // 4096 bit maximum
+
+procedure RSACreate(var RSA: TRSA);
+begin
+  BIInitialize(RSA.Context);
+end;
+
+procedure RSAFree(var RSA: TRSA);
+begin
+  if RSA.M = nil then
+    Exit;
+  BITerminate(RSA.Context);
+end;
+
+procedure RsaPublicKeyToHexa(const Modulus, Exponent: String;
+  var PublicKeyHexa: String);
+begin
+  PublicKeyHexa:=PublicKeyHexa+BytesToHexStr(Exponent)+BytesToHexStr(Modulus);
+end;
+
+procedure RsaPublicKeyFromHexa(const PublicKeyHexa: String; out Modulus,
+  Exponent: String);
+var
+  aBytes: TBytes;
+begin
+  HexStrToBytes(PublicKeyHexa,aBytes);
+  if length(aBytes)<4 then
+    raise Exception.Create('20220426235757');
+  SetLength(Exponent{%H-},3);
+  Move(aBytes[0],Exponent[1],3);
+  SetLength(Modulus{%H-},length(aBytes)-3);
+  Move(aBytes[3],Modulus[1],length(Modulus));
+end;
+
+procedure RsaInitFromPublicKey(var RSA: TRSA; const Modulus, Exponent: String);
+begin
+  RSA.ModulusLen := length(Modulus);
+  RSA.M := BIImport(RSA.Context, Modulus);
+  BISetMod(RSA.Context, RSA.M, BIGINT_M_OFFSET);
+  RSA.E := BIImport(RSA.Context, Exponent);
+  BIPermanent(RSA.E);
+end;
+
+function RSAEncryptSign(var RSA: TRSA; const Input: PByte; Len: Integer;
+  Output: PByte; Sign: Boolean): Integer;
+{ Perform PKCS1.5 Encryption or Signing
+  Context: The RSA context containing Private and/or Public keys
+  Input: The data to be encrypted
+  Len: The size of the input data in bytes (Must be <= Modulus length - 11 to
+       make the padding at least 8 bytes as recommended by RFC2313)
+  Output: The buffer for the encrypted result (Must always be Modulus length)
+  Sign: If true then sign instead of encrypting
+  Return: The number of bytes encrypted or -1 on error
+}
+var
+  Size: Integer;
+  Padding: Integer;
+  Imported: PByte;
+  Decrypted: PBigInt;
+  Encrypted: PBigInt;
+  Block: array[0..RSA_MODULUS_BYTES_MAX-1] of Byte;
+begin
+  Result := -1;
+  if Input = nil then
+    Exit;
+  if Output = nil then
+    Exit;
+  Size := RSA.ModulusLen;
+  Padding := Size-Len-3;
+  if Len > Size-11 then
+    Exit;
+  {$IFDEF CRYPTO_DEBUG}
+    writeln('RSAEncryptSign - Len = ' + IntToStr(Len) + ' Size = ' + IntToStr(Size) + ' Padding = ' + IntToStr(Padding)); //To Do
+  {$ENDIF}
+  if Size > RSA_MODULUS_BYTES_MAX then
+    Imported := GetMem(Size)
+  else
+    Imported := @Block;
+  try
+    // Leading zero to ensure encryption block is less than modulus (when converted to an integer)
+    Imported[0]:=0;
+
+    // Check Sign
+    if Sign then
+    begin
+      // Block Type 1
+      Imported[1]:=1;
+
+      // Pad with 0xff bytes
+      FillByte(Imported[2],Padding,$FF);
+    end else
+    begin
+      // Block Type 2
+      Imported[1]:=2;
+
+      // Pad with random non-zero bytes
+      if not CryptoGetRandomBytes(@Imported[2], Padding) then
+        Exit;
+    end;
+
+    // Trailing zero after padding bytes
+    Imported[2 + Padding]:=0;
+
+    // Copy Input to Block
+    System.Move(Input^,Imported[3 + Padding],Len);
+
+    {$IFDEF CRYPTO_DEBUG}
+    writeln('RSAEncryptSign - Imported Size = ' + IntToStr(Size) + ' Imported = ',Imported,Size);
+    {$ENDIF}
+
+    // Encrypt the Block
+    Decrypted:=BIImport(RSA.Context,Imported,Size);
+    if Sign then
+    begin
+      // Sign with Private Key
+      Encrypted:=BICRT(RSA.Context,Decrypted,RSA.DP,RSA.DQ,RSA.P,RSA.Q,RSA.QInv);
+    end else
+    begin
+      // Encrypt with Public Key
+      RSA.Context.ModOffset:=BIGINT_M_OFFSET;
+      Encrypted:=BIModPower(RSA.Context,Decrypted,RSA.E);
+    end;
+    BIExport(RSA.Context,Encrypted,Output,Size);
+
+    {$IFDEF CRYPTO_DEBUG}
+    writeln('RSAEncryptSign - Output Size = ' + IntToStr(Size) + ' Output = ',Output,Size);
+    {$ENDIF}
+
+    // Return Result
+    Result:=Size;
+  finally
+    if Size > RSA_MODULUS_BYTES_MAX then
+      FreeMem(Imported);
+  end;
+end;
+
+function RSADecryptVerify(var RSA: TRSA; const Input: PByte; Output: PByte;
+  Len: Integer; Verify: Boolean): Integer;
+// Perform PKCS1.5 Decryption or Verification
+// Context: The RSA context containing Private and/or Public keys
+// @Input: The data to be decrypted (Must always be Modulus length)
+// @Output: The buffer for the decrypted result
+// Len: The size of the output buffer in bytes
+// Verify: If true then verify instead of decrypting
+// Return: The number of bytes decrypted or -1 on error
+var
+  Size: Integer;
+  Count: Integer;
+  Padding: Integer;
+  Exported: PByte;
+  Encrypted: PBigInt;
+  Decrypted: PBigInt;
+  Block: array[0..RSA_MODULUS_BYTES_MAX-1] of Byte;
+begin
+  Result := -1;
+  if Input = nil then
+    Exit;
+  if Output = nil then
+    Exit;
+  Size := RSA.ModulusLen;
+  Count := 0;
+  Padding := 0;
+  {$IFDEF CRYPTO_DEBUG}
+  writeln('RSA', 'RSADecryptVerify Len: ', Len, ' Size: ', Size, ' Padding: ', Padding);
+  {$ENDIF}
+  Encrypted := BIImport(RSA.Context, Input, Size);
+  if Verify then
+  begin
+    // Verify with Public Key
+    RSA.Context.ModOffset := BIGINT_M_OFFSET;
+    Decrypted := BIModPower(RSA.Context, Encrypted, RSA.E);
+  end else
+  begin
+    // Decrypt with Private Key
+    Decrypted := BICRT(RSA.Context,Encrypted,RSA.DP,RSA.DQ,RSA.P,RSA.Q,RSA.QInv);
+  end;
+  Exported := @Block;
+  if Size > RSA_MODULUS_BYTES_MAX then
+  begin
+    Exported := GetMem(Size);
+    if Exported = nil then
+      Exit;
+  end;
+  try
+    BIExport(RSA.Context, Decrypted, Exported, Size);
+    if Exported[Count] <> 0 then
+      Exit; // Check Leading Zero
+    Inc(Count);
+    if Verify then
+    begin
+      // Check Block Type 1
+      if Exported[Count] <> 1 then
+        Exit;
+      Inc(Count);
+      while (Exported[Count] = $FF) and (Count < Size) do
+      begin
+        // Padded with 0xff bytes
+        Inc(Count);
+        Inc(Padding);
+      end;
+    end else
+    begin
+      // Check Block Type 2
+      if Exported[Count] <> 2 then
+        Exit;
+      Inc(Count);
+      while (Exported[Count] <> 0) and (Count < Size) do
+      begin
+        // Padded with random non-zero bytes
+        Inc(Count);
+        Inc(Padding);
+      end;
+    end;
+    // Check trailing zero byte and padding size
+    if (Count = Size) or (Padding < 8) then
+      Exit;
+    if Exported[Count] <> 0 then
+      Exit;
+    Inc(Count);
+    Result := Size-Count;
+    if Len < Result then
+    begin
+      Result := -1;
+      Exit;
+    end;
+    if Len > Result then
+      FillByte(Output[Result], Len-Result, 0);
+    System.Move(Exported[Count], Output^, Result);
+    {$IFDEF CRYPTO_DEBUG}
+      writeln('RSADecryptVerify - Output Size: ', Result);
+      //writeln('Output: ', Output);
+    {$ENDIF}
+  finally
+    if Size > RSA_MODULUS_BYTES_MAX then
+      FreeMem(Exported);
+  end;
+end;
+
+function RsaVerify(const Modulus, Exponent, Hash, Signature: String): Boolean;
+var
+  ASNType, ASNSize: Int32;
+  Data: array[0..4095] of byte;
+  Digest: String;
+  DataP, DataEnd: PByte;
+  OID: String;
+  RSA: TRSA;
+  Size: Integer;
+begin
+  Result := False;
+  {$IFDEF TLS_DEBUG}
+    writeln('RsaVerify - Modulus: ', Modulus,' Exponent: ', Exponent,
+       ' Hash: ', Hash, ' Signature: ', Signature,
+       ' Signature Length: ', Signature.Length,
+       ' Modulus Length: ', Modulus.Length);
+  {$ENDIF}
+  if length(Modulus) <> length(Signature) then
+    Exit;
+  if length(Signature)>length(Data) then
+    Exit;
+  RsaCreate(RSA);
+  try
+    RsaInitFromPublicKey(RSA, Modulus, Exponent);
+    DataP:=PByte(@Data[0]);
+    DataEnd:=DataP+length(Data);
+    Size := RSADecryptVerify(RSA, PByte(Signature), DataP, length(Signature), True); // Decrypt the signature
+    if Size = -1 then
+      Exit;
+    if not ASNFetch(DataP, DataEnd, ASNType, ASNSize) then  // Sequence: DigestInfo
+      Exit;
+    if ASNType <> ASN1_SEQ then
+      Exit;
+    if not ASNFetch(DataP, DataEnd, ASNType, ASNSize) then  // Sequence: AlgorithmIdentifier
+      Exit;
+    if ASNType <> ASN1_SEQ then
+      Exit;
+    if not ASNFetchOID(DataP, DataEnd, OID) then  // OID: Algorithm
+      Exit;
+    if not ASNFetch(DataP, DataEnd, ASNType, ASNSize) then  // ASN1_NULL OctetString: Digest
+      Exit;
+    if ASNType = ASN1_NULL then
+    begin
+      if not ASNFetch(DataP, DataEnd, ASNType, ASNSize) then  // OctetString: Digest
+        Exit;
+    end;
+    if ASNType <> ASN1_OCTSTR then
+    begin
+      {$IFDEF TLS_DEBUG}
+      writeln('RsaVerify - OCTETSTRING Digest not found in decoded Signature');
+      {$ENDIF}
+      Exit;
+    end;
+    if ASNSize <> length(Hash) then
+    begin
+      {$IFDEF TLS_DEBUG}
+      writeln('RsaVerify - Mismatch digest size: ',ASNSize,' != Hash.Length: ', length(Hash));
+      {$ENDIF}
+      Exit;
+    end;
+    if DataEnd-DataP<ASNSize then
+      Exit;
+    SetLength(Digest{%H-},ASNSize);
+    System.Move(DataP^,Digest[1],ASNSize);
+    {$IFDEF TLS_DEBUG}
+      writeln('RsaVerify - Compare Digest: ', Digest);
+      writeln('RsaVerify - with Hash: ', Hash);
+    {$ENDIF}
+    Result := Digest=Hash;
+    {$IFDEF TLS_DEBUG}
+    if Result then
+      writeln('RsaVerify - Success')
+    else
+      writeln('RsaVerify - Failed');
+    {$ENDIF}
+  finally
+    RSAFree(RSA);
+  end;
+end;
+
+function RS256VerifyFromPublicKeyHexa(const PublicKeyHexa, SignatureBaseHash,
+  Signature: String): Boolean;
+var
+  Modulus, Exponent: String;
+begin
+  RsaPublicKeyFromHexa(PublicKeyHexa, Modulus, Exponent);
+  Result := RsaVerify(Modulus, Exponent, SignatureBaseHash, Signature);
+end;
+
+function TestRS256Verify: Boolean;
+const
+  _Modulus = 'BB32B4D0D89E9A9E8C79294C2BA8EF5C43D4933B9478FF3054C71BC8E52F1B99CD108D67C8540C075AE4F4067FC7D684B42CCD2D4E4426011AEA37BEEFF4C715'
+            +'07C3164C6B261909D2FF5910445B8A8981941DFEE25F9A5F8A36D8B0E91F6F802254ACAC29435552D815BE92687B94565118D0A7D5C35A47A8D83CC61D72DC04'
+            +'369DACCF152C2E87D7F0FD497755AEEC4AA9DB8B291E3567FE9D9520DD798D600A7873DC2875A586DF31FB130936A6C3E02D46DC252B76F6ADF4C77DF868C23B'
+            +'B3335E542ADF9BAEBFDC1019408D04EF6BCAEEB5853D2BD38D825FA91B6BBB06FE75E83C26372F31CFDC0E8D378EA5E87433D37F7B0ABC7206D1F3B2C56B18B5';
+  _Hash = 'A135E3608E956E91743421E0677C03FBE2C7CE0890FF06423B66335E3428EF9A';
+  _Exponent = '010001';
+  _Signature =  '75BDCF54B21FD4F2891EEC91D1E9F6D82ADEB63BBB1DB4E03A389B525E8F5B97669FEB2E9C87EF4E785124F5499918771E03E4FF83E31CE0CF4A8276809C35AA'
+               +'FBF9B45B7918F5D891D863CA441D5803DFD1C4190640A73ADA10DC05C2EF480C449FDD157AB4CD1ADE0B067930E07607134ED425BE5A0A1F78AFD6045BA638E7'
+               +'18BFB311B8377C0FACDED4CD2B1E2692E480BE260BE355F050EBABF89E24F2833F56F0A74C185225DB3B47B63612FB9BDEE1E1B8707807093E1551F24527A763'
+               +'1947D033ED7052C439E50B8A46E4D0C06DBC38AF1D64B49766A5CF9A82644650FFD733B61942DB0BD8D47C8EF24A02DC9FD2EF557B12DED804519F2B2B6C284D';
+var
+  Exponent, Modulus, Hash, Signature: string;
+begin
+  Exponent:=HexStrToString(_Exponent);
+  Modulus:=HexStrToString(_Modulus);
+  Hash:=HexStrToString(_Hash);
+  Signature:=HexStrToString(_Signature);
+  Result := RsaVerify(Modulus, Exponent, Hash, Signature);
+end;
+
+end.
+

packages/fcl-hash/src/fptlsbigint.pas

@@ -0,0 +1,1239 @@
+
+{-------------------------------------------------------------------------------
+  Notes: refactored from Ultibo Big Integer unit Copyright (C) 2018 - SoftOz Pty Ltd.
+  inspired by AXTLS - \crypto\bigint.c - Copyright (c) 2007, Cameron Rich
+  Reference: Handbook of Applied Cryptography (Chapter 14) - http://cacr.uwaterloo.ca/hac/about/chap14.pdf
+-------------------------------------------------------------------------------}
+{$MODE OBJFPC}
+{$h+}
+{$MODESWITCH advancedrecords}
+unit fpTLSBigInt;
+
+interface
+
+uses SysUtils;
+
+{ $DEFINE BIGINT_DEBUG}         // Enable debug output/functions for BitInt unit
+
+const
+  // Maintain a number of precomputed variables when doing reduction
+  BIGINT_M_OFFSET = 0;    // Normal modulo offset
+  BIGINT_P_OFFSET = 1;    // P modulo offset
+  BIGINT_Q_OFFSET = 2;    // Q modulo offset
+  BIGINT_NUM_MODS = 3;    // The number of modulus constants used
+
+const
+  BIGINT_COMP_RADIX       = UInt64(4294967296);        // Max component + 1
+  BIGINT_COMP_MAX         = UInt64($FFFFFFFFFFFFFFFF); // Max dbl component - 1
+  BIGINT_COMP_BIT_SIZE    = 32;                        // Number of bits in a component
+  BIGINT_COMP_BYTE_SIZE   = 4;                         // Number of bytes in a component
+  BIGINT_COMP_NUM_NIBBLES = 8;                         // Used for diagnostics only
+
+  BIGINT_PERMANENT = $7FFF55AA;  {A magic number for permanents}
+
+  BIGINTCONTEXT_CHUNKSIZE = 16*1024;
+
+type
+  PBIComponent = ^TBIComponent;
+  TBIComponent = LongWord;    // A single precision component
+
+  PBILongComponent = ^TBILongComponent;
+  TBILongComponent = UInt64; // A double precision component
+
+  PBISignedLongComponent = ^TBISignedLongComponent;
+  TBISignedLongComponent = Int64; // A signed double precision component
+
+  PBIComponents = ^TBIComponents;
+  TBIComponents = array[0..(MaxInt div SizeOf(TBIComponent))-1] of TBIComponent;
+
+type
+  PPBigInt = ^PBigInt;
+  PBigInt = ^TBigInt;
+  TBigInt = record
+    Next: PBigInt;           // The next bigint in the cache
+    Size: Integer;           // The number of components in this bigint
+    MaxComponents: Integer;  // The number of components allocated for this bigint
+    References: Integer;     // An internal reference count
+    Components: PBIComponent;  // A ptr to the actual component data
+    procedure ToString(out S: AnsiString);
+  end;
+  PBigInts = ^TBigInts;
+  TBigInts = array[0..(MaxInt div SizeOf(PBigInt)) - 1] of PBigInt;
+
+  {Maintains the state of the cache, and a number of variables used in reduction}
+  PBigIntContext = ^TBigIntContext;
+  TBigIntContext = record
+    FreeList: PBigInt;                                        // Bigints not used
+    BIRadix: PBigInt;                                         // The radix used
+    BIMod: array[0..BIGINT_NUM_MODS-1] of PBigInt;            // Modulus
+    BImu: array[0..BIGINT_NUM_MODS-1] of PBigInt;             // Storage for mu
+    BIbk1: array[0..BIGINT_NUM_MODS-1] of PBigInt;            // Storage for b(k+1)
+    BINormalisedMod: array[0..BIGINT_NUM_MODS-1] of PBigInt;  // Normalised mod storage
+    G: PPBigInt;                                              // Used by sliding-window
+    Window: Integer;                                          // The size of the sliding window
+    ActiveCount: Integer;                                     // Number of active bigints
+    FreeCount: Integer;                                       // Number of free bigints
+    ModOffset: Byte;                                          // The mod offset we are using
+  end;
+
+procedure BIInitialize(out Context: TBigIntContext);
+procedure BITerminate(var Context: TBigIntContext);
+procedure BIPermanent(BI: PBigInt);
+procedure BIDepermanent(BI: PBigInt);
+procedure BIRelease(var Context: TBigIntContext; BI:PBigInt);
+
+function BICopy(BI: PBigInt): PBigInt;
+function BIClone(var Context: TBigIntContext; const BI: TBigInt): PBigInt;
+
+procedure BIExport(var Context: TBigIntContext; BI: PBigInt; Data: PByte; Size: Integer);
+function BIImport(var Context: TBigIntContext; Data: PByte; const Size: Integer): PBigInt; overload;
+function BIImport(var Context: TBigIntContext; const Data: TBytes): PBigInt; overload;
+function BIImport(var Context: TBigIntContext; const Data: AnsiString): PBigInt; overload;
+function IntToBI(var Context: TBigIntContext; I: TBIComponent): PBigInt;
+
+function BIAdd(var Context: TBigIntContext; BIA, BIB: PBigInt): PBigInt;
+function BISubtract(var Context: TBigIntContext; BIA, BIB: PBigInt;out IsNegative: Boolean): PBigInt;
+function BIDivide(var Context: TBigIntContext; U, V: PBigInt; IsMod: Boolean): PBigInt;
+function BIMultiply(var Context: TBigIntContext; BIA, BIB: PBigInt): PBigInt;
+function BIModPower(var Context: TBigIntContext; BI, BIExp: PBigInt): PBigInt;
+//function BIModPower2(var Context: TBigIntContext; BI,BIM,BIExp:PBigInt):PBigInt;
+
+function BICompare(BIA, BIB: PBigInt): Integer;
+procedure BISetMod(var Context: TBigIntContext; BIM: PBigInt; ModOffset: Integer);
+procedure BIFreeMod(var Context: TBigIntContext; ModOffset: Integer);
+
+function BIMod(var Context: TBigIntContext; BI: PBigInt): PBigInt; inline;
+function BIResidue(var Context: TBigIntContext; BI: PBigInt): PBigInt; inline;
+function BIBarrett(var Context: TBigIntContext; BI: PBigInt): PBigInt;
+
+function BISquare(var Context: TBigIntContext; BI: PBigInt): PBigInt; inline;
+
+function BICRT(var Context: TBigIntContext; BI, DP, DQ, P, Q, QInv: PBigInt): PBigInt;
+
+procedure BItoString(BI: PBigInt; out S: AnsiString);
+function StringToBI(var Context: TBigIntContext; const Value: AnsiString): PBigInt;
+
+implementation
+
+// @S[BI.Size*2]
+procedure TBigInt.ToString(out S: AnsiString);
+begin
+  BIToString(@Self, S);
+end;
+
+function Min(A, B: LongInt): LongInt; inline;
+begin
+  if A < B then
+    Result := A
+  else
+    Result:=B;
+end;
+
+function Max(A, B: LongInt): LongInt; inline;
+begin
+  if A > B then
+    Result := A
+  else
+    Result := B;
+end;
+
+{Internal Functions}
+
+{Perform a sanity check on bi}
+function BICheck(const BI: TBigInt): Boolean; inline;
+begin
+{$IFDEF BIGINT_DEBUG}
+  if BI.References <= 0 then
+  begin
+    XLog(tlDebug, 'TLS', 'BICheck - Zero or negative References in TBigInt');
+    Result := False;
+    Exit;
+  end;
+  if BI.Next <> nil then
+  begin
+    XLog(tlDebug, 'TLS', 'BICheck - Attempt to use a TBigInt from the free list');
+    Result := False;
+    Exit;
+  end;
+  Result:=True;
+{$ELSE}
+  Result:=True;
+{$ENDIF}
+end;
+
+// Delete any leading 0's (and allow for 0)
+procedure BITrim(BI: PBigInt);
+begin
+  if not BICheck(BI^) then
+    Exit;
+  while (PBIComponents(BI^.Components)^[BI^.Size-1] = 0) and (BI^.Size > 1) do
+    Dec(BI^.Size);
+end;
+
+procedure BIAddComponents(var Context: TBigIntContext; BI: PBigInt; N: Integer);
+var
+  OldComponents: PBIComponent;
+  OldMaxComponents: Int32;
+begin
+  if N > BI^.MaxComponents then
+  begin
+    BI^.MaxComponents := Max(BI^.MaxComponents*2, N);
+    ReAllocMem(BI^.Components, BI^.MaxComponents*BIGINT_COMP_BYTE_SIZE);
+  end;
+  if N > BI^.Size then
+    FillChar(PBIComponents(BI^.Components)^[BI^.Size], (N-BI^.Size)*BIGINT_COMP_BYTE_SIZE, 0);
+  BI^.Size := N;
+end;
+
+function BIAllocate(var Context: TBigIntContext; Size: Integer): PBigInt;
+begin
+  if Context.FreeList <> nil then
+  begin
+    Result := Context.FreeList;
+    Context.FreeList := Result^.Next;
+    Dec(Context.FreeCount);
+    if Result^.References <> 0 then
+    begin
+      Result := nil;
+      Exit;
+    end;
+    BIAddComponents(Context, Result, Size);
+  end else
+  begin
+    Result := AllocMem(SizeOf(TBigint));
+    Result^.Components := AllocMem((Size*2)*BIGINT_COMP_BYTE_SIZE);
+    Result^.MaxComponents := Size*2; // Allow space to expand
+  end;
+  Result^.Size := Size;
+  Result^.References := 1;
+  Result^.Next := nil;
+  Inc(Context.ActiveCount);
+end;
+
+// Work out the highest '1' bit in an exponent. Used when doing sliding-window exponentiation
+function BIFindMaxExponentIndex(BIExp: PBigInt): Integer;
+var
+  I: Integer;
+  Shift, Test: TBIComponent;
+begin
+  I := BIGINT_COMP_BIT_SIZE-1;
+  Shift:=BIGINT_COMP_RADIX div 2;
+  Test:=PBIComponents(BIExp^.Components)^[BIExp^.Size - 1]; {Assume no leading zeroes}
+  if not BICheck(BIExp^) then
+  begin
+    Result:=-1;
+    Exit;
+  end;
+  repeat
+    if (Test and Shift) <> 0 then
+    begin
+      Result := I + (BIExp^.Size-1) * BIGINT_COMP_BIT_SIZE;
+      Exit;
+    end;
+    Shift := Shift shr 1;
+    Dec(I);
+  until I < 0;
+  Result := -1; // Error - must have been a leading 0
+end;
+
+// Is a particular bit is an exponent 1 or 0? Used when doing sliding-window exponentiation
+function BIExpBitIsOne(BIExp: PBigInt; Offset: Integer): Boolean;
+var
+  NumShifts: Integer;
+  Shift, Test: TBIComponent;
+begin
+  Test := PBIComponents(BIExp^.Components)^[Offset div BIGINT_COMP_BIT_SIZE];
+  NumShifts := Offset mod BIGINT_COMP_BIT_SIZE;
+  if not BICheck(BIExp^) then
+  begin
+   Result := False;
+   Exit;
+  end;
+  Shift := 1 shl NumShifts;
+  Result := (Test and Shift) <> 0;
+end;
+
+function BIIntMultiply(var Context: TBigIntContext; BIA: PBigInt; B: TBIComponent): PBigInt;
+var
+  A: PBIComponent;
+  Carry: TBIComponent;
+  J, N: Integer;
+  R: PBIComponent;
+  Tmp: TBILongComponent;
+begin
+  if not BICheck(BIA^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  J := 0;
+  N := BIA^.Size;
+  Carry := 0;
+  Result := BIAllocate(Context, N + 1);
+  R := Result^.Components;
+  A := BIA^.Components;
+  FillChar(R^, (N+1) * BIGINT_COMP_BYTE_SIZE, 0);
+  repeat
+    Tmp := R^ + TBILongComponent(PBIComponents(A)^[J]) * B + Carry; // Avoid overflow
+    R^ := Tmp; // Downsize
+    Inc(R);
+    Carry := Tmp shr BIGINT_COMP_BIT_SIZE;
+    Inc(J);
+  until J >= N;
+  R^ := Carry;
+  BIRelease(Context, BIA);
+  BITrim(Result);
+end;
+
+function BIIntDivide(var Context: TBigIntContext; BIR: PBigInt; Denom: TBIComponent): PBigInt;
+var
+  I: Integer;
+  R: TBILongComponent;
+begin
+  if not BICheck(BIR^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  I := BIR^.Size-1;
+  R := 0;
+  repeat
+    R := (R shl BIGINT_COMP_BIT_SIZE) + PBIComponents(BIR^.Components)^[I];
+    PBIComponents(BIR^.Components)^[I] := R div Denom;
+    R := R mod Denom;
+    Dec(I);
+  until I < 0;
+  BITrim(BIR);
+  Result := BIR;
+end;
+
+// Take each component and shift down (in terms of components)
+function BICompRightShift(BIR: PBigInt; NumShifts: Integer): PBigInt;
+var
+  I: Integer;
+  X, Y: PBIComponent;
+begin
+  if not BICheck(BIR^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  I := BIR^.Size-NumShifts;
+  X := BIR^.Components;
+  Y := @PBIComponents(BIR^.Components)^[NumShifts];
+  if I <= 0 then // Have we completely right shifted?
+  begin
+    PBIComponents(BIR^.Components)^[0]:=0; {Return 0}
+    BIR^.Size:=1;
+    Result:=BIR;
+    Exit;
+  end;
+  repeat
+    X^ := Y^;
+    Inc(X);
+    Inc(Y);
+    Dec(I);
+  until I <= 0;
+  Dec(BIR^.Size, NumShifts);
+  Result := BIR;
+end;
+
+// Take each component and shift it up (in terms of components)
+function BICompLeftShift(var Context: TBigIntContext; BIR: PBigInt; NumShifts: Integer): PBigInt;
+var
+ I: Integer;
+ X: PBIComponent;
+ Y: PBIComponent;
+begin
+  if not BICheck(BIR^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  I := BIR^.Size-1;
+  if NumShifts <= 0 then
+  begin
+    Result:=BIR;
+    Exit;
+  end;
+  BIAddComponents(Context, BIR, BIR^.Size+NumShifts);
+  X := @(PBIComponents(BIR^.Components)^[I + NumShifts]);
+  Y := @(PBIComponents(BIR^.Components)^[I]);
+  repeat
+    X^ := Y^;
+    Dec(X);
+    Dec(Y);
+    Dec(I);
+  until I < 0;
+  FillChar(BIR^.Components^, NumShifts*BIGINT_COMP_BYTE_SIZE, 0); // Zero least significant components
+  Result := BIR;
+end;
+
+// Perform a standard multiplication between two bigints
+function BIRegularMultiply(var Context: TBigIntContext; BIA, BIB: PBigInt; InnerPartial, OuterPartial: Integer): PBigInt;
+var
+  Carry: TBIComponent;
+  BIR: PBigInt;
+  I, J, N, RIndex, T: Integer;
+  SA, SB, SR:PBIComponent;
+  Tmp: TBILongComponent;
+begin
+  if not BICheck(BIA^) or not BICheck(BIB^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  I := 0;
+  N := BIA^.Size;
+  T := BIB^.Size;
+  BIR := BIAllocate(Context, N+T);
+  SR := BIR^.Components;
+  SA := BIA^.Components;
+  SB := BIB^.Components;
+  FillChar(BIR^.Components^, (N+T) * BIGINT_COMP_BYTE_SIZE, 0);
+  repeat
+    Carry := 0;
+    RIndex := I;
+    J := 0;
+    if (OuterPartial > 0) and ((OuterPartial-I) > 0) and (OuterPartial < N) then
+    begin
+      RIndex := OuterPartial-1;
+      J := OuterPartial-I-1;
+    end;
+    repeat
+      if (InnerPartial > 0) and (RIndex >= InnerPartial) then
+        Break;
+      Tmp := PBIComponents(SR)^[RIndex] + TBILongComponent(PBIComponents(SA)^[J]) * PBIComponents(SB)^[I] + Carry; // Avoid overflow
+      PBIComponents(SR)^[RIndex] := Tmp; // Downsize
+      Inc(RIndex);
+      Carry := Tmp shr BIGINT_COMP_BIT_SIZE;
+      Inc(J);
+    until J >= N;
+    PBIComponents(SR)^[RIndex] := Carry;
+    Inc(I);
+  until I >= T;
+  BIRelease(Context,BIA);
+  BIRelease(Context,BIB);
+  BITrim(BIR);
+  Result := BIR;
+end;
+
+// Perform the actual square operation. It takes into account overflow
+function BIRegularSquare(var Context: TBigIntContext; BI: PBigInt): PBigInt;
+var
+  BIR: PBigInt;
+  C: Byte;
+  Carry: TBILongComponent;
+  I, J, T: Integer;
+  Tmp, XX: TBILongComponent;
+  W, X: PBIComponent;
+begin
+  T := BI^.Size;
+  I := 0;
+  BIR := BIAllocate(Context, T*2 + 1);
+  W := BIR^.Components;
+  X := BI^.Components;
+  FillChar(W^,BIR^.Size * BIGINT_COMP_BYTE_SIZE,0);
+  repeat
+    Tmp := PBIComponents(W)^[2*I] + TBILongComponent(PBIComponents(X)^[I]) * PBIComponents(X)^[I]; // Avoid overflow
+    PBIComponents(W)^[2 * I] := Tmp;
+    Carry := Tmp shr BIGINT_COMP_BIT_SIZE;
+    J := I+1;
+    while J < T do
+    begin
+      C := 0;
+      XX := TBILongComponent(PBIComponents(X)^[I]) * PBIComponents(X)^[J]; // Avoid overflow
+      if BIGINT_COMP_MAX-XX < XX then
+        C := 1;
+      Tmp := XX shl 1;
+      if BIGINT_COMP_MAX-Tmp < PBIComponents(W)^[I + J] then
+        C := 1;
+      Tmp := Tmp + PBIComponents(W)^[I + J];
+      if BIGINT_COMP_MAX-Tmp < Carry then
+        C := 1;
+      Tmp := Tmp + Carry;
+      PBIComponents(W)^[I + J] := Tmp;
+      Carry := Tmp shr BIGINT_COMP_BIT_SIZE;
+      if C > 0 then
+        Carry := Carry + BIGINT_COMP_RADIX;
+      Inc(J);
+    end;
+    Tmp := PBIComponents(W)^[I+T]+Carry;
+    PBIComponents(W)^[I+T] := Tmp;
+    PBIComponents(W)^[I+T+1] := Tmp shr BIGINT_COMP_BIT_SIZE;
+    Inc(I);
+  until I >= T;
+  BIRelease(Context, BI);
+  BITrim(BIR);
+  Result := BIR;
+end;
+
+// Stomp on the most significant components to give the illusion of a "mod base radix" operation
+function BICompMod(BI: PBigInt; Modulus: Integer): PBigInt;
+begin
+  if not BICheck(BI^) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+  if BI^.Size > Modulus then
+    BI^.Size := Modulus;
+  Result := BI;
+end;
+
+// Work out g1, g3, g5, g7... etc for the sliding-window algorithm
+procedure BIPrecomputeSlideWindow(var Context: TBigIntContext; Window: Integer; G1: PBigInt);
+var
+  I, K: Integer;
+  G2: PBigInt;
+begin
+  K := 1;
+  I := 0;
+  while I < Window-1 do {Compute 2^(window-1)}
+  begin
+    K := K shl 1;
+    Inc(I);
+  end;
+  Context.G := AllocMem(K*SizeOf(PBigInt));
+  PBigInts(Context.G)^[0] := BIClone(Context, G1^);
+  BIPermanent(PBigInts(Context.G)^[0]);
+  G2 := BIResidue(Context, BISquare(Context, PBigInts(Context.G)^[0])); {g^2}
+  for I := 1 to K-1 do
+  begin
+    PBigInts(Context.G)^[I] := BIResidue(Context, BIMultiply(Context, PBigInts(Context.G)^[I-1], BICopy(G2)));
+    BIPermanent(PBigInts(Context.G)^[I]);
+  end;
+  BIRelease(Context, G2);
+  Context.Window := K;
+end;
+
+procedure BIInitialize(out Context: TBigIntContext);
+begin
+  Context:=Default(TBigIntContext);
+  Context.BIRadix := BIAllocate(Context, 2);
+  PBIComponents(Context.BIRadix^.Components)^[0] := 0;
+  PBIComponents(Context.BIRadix^.Components)^[1] := 1;
+  BIPermanent(Context.BIRadix);
+end;
+
+// Close the bigint context and free any resources
+procedure BITerminate(var Context: TBigIntContext);
+
+Var
+  BI,BN : PBigInt;
+
+begin
+  FreeMem(Context.BIRadix);
+  BI:=Context.FreeList;
+  While BI<>Nil do
+    begin
+    BN:=BI^.Next;
+    if BI^.Components<>Nil then
+      FreeMem(BI^.Components);
+    FreeMem(BI);
+    BI:=BN;
+    end;
+end;
+
+// Make a bigint object "unfreeable" if BIFree() is called on it
+procedure BIPermanent(BI: PBigInt);
+begin
+  if not BICheck(BI^) then
+    Exit;
+  if BI^.References <> 1 then
+  begin
+    //XLog(tlDebug, 'TLS', 'BIPermanent - References not equal to one');
+    //To Do //Log Error /Raise Exception
+    Exit;
+  end;
+  BI^.References := BIGINT_PERMANENT;
+end;
+
+// Take a permanent object and make it freeable
+procedure BIDepermanent(BI: PBigInt);
+begin
+  if not BICHeck(BI^) then
+    Exit;
+  if BI^.References <> BIGINT_PERMANENT then
+  begin
+    // XLog(tlDebug, 'TLS', 'BIDepermanent - References not equal to BIGINT_PERMANENT');
+    Exit;
+  end;
+  BI^.References := 1;
+end;
+
+// Free a bigint object so it can be used again
+procedure BIRelease(var Context: TBigIntContext; BI: PBigInt);
+begin
+  if not BICheck(BI^) then
+    Exit;
+  if BI^.References = BIGINT_PERMANENT then
+    Exit;
+  Dec(BI^.References);
+  if BI^.References > 0 then
+    Exit;
+  BI^.Next := Context.FreeList;
+  Context.FreeList := BI;
+  Inc(Context.FreeCount);
+  Dec(Context.ActiveCount);
+//  if Context.ActiveCount < 0 then
+//    XLog(tlWarning, 'TLS', 'BIFree - ActiveCount less than zero');
+end;
+
+{==============================================================================}
+
+// Increment the number of references to this object
+function BICopy(BI: PBigInt): PBigInt;
+begin
+  if not BICheck(BI^) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+  if BI^.References <> BIGINT_PERMANENT then
+    Inc(BI^.References);
+  Result := BI;
+end;
+
+function BIClone(var Context: TBigIntContext; const BI: TBigInt): PBigInt;
+begin
+  if not BICheck(BI) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  Result := BIAllocate(Context, BI.Size);
+  System.Move(BI.Components^, Result^.Components^, BI.Size*BIGINT_COMP_BYTE_SIZE);
+end;
+
+procedure BIExport(var Context: TBigIntContext; BI: PBigInt; Data: PByte; Size: Integer);
+{Take a bigint and convert it into a byte sequence}
+{Context: The bigint session context}
+{BI: The bigint to be converted}
+{Data: The converted data as a byte stream}
+{Size: The maximum size of the byte stream. Unused bytes will be zeroed}
+var
+  I: Integer;
+  J: Integer;
+  K: Integer;
+  Mask: TBIComponent;
+  Num: Integer;
+begin
+  if not BICheck(BI^) then
+    Exit;
+  FillChar(Data^,Size,0);
+  K := Size-1;
+  try
+    for I := 0 to BI^.Size - 1 do
+    begin
+      for J := 0 to BIGINT_COMP_BYTE_SIZE - 1 do
+      begin
+        Mask := $FF shl (J * 8);
+        Num := (PBIComponents(BI^.Components)^[I] and Mask) shr (J * 8);
+        PByteArray(Data)^[K]:=Num;
+        Dec(K);
+        if K < 0 then
+          Exit;
+      end;
+    end;
+  finally
+    BIRelease(Context,BI);
+  end;
+end;
+
+// Allow a binary sequence to be imported as a bigint
+function BIImport(var Context: TBigIntContext; Data: PByte; const Size: Integer): PBigInt;
+var
+  I: Integer;
+  J: Integer;
+  Offset: Integer;
+begin
+  J := 0;
+  Offset := 0;
+  Result := BIAllocate(Context, (Size+BIGINT_COMP_BYTE_SIZE-1) div BIGINT_COMP_BYTE_SIZE);
+  FillChar(Result^.Components^, Result^.Size*BIGINT_COMP_BYTE_SIZE, 0);
+  for I := Size-1 downto 0 do
+  begin
+    PBIComponents(Result^.Components)^[Offset] := PBIComponents(Result^.Components)^[Offset] + (PByteArray(Data)^[I] shl (J * 8));
+    Inc(J);
+    if J = BIGINT_COMP_BYTE_SIZE then
+    begin
+      J := 0;
+      Inc(Offset);
+    end;
+  end;
+end;
+
+function BIImport(var Context: TBigIntContext; const Data: TBytes): PBigInt;
+begin
+  Result := BIImport(Context, PByte(Data), Length(Data));
+end;
+
+function BIImport(var Context: TBigIntContext; const Data: AnsiString): PBigInt; overload;
+
+begin
+  Result:=BIImport(Context,TEncoding.UTF8.GetAnsiBytes(Data));
+end;
+
+
+// Convert an (unsigned) integer into a bigint
+// I: The (unsigned) integer to be converted
+function IntToBI(var Context: TBigIntContext; I: TBIComponent): PBigInt;
+begin
+  Result := BIAllocate(Context,1);
+  PBIComponents(Result^.Components)^[0] := I;
+end;
+
+function BIAdd(var Context: TBigIntContext; BIA, BIB: PBigInt): PBigInt;
+var
+  N: Integer;
+  PA: PBIComponent;
+  PB: PBIComponent;
+  Carry: TBIComponent;
+  SL: TBIComponent;
+  RL: TBIComponent;
+  CY1: TBIComponent;
+begin
+  Carry := 0;
+  if not BICheck(BIA^) or not BICheck(BIB^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  N := Max(BIA^.Size, BIB^.Size);
+  BIAddComponents(Context, BIA, N+1);
+  BIAddComponents(Context, BIB, N);
+  PA := BIA^.Components;
+  PB := BIB^.Components;
+  repeat
+    SL := PA^ + PB^;
+    Inc(PB);
+    RL := SL + Carry;
+    if SL < PA^ then
+      CY1 := 1
+    else
+      CY1 := 0;
+    if RL < SL then
+      Carry := CY1 or 1
+    else
+      Carry := CY1 or 0;
+    PA^ := RL;
+    Inc(PA);
+    Dec(N);
+  until N = 0;
+  PA^ := Carry; // Do overflow
+  BIRelease(Context, BIB);
+  BITrim(BIA);
+  Result := BIA;
+end;
+
+// @IsNegative: Indicates that the result was negative
+// Return: The result of the subtraction. The result is always positive
+function BISubtract(var Context: TBigIntContext; BIA, BIB: PBigInt; out IsNegative: Boolean): PBigInt;
+var
+  Carry: TBIComponent;
+  CY1: TBIComponent;
+  N: Integer;
+  PA: PBIComponent;
+  PB: PBIComponent;
+  SL: TBIComponent;
+  RL: TBIComponent;
+begin
+  Carry := 0;
+  if not BICheck(BIA^) or not BICheck(BIB^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  N := BIA^.Size;
+  BIAddComponents(Context, BIB, N);
+  PA := BIA^.Components;
+  PB := BIB^.Components;
+  repeat
+    SL := PA^-PB^;
+    Inc(PB);
+    RL := SL-Carry;
+    if SL > PA^ then
+      CY1 := 1
+    else
+      CY1 :=0 ;
+    if RL > SL then
+      Carry := CY1 or 1
+    else
+      Carry:=CY1 or 0;
+    PA^ := RL;
+    Inc(PA);
+    Dec(N);
+  until N = 0;
+  IsNegative := Carry <> 0;
+  BITrim(BIB); // Put BIB back to the way it was
+  BIRelease(Context, BIB);
+  BITrim(BIA);
+  Result := BIA;
+end;
+
+// Does both division and modulo calculations
+// @U: A bigint which is the numerator
+// @V: Either the denominator or the modulus depending on the mode
+// @IsMod: Determines if this is a normal division (False) or a reduction (True)}
+function BIDivide(var Context: TBigIntContext; U, V: PBigInt; IsMod: Boolean): PBigInt;
+
+  function BIDivide_V1(V:PBigInt):TBIComponent; inline;
+  begin // V1 for division
+    Result := PBIComponents(V^.Components)^[V^.Size-1];
+  end;
+
+  function BIDivide_V2(V: PBigInt): TBIComponent; inline;
+  begin  // V2 for division
+    Result := PBIComponents(V^.Components)^[V^.Size-2];
+  end;
+
+  function BIDivide_U(TmpU: PBigInt; J: Integer): TBIComponent; inline;
+  begin // U(J) for division
+    Result := PBIComponents(TmpU^.Components)^[TmpU^.Size-J-1];
+  end;
+
+var
+  D, Inner: TBIComponent;
+  IsNegative: Boolean;
+  J, M, N: Integer;
+  ModOffset: Byte;
+  OrigUSize: Integer;
+  QDash: TBIComponent;
+  Quotient, TmpU: PBigInt;
+begin
+  N := V^.Size;
+  M := U^.Size - N;
+  J := 0;
+  OrigUSize := U^.Size;
+  ModOffset := Context.ModOffset;
+  if not BICheck(U^) or not BICheck(V^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  // If doing reduction and we are < mod, then return mod
+  if IsMod and (BICompare(V, U) > 0) then
+  begin
+    BIRelease(Context, V);
+    Result := U;
+    Exit;
+  end;
+  Quotient := BIAllocate(Context, M+1);
+  TmpU := BIAllocate(Context, N+1);
+  BITrim(V); // Make sure we have no leading 0's
+  D := BIGINT_COMP_RADIX div (TBILongComponent(BIDivide_V1(V)) + 1);
+  FillChar(Quotient^.Components^, Quotient^.Size * BIGINT_COMP_BYTE_SIZE, 0);
+  if D > 1 then
+  begin // Normalize
+    U := BIIntMultiply(Context,U,D);
+    if IsMod then
+      V := Context.BINormalisedMod[ModOffset]
+    else
+      V:=BIIntMultiply(Context,V,D);
+  end;
+  if OrigUSize = U^.Size then
+    BIAddComponents(Context, U, OrigUSize+1); // New digit position u0
+  repeat
+    // Get a temporary short version of u
+    System.Move(PBIComponents(U^.Components)^[U^.Size-N-1-J], TmpU^.Components^, (N+1) * BIGINT_COMP_BYTE_SIZE);
+    // Calculate q'
+    if BIDivide_U(TmpU, 0) = BIDivide_V1(V) then
+    begin
+      QDash := BIGINT_COMP_RADIX-1;
+    end else
+    begin
+      QDash := (TBILongComponent(BIDivide_U(TmpU, 0)) * BIGINT_COMP_RADIX + BIDivide_U(TmpU, 1)) div BIDivide_V1(V);
+      if (V^.Size > 1) and (BIDivide_V2(V) > 0) then
+      begin
+        // We are implementing the following: if (V2*q_dash > (((U(0)*COMP_RADIX + U(1) - q_dash*V1)*COMP_RADIX) + U(2))) ...
+        Inner := BIGINT_COMP_RADIX * BIDivide_U(TmpU, 0) + BIDivide_U(TmpU, 1) - TBILongComponent(QDash) * BIDivide_V1(V); {Avoid overflow}
+        if (TBILongComponent(BIDivide_V2(V)) * QDash) > (TBILongComponent(Inner) * BIGINT_COMP_RADIX + BIDivide_U(TmpU, 2)) then {Avoid overflow}
+          Dec(QDash);
+      end;
+    end;
+    if QDash > 0 then
+    begin // Multiply and subtract
+      TmpU := BISubtract(Context, TmpU, BIIntMultiply(Context, BICopy(V), QDash), IsNegative);
+      BIAddComponents(Context, TmpU, N+1);
+      PBIComponents(Quotient^.Components)^[Quotient^.Size-J-1] := QDash;
+      if IsNegative then
+      begin // Add back
+        Dec(PBIComponents(Quotient^.Components)^[Quotient^.Size-J-1]);
+        TmpU := BIAdd(Context, TmpU, BICopy(V));
+        // Lop off the carry
+        Dec(TmpU^.Size);
+        Dec(V^.Size);
+      end;
+    end else
+    begin
+      PBIComponents(Quotient^.Components)^[Quotient^.Size-J-1] := 0;
+    end;
+    // Copy back to U
+    System.Move(TmpU^.Components^, PBIComponents(U^.Components)^[U^.Size-N-1-J], (N+1) * BIGINT_COMP_BYTE_SIZE);
+    Inc(J);
+  until J > M;
+  BIRelease(Context, TmpU);
+  BIRelease(Context, V);
+  if IsMod then
+  begin // Get the remainder
+    BIRelease(Context, Quotient);;
+    BITrim(U);
+    Result := BIIntDivide(Context, U, D);
+  end else
+  begin // Get the quotient
+    BIRelease(Context, U);
+    BITrim(Quotient);
+    Result := Quotient;
+  end
+end;
+
+function BIMultiply(var Context: TBigIntContext; BIA, BIB: PBigInt): PBigInt;
+begin
+  if not BICheck(BIA^) or not BICheck(BIB^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  Result := BIRegularMultiply(Context, BIA, BIB, 0, 0);
+end;
+
+// Perform a modular exponentiation.
+// it requires BISetMod() to have been called previously
+// This is one of the optimisations used for performance
+// @BI: The bigint on which to perform the mod power operation
+function BIModPower(var Context: TBigIntContext; BI, BIExp: PBigInt): PBigInt;
+var
+  BIR: PBigInt;
+  I, J, L: Int32;
+  PartExp: Int32;
+  WindowSize: Integer;
+begin
+  I := BIFindMaxExponentIndex(BIExp);
+  BIR := IntToBI(Context, 1);
+  WindowSize := 1;
+  if not BICheck(BI^) or not BICheck(BIExp^) then
+  begin
+    Result:=nil;
+    Exit;
+  end;
+  // Work out an optimum size
+  J := I;
+  while J > 32 do
+  begin
+    Inc(WindowSize);
+    J := J div 5;
+  end;
+  BIPrecomputeSlideWindow(Context, WindowSize, BI); // Work out the sliding window constants
+  repeat // If sliding-window is off, then only one bit will be done at a time and will reduce to standard left-to-right exponentiation
+    if BIExpBitIsOne(BIExp,I) then
+    begin
+      L := I-WindowSize+1;
+      PartExp := 0;
+      if L < 0 then // LSB of exponent will always be 1
+      begin
+        L := 0;
+      end else
+      begin
+        while not BIExpBitIsOne(BIExp,L) do
+          Inc(L); // Go back up
+      end;
+      // Build up the section of the exponent
+      J := I;
+      while J >= L do
+      begin
+        BIR := BIResidue(Context, BISquare(Context,BIR));
+        if BIExpBitIsOne(BIExp, J) then
+          Inc(PartExp);
+        if J <> L then
+          PartExp := PartExp shl 1;
+        Dec(J);
+      end;
+      PartExp := (PartExp-1) div 2; // Adjust for array
+      BIR := BIResidue(Context, BIMultiply(Context, BIR, PBigInts(Context.G)^[PartExp]));
+      I := L-1;
+    end else
+    begin // Square it
+      BIR := BIResidue(Context, BISquare(Context, BIR));
+      Dec(I);
+    end;
+  until I < 0;
+  for I := 0 to Context.Window-1 do
+  begin // Cleanup
+    BIDepermanent(PBigInts(Context.G)^[I]);
+    BIRelease(Context, PBigInts(Context.G)^[I]);
+  end;
+  BIRelease(Context, BI);
+  BIRelease(Context, BIExp);
+  Result := BIR;
+end;
+
+(*
+// Perform a modular exponentiation using a temporary modulus.
+// Useful to check the signatures of certificates. The modulus of this function is temporary as it's just used for authentication
+// @BI: The bigint to perform the exp/mod
+// @BIM: The temporary modulus
+function BIModPower2(var Context: TBigIntContext; BI, BIM, BIExp: PBigInt): PBigInt;
+var
+  BIR: PBigInt;
+  TmpBIR: PBigInt;
+  TmpContext: TBigIntContext;
+begin
+  // Set up a temporary bigint context and transfer what we need between them.
+  // We need to do this since we want to keep the original modulus which is already in this context.
+  // This operation is only called when doing peer verification, and so is not expensive
+  BIInitialize(TmpContext, CurrentScratch);
+  BISetMod(TmpContext, BIClone(TmpContext, BIM^), BIGINT_M_OFFSET);
+  TmpBIR := BIModPower(TmpContext, BIClone(TmpContext, BI^), BIClone(TmpContext, BIExp^));
+  BIR := BIClone(Context, TmpBIR^);
+  BIRelease(TmpContext, TmpBIR);
+  BIFreeMod(TmpContext, BIGINT_M_OFFSET);
+  BITerminate(TmpContext);
+  BIRelease(Context, BI);
+  BIRelease(Context, BIM);
+  BIRelease(Context, BIExp);
+  Result := BIR;
+end;
+*)
+
+function BICompare(BIA, BIB: PBigInt): Integer;
+var
+  A, B: PBIComponent;
+  I: Integer;
+begin
+  if not BICheck(BIA^) or not BICheck(BIB^) then
+  begin
+    Result := 0;
+    Exit;
+  end;
+  if BIA^.Size > BIB^.Size then
+  begin
+    Result := 1;
+    Exit;
+  end;
+  if BIA^.Size < BIB^.Size then
+  begin
+    Result := -1;
+    Exit;
+  end;
+  A := BIA^.Components;
+  B := BIB^.Components;
+  // Same number of components. Compare starting from the high end and working down
+  Result := 0;
+  I := BIA^.Size-1;
+  repeat
+    if PBIComponents(A)^[I] > PBIComponents(B)^[I] then
+    begin
+      Result := 1;
+      Exit;
+    end;
+    if PBIComponents(A)^[I] < PBIComponents(B)^[I] then
+    begin
+      Result := -1;
+      Exit;
+    end;
+    Dec(I);
+  until I < 0;
+end;
+
+// Pre-compute some of the expensive steps in reduction
+// This function should only be called once (normally when a session starts).
+// When the session is over, BIFreeMod() should be called. BIModPower() and BIMod() rely on this function being called
+// BIM: The bigint modulus that will be used
+// ModOffset: There are three moduluii that can be stored - the  standard modulus, and its two primes p and q. This offset refers to which modulus we are referring to
+procedure BISetMod(var Context: TBigIntContext; BIM: PBigInt; ModOffset: Integer);
+var
+  D: TBIComponent;
+  K: Integer;
+begin
+  K := BIM^.Size;
+  D := BIGINT_COMP_RADIX div (TBILongComponent(PBIComponents(BIM^.Components)^[K-1]) + 1);
+  Context.BIMod[ModOffset] := BIM;
+  BIPermanent(Context.BIMod[ModOffset]);
+  Context.BINormalisedMod[ModOffset] := BIIntMultiply(Context, BIM, D);
+  BIPermanent(Context.BINormalisedMod[ModOffset]);
+  Context.BImu[ModOffset] := BIDivide(Context, BICompLeftShift(Context, BIClone(Context, Context.BIRadix^), K*2-1), Context.BIMod[ModOffset], False);
+  BIPermanent(Context.BImu[ModOffset]);
+  Context.BIbk1[ModOffset] := BICompLeftShift(Context, IntToBI(Context,1), K+1);
+  BIPermanent(Context.BIbk1[ModOffset]);
+end;
+
+// Used when cleaning various bigints at the end of a session
+procedure BIFreeMod(var Context: TBigIntContext; ModOffset: Integer);
+begin
+  BIDepermanent(Context.BIMod[ModOffset]);
+  BIRelease(Context, Context.BIMod[ModOffset]);
+  BIDepermanent(Context.BImu[ModOffset]);
+  BIRelease(Context, Context.BImu[ModOffset]);
+  BIDepermanent(Context.BIbk1[ModOffset]);
+  BIRelease(Context, Context.BIbk1[ModOffset]);
+  BIDepermanent(Context.BINormalisedMod[ModOffset]);
+  BIRelease(Context, Context.BINormalisedMod[ModOffset]);
+end;
+
+// Find the residue of BI. BISetMod() must be called beforehand
+function BIMod(var Context: TBigIntContext; BI: PBigInt): PBigInt; inline;
+begin
+  Result := BIDivide(Context, BI, Context.BIMod[Context.ModOffset], True);
+end;
+
+// BIResidue is simply an alias for BIBarrett
+function BIResidue(var Context: TBigIntContext; BI: PBigInt): PBigInt; inline;
+begin
+  Result := BIBarrett(Context, BI);
+end;
+
+// Perform a single Barrett reduction
+function BIBarrett(var Context: TBigIntContext; BI: PBigInt): PBigInt;
+var
+  Q1:PBigInt;
+  Q2:PBigInt;
+  Q3:PBigInt;
+  R1:PBigInt;
+  R2:PBigInt;
+  R:PBigInt;
+  ModOffset:Byte;
+  BIM:PBigInt;
+  K:Integer;
+  IsNegative:Boolean;
+begin
+  ModOffset := Context.ModOffset;
+  BIM := Context.BIMod[ModOffset];
+  K := BIM^.Size;
+  if not BICheck(BI^) or not BICheck(BIM^) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+  if BI^.Size > K*2 then
+  begin // Use Classical method instead  - Barrett cannot help here
+    Result := BIMod(Context,BI);
+    Exit;
+  end;
+  // q1 = [x / b**(k-1)]
+  Q1 := BICompRightshift(BIClone(Context,BI^), K-1);
+  // Do outer partial multiply
+  // q2 = q1 * mu
+  Q2 := BIRegularMultiply(Context, Q1, Context.BImu[ModOffset], 0, K-1);
+  // q3 = [q2 / b**(k+1)]
+  Q3 := BICompRightShift(Q2, K+1);
+  // r1 = x mod b**(k+1)
+  R1 := BICompMod(BI, K+1);
+  // Do inner partial multiply
+  // r2 = q3 * m mod b**(k+1)
+  R2 := BICompMod(BIRegularMultiply(Context, Q3, BIM, K+1, 0), K+1);
+  // if (r1 < r2) r1 = r1 + b**(k+1)
+  if BICompare(R1,R2) < 0 then
+    R1 := BIAdd(Context,R1,Context.BIbk1[ModOffset]);
+  // r = r1-r2
+  R := BISubtract(Context,R1,R2,IsNegative);
+  // while (r >= m) do r = r-m
+  while BICompare(R,BIM) >= 0 do
+    R := BISubtract(Context,R,BIM,IsNegative);
+  Result:=R;
+end;
+
+// Perform a square operation on a bigint
+function BISquare(var Context: TBigIntContext; BI: PBigInt): PBigInt;
+begin
+  {$IFDEF BIGINT_SQUARE}
+    if not BICheck(BI^) then
+    begin
+      Result := nil;
+      Exit;
+    end;
+    Result := BIRegularSquare(Context, BI);
+  {$ELSE}
+    Result := BIMultiply(Context, BICopy(BI), BI)
+  {$ENDIF}
+end;
+
+// Chinese Remainder Theorem to quickly perform RSA decrypts
+// @BI: The bigint to perform the exp/mod
+// @DP: CRT's dP bigint, @Q: CRT's dQ bigint, @: CRT's p bigint, @: CRT's q bigint, @Inv: CRT's qInv bigint
+function BICRT(var Context: TBigIntContext; BI, DP, DQ, P, Q, QInv: PBigInt): PBigInt;
+var
+  H, M1, M2: PBigInt;
+  IsNegative: Boolean;
+begin
+  Context.ModOffset := BIGINT_P_OFFSET;
+  M1 := BIModPower(Context, BICopy(BI), DP);
+  Context.ModOffset := BIGINT_Q_OFFSET;
+  M2 := BIModPower(Context, BI, DQ);
+  H := BISubtract(Context, BIAdd(Context, M1, P), BICopy(M2), IsNegative);
+  H := BIMultiply(Context, H, QInv);
+  Context.ModOffset := BIGINT_P_OFFSET;
+  H := BIResidue(Context, H);
+  Result := BIAdd(Context, M2, BIMultiply(Context, Q, H));
+end;
+
+// Convert a bigint to a string of hex characters
+// @Result[BI.Size*2]
+procedure BItoString(BI: PBigInt; out S: AnsiString);
+const
+  Digits: Array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
+var
+  I,J,K: Integer;
+  Num: TBIComponent;
+  Mask: TBIComponent;
+begin
+  S:='';
+  if BI = nil then
+    Exit;
+  SetLength(S,BI^.Size*BIGINT_COMP_NUM_NIBBLES);
+  K:=1;
+  for I := BI^.Size-1 downto 0 do
+  begin
+    for J := BIGINT_COMP_NUM_NIBBLES-1 downto 0 do
+    begin
+      Mask := $0F shl (J*4);
+      Num := (PBIComponents(BI^.Components)^[I] and Mask) shr (J*4);
+      S[K]:=Digits[Num and $F];
+      inc(K);
+    end;
+  end;
+end;
+
+// Convert a string of hex characters to a bigint
+function StringToBI(var Context: TBigIntContext; const Value: AnsiString): PBigInt;
+const
+  Convert: array[Ord('0')..Ord('f')] of SmallInt =
+    ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
+     -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+     -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+     -1,10,11,12,13,14,15);
+var
+  Num: Byte;
+  I, J, Offset, Size: Integer;
+  BIR: PBigInt;
+begin
+  J := 0;
+  Offset := 0;
+  Size := Value.Length;
+  BIR := BIAllocate(Context, (Size+BIGINT_COMP_NUM_NIBBLES-1) div BIGINT_COMP_NUM_NIBBLES);
+  FillChar(BIR^.Components^, BIR^.Size*BIGINT_COMP_BYTE_SIZE, 0);
+  for I := Size downto 1 do
+  begin
+    Num := Byte(Convert[Ord(Value[I])]);
+    if Num = 255 then
+    begin
+      Result := nil;
+      Exit;
+    end;
+    PBIComponents(BIR^.Components)^[Offset] := PBIComponents(BIR^.Components)^[Offset] + LongWord(Num shl (J * 4));
+    Inc(J);
+    if J = BIGINT_COMP_NUM_NIBBLES then
+    begin
+      J := 0;
+      Inc(Offset);
+    end;
+  end;
+  Result := BIR;
+end;
+
+initialization
+
+finalization
+
+end.
+