{ *******************************************************

  VLI - Very long integers

  Copyright (c) 2011 Ing.-Buero Lang

  Date: 15.02.2011

  under usage of algorithms from
  Prof. Harlay Flanders, University of Michigan
  and Florian Rienhardt

  ******************************************************* }

unit VLI;

{$IFOPT Q+}
{$DEFINE OverflowCheckOn}
{$ENDIF}

interface

uses
  SysUtils, Math;

resourcestring
  sCantAssignNil = 'Can''t assign nil';
  sDivideBy0 = 'Divide by 0';
  sWrongCharInHexNum = 'Wrong character in Hex number';

const
  Base = $100000000;
  BaseMinusOne = Base - 1;
  BaseLen = 8;
  DecBase: Cardinal = 1000000000;
  DecBaseLen = 9;

type
  // Dynamic array to hold as many as needed cardinals (< Base)
  TIntAr = array of Cardinal;

  TVLI = class(TObject)
  private
    // FIntAr represents the very long integer
    // FIntAr[0] + FIntAr[1] * Base + FIntAr[2] * Base^2 + ..
    FVLIAr: TIntAr;
    // FMinus holds the (negative) sign
    FMinus: Boolean;
    function GetAsFloat: Extended;
    function GetAsHex: AnsiString;
    function GetAsInt64: Int64;
    function GetAsInteger: Integer;
    function GetAsString: AnsiString;
    function GetIsZero: Boolean;
    function GetLenVLI: Integer;
    procedure Adjust;
    procedure Clean;
    procedure ComplementOnTwo;
    procedure Divide(const Value: Cardinal; out Remainder: Cardinal); overload;
    procedure Multiply(const Value: Cardinal); overload;
    procedure SetAsFloat(Value: Extended);
    procedure SetAsHex(Value: AnsiString);
    procedure SetAsInt64(const Value: Int64);
    procedure SetAsInteger(const Value: Integer);
    procedure SetAsString(Value: AnsiString);
    procedure SetLenVLI(const Value: Integer);
    property LenVLI: Integer read GetLenVLI write SetLenVLI;
  public
    constructor Create; overload;
    constructor Create(const Value: AnsiString); overload;
    constructor Create(const Value: Int64); overload;
    constructor Create(const Value: Integer); overload;
    destructor Destroy; override;

    procedure Abs;

    procedure Add(const Value: Int64); overload;
    procedure Add(const Value: Integer); overload;
    procedure Add(const X, Y: TVLI); overload;
    procedure Add(const Y: TVLI); overload;

    procedure Assign(Source: TVLI);
    procedure Clear;

    function Compare(const X: TVLI): Integer; overload;

    function CompareAbs(const X: TVLI): Integer; overload;

    procedure Dec;

    procedure Divide(const Value: Int64; out Remainder: Int64); overload;
    procedure Divide(const Value: Integer; out Remainder: Integer); overload;
    procedure Divide(const X, Y: TVLI; out Remainder: TVLI); overload;
    procedure Divide(const Y: TVLI; out Remainder: TVLI); overload;

    function Equal(const X: TVLI): Boolean; overload;

    procedure GCD(const X, Y: TVLI); overload;
    procedure GCD(const Y: TVLI); overload;

    procedure Inc;

    procedure Multiply(const Value: Int64); overload;
    procedure Multiply(const Value: Integer); overload;
    procedure Multiply(const X, Y: TVLI); overload;
    procedure Multiply(const Y: TVLI); overload;

    procedure Negate;

    function Odd: Boolean;

    procedure Power(const Exponent: Cardinal); overload;
    procedure Power(const X: TVLI; Exponent: Cardinal); overload;

    procedure ShiftLeft(const N: Cardinal); overload;
    procedure ShiftLeft(const X: TVLI; N: Cardinal); overload;

    procedure ShiftRight(const N: Integer); overload;
    procedure ShiftRight(const X: TVLI; N: Integer); overload;

    function Sign: Integer;

    procedure Sqr(const X: TVLI); overload;
    procedure Sqr; overload;

    procedure Subtract(const Value: Int64); overload;
    procedure Subtract(const Value: Integer); overload;
    procedure Subtract(const X, Y: TVLI); overload;
    procedure Subtract(const Y: TVLI); overload;

    property AsFloat: Extended read GetAsFloat write SetAsFloat;
    property AsHex: AnsiString read GetAsHex write SetAsHex;
    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
    property AsString: AnsiString read GetAsString write SetAsString;
    property IsZero: Boolean read GetIsZero;
  end;

  EAssignError = class(Exception);

implementation

function PadL(S: AnsiString; C: Char; L: Integer): AnsiString;
var
  tmp: AnsiString;
begin
  Result := S;
  if Length(S) < L then
  begin
    SetLength(tmp, L - Length(S));
    FillChar(tmp[1], L - Length(S), C);
    Result := tmp + Result;
  end;
end;

{ TVLI }

constructor TVLI.Create;
begin
  inherited;
  Clear;
  FMinus := False;
end;

constructor TVLI.Create(const Value: AnsiString);
begin
  inherited Create;
  AsString := Value;
end;

constructor TVLI.Create(const Value: Int64);
begin
  inherited Create;
  AsInt64 := Value;
end;

constructor TVLI.Create(const Value: Integer);
begin
  inherited Create;
  AsInteger := Value;
end;

destructor TVLI.Destroy;
begin
  LenVLI := 0;
  inherited;
end;

procedure TVLI.Abs;
begin
  FMinus := False;
end;

// add an Int64 to the VLI

procedure TVLI.Add(const Value: Int64);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create(Value);
  try
    Add(Temp);
  finally
    Temp.Free;
  end;
end;

// add an Integer to the VLI

procedure TVLI.Add(const Value: Integer);
begin
  Add(Int64(Value));
end;

// set the VLI to the sum of X and Y
// algorithm from Florian Rienhardt

procedure TVLI.Add(const X, Y: TVLI);
var
  NewLen: Integer;
  I: Integer;
  Aux, CY: UInt64;
  TempX, TempY: TVLI;
begin
  // possibly X = Self or Y = Self and/or X = Y
  TempX := TVLI.Create;
  TempY := TVLI.Create;
  try
    TempX.Assign(X);
    TempY.Assign(Y);
    // the result is maximal 1 digit longer as the longest summand
    NewLen := Max(TempX.LenVLI, TempY.LenVLI) + 1;
    // set all VLIs to the new length
    TempX.LenVLI := NewLen;
    TempY.LenVLI := NewLen;
    LenVLI := NewLen;
    Clean;
    // perform a complement on two in case the vli is negative
    TempX.ComplementOnTwo;
    TempY.ComplementOnTwo;
    CY := 0;
    // add up the parts with carry
    for I := 0 to NewLen - 1 do
    begin
      Aux := UInt64(TempX.FVLIAr[I]) + TempY.FVLIAr[I] + CY;
      FVLIAr[I] := Aux and BaseMinusOne;
      CY := Aux shr 32;
    end;

    // get the sign
    FMinus := FVLIAr[LenVLI - 1] and $80000000 = $80000000;
    ComplementOnTwo;
    Adjust;
  finally
    TempY.Free;
    TempX.Free;
  end;
end;

// add Y to the VLI

procedure TVLI.Add(const Y: TVLI);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.Add(Self, Y);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

// remove leading zero digits

procedure TVLI.Adjust;
var
  I: Integer;
  NewLen: Integer;
begin
  NewLen := 1;
  for I := LenVLI - 1 downto 0 do
  begin
    if FVLIAr[I] <> 0 then
    begin
      NewLen := I + 1;
      Break;
    end;
  end;
  LenVLI := NewLen;
end;

// assign Source to the VLI

procedure TVLI.Assign(Source: TVLI);
var
  I: Integer;
begin
  if Source <> Self then
  begin
    if Source <> nil then
    begin
      FMinus := (Source as TVLI).FMinus;
      LenVLI := (Source as TVLI).LenVLI;
      for I := 0 to LenVLI - 1 do
        FVLIAr[I] := (Source as TVLI).FVLIAr[I];
    end
    else
      raise EAssignError.Create(sCantAssignNil);
  end;
end;

// set all digits to 0

procedure TVLI.Clean;
var
  I: Integer;
begin
  for I := 0 to LenVLI - 1 do
    FVLIAr[I] := 0;
end;

// set the VLI to 0

procedure TVLI.Clear;
begin
  FMinus := False;
  LenVLI := 1;
  FVLIAr[0] := 0;
end;

// compare the VLI against X
// -1 less
// 0  equal
// 1  greater

function TVLI.Compare(const X: TVLI): Integer;
var
  I: Integer;
begin
  if FMinus xor X.FMinus then
  begin
    // different signs
    if FMinus then
      Result := -1
    else
      Result := 1;
  end
  else
  begin
    // equal signs
    Adjust;
    X.Adjust;
    // compare the length
    Result := Math.Sign(LenVLI - X.LenVLI);
    // in case of equal length compare the array members
    if Result = 0 then
    begin
      for I := LenVLI - 1 downto 0 do
      begin
        Result := Math.Sign(Int64(FVLIAr[I]) - X.FVLIAr[I]);
        if Result <> 0 then
          Break;
      end;
    end;

    // equal signs but minus
    if FMinus then
    begin
      Result := Result * -1;
    end;
  end;
end;

// compare |VLI| with |X|

function TVLI.CompareAbs(const X: TVLI): Integer;
var
  OldMinus: Boolean;
  OldRightMinus: Boolean;
begin
  OldMinus := FMinus;
  OldRightMinus := X.FMinus;
  try
    FMinus := False;
    X.FMinus := False;
    Result := Compare(X);
  finally
    // don't forget
    FMinus := OldMinus;
    X.FMinus := OldRightMinus;
  end;
end;

// if negative, perform a complement on two

procedure TVLI.ComplementOnTwo;
var
  Aux: Int64;
  C: Cardinal;
  I: Integer;
begin
  if FMinus then
  begin
    C := 1;
    for I := 0 to LenVLI - 1 do
    begin
      Aux := Int64(not(FVLIAr[I])) + C;
      FVLIAr[I] := Aux and BaseMinusOne;
      C := Aux shr 32;
    end;
  end;
end;

procedure TVLI.Dec;
begin
  Subtract(1);
end;

// internally used

procedure TVLI.Divide(const Value: Cardinal; out Remainder: Cardinal);
var
  I: Integer;
  Aux: UInt64;
begin
  Remainder := 0;

  for I := LenVLI - 1 downto 0 do
  begin
    Aux := UInt64(Remainder) shl 32 + FVLIAr[I];
    FVLIAr[I] := Aux div Value;
    Remainder := Aux mod Value;
  end;
  Adjust;
end;

// divide the VLI by an Int64

procedure TVLI.Divide(const Value: Int64; out Remainder: Int64);
var
  Temp, Rem: TVLI;
begin
  Temp := TVLI.Create(Value);
  Rem := TVLI.Create;
  try
    Divide(Temp, Rem);
    Remainder := Rem.AsInt64;
  finally
    Rem.Free;
    Temp.Free;
  end;
end;

// divide the VLI by an Integer

procedure TVLI.Divide(const Value: Integer; out Remainder: Integer);
var
  Rem: Int64;
begin
  Divide(Value, Rem);
  Remainder := Rem;
end;

// set the VLI to the quotient of X by Y
// algorithm from Prof. Harlay Flanders, University of Michigan

procedure TVLI.Divide(const X, Y: TVLI; out Remainder: TVLI);
var
  LeftMinus, RightMinus: Boolean;
  TempX, TempY: TVLI;

  procedure UnsignedDivide;
  var
    ScaledR: TVLI;
    ScaledB2ndCoeff, ScaledBHighCoeff, TrialQuotient: UInt64;
    Scaler: Cardinal;
    Shift, Deg: Integer;

    procedure Normalize;
    begin
      Scaler := Base div (UInt64(TempY.FVLIAr[TempY.LenVLI - 1]) + 1);
      Remainder.Assign(TempX);
      if Scaler > 1 then
      begin
        Remainder.Multiply(Scaler);
        ScaledR.Multiply(Scaler);
      end;
      Remainder.LenVLI := TempX.LenVLI + 1;

      ScaledBHighCoeff := ScaledR.FVLIAr[ScaledR.LenVLI - 1];
      if ScaledR.LenVLI > 1 then
        ScaledB2ndCoeff := ScaledR.FVLIAr[ScaledR.LenVLI - 2]
      else
        ScaledB2ndCoeff := 0;
    end;

    procedure FindTrialQuotient;
    var
      TrialDividend, TrialRemainder, T0, T1: UInt64;
      OverFlow: Boolean;

      function AddUint64(A, B: UInt64): UInt64;
      var
        Aux: UInt64;
      begin
        Result := (A and BaseMinusOne) + (B and BaseMinusOne);
        Aux := (A shr 32) + (B shr 32);
        Result := (Aux and BaseMinusOne) shl 32 + Result;
        OverFlow := Aux >= Base;
      end;

    begin
      TrialDividend := UInt64(Remainder.FVLIAr[Deg + 1]) shl 32 +
        Remainder.FVLIAr[Deg];
      TrialQuotient := TrialDividend div ScaledBHighCoeff;
      if TrialQuotient >= Base then
        TrialQuotient := BaseMinusOne;

      if Deg > 0 then
      begin
        TrialRemainder := TrialDividend - TrialQuotient * ScaledBHighCoeff;
        T0 := ScaledB2ndCoeff * TrialQuotient;
        // consider overflow
        if TrialRemainder < Base then
        begin
          T1 := TrialRemainder shl 32 + Remainder.FVLIAr[Deg - 1];
          OverFlow := False;
          while (T0 > T1) and not OverFlow do
          begin
            if TrialQuotient > 0 then
            begin
              System.Dec(TrialQuotient);
              if T0 >= ScaledB2ndCoeff then
              begin
                T0 := T0 - ScaledB2ndCoeff;
                T1 := AddUint64(T1, ScaledBHighCoeff shl 32);
              end
              else
                OverFlow := True;
            end
            else
              OverFlow := True;
          end;
        end;
      end;
    end;

    procedure FindQuotient;
    var
      Sum, Product, Difference, Borrow, AddCarry, MultCarry: UInt64;
      BsIndex, ShiftIndex: Cardinal;
    begin
      MultCarry := 0;
      Borrow := Base;
      ShiftIndex := Shift;
      for BsIndex := 0 to ScaledR.LenVLI - 1 do
      begin
        Product := UInt64(ScaledR.FVLIAr[BsIndex]) * TrialQuotient + MultCarry;
        MultCarry := Product shr 32;
        Difference := (UInt64(Remainder.FVLIAr[ShiftIndex]) + Borrow) -
          (Product - Product and (UInt64(BaseMinusOne) shl 32));
        if Difference >= Base then
        begin
          Remainder.FVLIAr[ShiftIndex] := Difference - Base;
          Borrow := Base;
        end
        else
        begin
          Remainder.FVLIAr[ShiftIndex] := Difference;
          Borrow := BaseMinusOne;
        end;
        System.Inc(ShiftIndex);
      end;

      Difference := Remainder.FVLIAr[ShiftIndex] - MultCarry;
      if Difference >= (Base - Borrow) then
      begin
        FVLIAr[Shift] := TrialQuotient;
      end
      else
      begin
        FVLIAr[Shift] := TrialQuotient - 1;
        AddCarry := 0;
        ShiftIndex := Shift;
        for BsIndex := 0 to ScaledR.LenVLI - 1 do
        begin
          Sum := UInt64(Remainder.FVLIAr[ShiftIndex]) + ScaledR.FVLIAr[BsIndex]
            + AddCarry;
          if Sum >= Base then
          begin
            Remainder.FVLIAr[ShiftIndex] := Sum - Base;
            AddCarry := 1;
          end
          else
          begin
            Remainder.FVLIAr[ShiftIndex] := Sum;
            AddCarry := 0;
          end;
          System.Inc(ShiftIndex);
        end;
      end;
      Remainder.FVLIAr[ShiftIndex] := 0;
    end;

    procedure DeNormalize;
    var
      R: Cardinal;
    begin
      Remainder.Divide(Scaler, R);
    end;

  begin
    ScaledR := TVLI.Create;
    try
      TempY.Adjust;
      ScaledR.Assign(TempY);
      Normalize;
      ScaledR.Adjust;
      Shift := TempX.LenVLI - ScaledR.LenVLI;
      for Deg := TempX.LenVLI - 1 downto ScaledR.LenVLI - 1 do
      begin
        FindTrialQuotient;
        FindQuotient;
        System.Dec(Shift);
      end;
      DeNormalize;
    finally
      ScaledR.Free;
    end;
  end;

begin
  if X.IsZero then
  begin
    Clear;
    Remainder.Clear;
    Exit;
  end;

  if Y.IsZero then
  begin
    raise EDivByZero.Create(sDivideBy0);
  end;

  case X.CompareAbs(Y) of
    - 1:
      begin
        Clear;
        Remainder.Assign(X);
        Exit;
      end;
    0:
      begin
        AsInteger := 1;
        FMinus := X.FMinus xor Y.FMinus;
        Remainder.Clear;
        Exit;
      end;
  end;

  TempX := TVLI.Create;
  TempY := TVLI.Create;
  try
    TempX.Assign(X);
    TempY.Assign(Y);
    LenVLI := TempX.LenVLI - TempY.LenVLI + 1;
    LeftMinus := TempX.FMinus;
    RightMinus := TempY.FMinus;
    TempX.FMinus := False;
    TempY.FMinus := False;
    UnsignedDivide;
    Adjust;

    { set sign
      the next lines show the results doing a signed division
      10 /   3 =   3 R   1
      10 /  -3 =  -3 R   1
      -10 /   3 =  -3 R  -1
      -10 /  -3 =   3 R  -1
    }
    if not LeftMinus then
    begin
      FMinus := RightMinus;
    end
    else
    begin
      FMinus := not RightMinus;
      Remainder.FMinus := True;
    end;
  finally
    TempY.Free;
    TempX.Free;
  end;
end;

// divide the VLI by Y

procedure TVLI.Divide(const Y: TVLI; out Remainder: TVLI);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.Divide(Self, Y, Remainder);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

// check whether the VLI and X are equal

function TVLI.Equal(const X: TVLI): Boolean;
var
  I: Integer;
begin
  Result := (LenVLI = X.LenVLI) and (FMinus = X.FMinus);
  if Result then
  begin
    for I := 0 to LenVLI - 1 do
    begin
      Result := FVLIAr[I] = X.FVLIAr[I];
      if not Result then
        Break;
    end;
  end;
end;

// greatest common divisor

procedure TVLI.GCD(const X, Y: TVLI);
var
  A, B, R: TVLI;
begin
  A := TVLI.Create;
  B := TVLI.Create;
  R := TVLI.Create;
  try
    A.Assign(X);
    B.Assign(Y);
    while not B.IsZero do
    begin
      A.Divide(B, R);
      A.Assign(B);
      B.Assign(R);
    end;
    Assign(A);
  finally
    A.Free;
    B.Free;
    R.Free;
  end;
end;

procedure TVLI.GCD(const Y: TVLI);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.GCD(Self, Y);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

{$Q+}

function TVLI.GetAsFloat: Extended;
var
  I: Integer;
begin
  Result := 0;
  for I := LenVLI - 1 downto 0 do
  begin
    Result := Result * Base + FVLIAr[I];
  end;
  if FMinus then
    Result := -Result;
end;

{$IFNDEF OverflowCheckOn}
{$Q-}
{$ENDIF}

function TVLI.GetAsHex: AnsiString;
var
  I: Integer;
begin
  Result := '0';
  for I := LenVLI - 1 downto 0 do
  begin
{$WARNINGS Off}
    if I = LenVLI - 1 then
      Result := IntToHex(FVLIAr[I], 1)
    else
      Result := Result + IntToHex(FVLIAr[I], 8);
{$WARNINGS On}
  end;
  Result := '$' + Result;
end;

{$Q+}

function TVLI.GetAsInt64: Int64;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to LenVLI - 1 do
  begin
    Result := Result * Base + FVLIAr[I];
  end;
  if FMinus then
    Result := -Result;
end;

function TVLI.GetAsInteger: Integer;
begin
  Result := AsInt64;
end;

{$IFNDEF OverflowCheckOn}
{$Q-}
{$ENDIF}

function TVLI.GetAsString: AnsiString;
var
  Remainder: Integer;
  Temp: TVLI;
begin
  if IsZero then
    Result := '0'
  else
  begin
    Result := '';
    Temp := TVLI.Create;
    try
      Temp.Assign(Self);
      Temp.FMinus := False;
      while not Temp.IsZero do
      begin
        Temp.Divide(DecBase, Remainder);
{$WARNINGS Off}
        if not Temp.IsZero then
          Result := Format('%.*d%s', [DecBaseLen, Remainder, Result])
        else
          Result := Format('%d%s', [Remainder, Result]);
{$WARNINGS On}
      end;
      if FMinus then
        Result := '-' + Result
    finally
      Temp.Free;
    end;
  end;
end;

function TVLI.GetIsZero: Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to LenVLI - 1 do
  begin
    if FVLIAr[I] <> 0 then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

// number of 'digits'

function TVLI.GetLenVLI: Integer;
begin
  Result := Length(FVLIAr);
end;

procedure TVLI.Inc;
begin
  Add(1);
end;

// internally used

procedure TVLI.Multiply(const Value: Cardinal);
var
  I: Integer;
  C: Cardinal;
  Aux: UInt64;
begin
  LenVLI := LenVLI + 1;
  C := 0;
  for I := 0 to LenVLI - 1 do
  begin
    Aux := UInt64(FVLIAr[I]) * Value + C;
    FVLIAr[I] := Aux and BaseMinusOne;
    C := Aux shr 32;
  end;
  Adjust;
end;

// multiply the VLI by an Int64

procedure TVLI.Multiply(const Value: Int64);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create(Value);
  try
    Multiply(Temp);
  finally
    Temp.Free;
  end;
end;

// multiply the VLI by an Integer

procedure TVLI.Multiply(const Value: Integer);
begin
  Multiply(Int64(Value));
end;

// set the VLI to the product of X by Y

procedure TVLI.Multiply(const X, Y: TVLI);
var
  I, J, K: Integer;
  PartRes: UInt64;
  TempX, TempY: TVLI;
begin
  // possibly X = Self or Y = Self and/or X = Y
  TempX := TVLI.Create;
  TempY := TVLI.Create;
  try
    TempX.Assign(X);
    TempY.Assign(Y);
    // the length of the result is length of Left + length of Right
    // maybe the result is one too large
    LenVLI := TempX.LenVLI + TempY.LenVLI;
    // set all parts of the result to 0
    Clean;
    // set the sign of the result
    FMinus := TempX.FMinus xor TempY.FMinus;

    // iterate over all parts of factor X
    for I := 0 to TempX.LenVLI - 1 do
    begin
      // in case a part of factor X is 0 the following calculation is not necessary
      if TempX.FVLIAr[I] = 0 then
        Continue;

      // iterate over all parts of factor Y
      for J := 0 to TempY.LenVLI - 1 do
      begin
        // in case a part of factor Y is 0 the calculation is also not necessary
        if TempY.FVLIAr[J] = 0 then
          Continue;

        // multiply the parts
        // (force Int64 to prevent integer overflow)
        PartRes := UInt64(TempX.FVLIAr[I]) * TempY.FVLIAr[J];

        // add the product of the parts to the result, pay attention to the carry
        for K := I + J to LenVLI - 1 do
        begin
          PartRes := PartRes + FVLIAr[K];
          FVLIAr[K] := PartRes and BaseMinusOne;
          PartRes := PartRes shr 32;
          if (PartRes = 0) then
            Break;
        end;
      end;
    end;

    // remove leading '0'
    Adjust;
  finally
    TempY.Free;
    TempX.Free;
  end;
end;

// multiply the VLI by Y

procedure TVLI.Multiply(const Y: TVLI);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.Multiply(Self, Y);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

// change the sign

procedure TVLI.Negate;
begin
  if not IsZero then
    FMinus := not FMinus;
end;

// check whether the VLI is odd

function TVLI.Odd: Boolean;
begin
  if LenVLI = 0 then
    Result := False
  else
    Result := System.Odd(FVLIAr[0]);
end;

// calculate VLI ^ Exponent

procedure TVLI.Power(const Exponent: Cardinal);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.Power(Self, Exponent);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

// set the VLI to the power of Left to the Exponent
// algorithm from Prof. Harlay Flanders, University of Michigan

procedure TVLI.Power(const X: TVLI; Exponent: Cardinal);
var
  Temp: TVLI;
begin
  if Exponent = 0 then
  begin
    SetAsInteger(1);
    Exit;
  end
  else if Exponent = 1 then
  begin
    Assign(X);
    Exit;
  end;

  Temp := TVLI.Create;
  try
    Temp.Assign(X);
    // it's possible that X = Self so only now set to 1
    SetAsInteger(1);
    repeat
      if System.Odd(Exponent) then
        Multiply(Temp);
      Exponent := Exponent shr 1;
      if Exponent = 0 then
        Break;
      Temp.Multiply(Temp);
    until False;
  finally
    Temp.Free;
  end;
end;

procedure TVLI.SetAsFloat(Value: Extended);
var
  I: Integer;
begin
  Clear;
  LenVLI := 5;
  FMinus := Math.Sign(Value) = -1;

  I := 0;
  Value := Round(System.Abs(Value));
  while Value > 0 do
  begin
    if I > LenVLI - 1 then
      LenVLI := LenVLI + 5;

    FVLIAr[I] := Round(Frac(Value / Base) * Base);
    Value := Int(Value / Base);
    System.Inc(I);
  end;
  Adjust;
end;

procedure TVLI.SetAsHex(Value: AnsiString);
var
  I: Integer;
  NewStrLen: Integer;
begin
  FMinus := False;
  Clear;
{$WARNINGS Off}
  Value := Trim(Value);
{$WARNINGS On}
  if Length(Value) <> 0 then
  begin
    if Value[1] = '$' then
      Delete(Value, 1, 1);

    NewStrLen := ((Length(Value) - 1) div BaseLen + 1) * BaseLen;
    LenVLI := NewStrLen div BaseLen;
    Value := PadL(Value, '0', NewStrLen);
    try
      for I := 0 to LenVLI - 1 do
      begin
{$WARNINGS Off}
        FVLIAr[LenVLI - 1 - I] :=
          StrToInt('$' + Copy(Value, I * BaseLen + 1, BaseLen));
{$WARNINGS On}
      end;
    except
      // EConvertError - Value contains characters other than '0' .. '9'
      on EConvertError do
      begin
        Clear;
      end;
    end;
  end
end;

procedure TVLI.SetAsInt64(const Value: Int64);
begin
  FMinus := Value < 0;
  LenVLI := 2;
  FVLIAr[0] := System.Abs(Value) and BaseMinusOne;
  FVLIAr[1] := System.Abs(Value) shr 32;
  Adjust;
end;

procedure TVLI.SetAsInteger(const Value: Integer);
begin
  AsInt64 := Value;
end;

procedure TVLI.SetAsString(Value: AnsiString);
var
  I: Integer;
  Aux: Integer;
  NewStrLen: Integer;
  ValMinus: Boolean;
begin
  FMinus := False;
  Clear;
{$WARNINGS Off}
  Value := Trim(Value);
{$WARNINGS On}
  if Length(Value) <> 0 then
  begin
    ValMinus := False;
    if Value[1] in ['+', '-'] then
    begin
      if Value[1] = '-' then
      begin
        ValMinus := True;
      end;
      Delete(Value, 1, 1);
    end;

    NewStrLen := ((Length(Value) - 1) div DecBaseLen + 1) * DecBaseLen;
    Value := PadL(Value, '0', NewStrLen);
    try
      for I := 0 to NewStrLen div DecBaseLen - 1 do
      begin
{$WARNINGS Off}
        Aux := StrToInt(Copy(Value, I * DecBaseLen + 1, DecBaseLen));
        Multiply(DecBase);
        Add(Aux);
{$WARNINGS On}
      end;
      FMinus := ValMinus;
    except
      // EConvertError - Value contains characters other than '0' .. '9'
      on EConvertError do
      begin
        Clear;
      end;
    end;
  end
end;

procedure TVLI.SetLenVLI(const Value: Integer);
var
  OldLength, I: Integer;
begin
  OldLength := Length(FVLIAr);
  if Value > OldLength then
  begin
    SetLength(FVLIAr, Value);
    for I := OldLength to Value - 1 do
      FVLIAr[I] := 0
  end
  else if Value < OldLength then
  begin
    SetLength(FVLIAr, Value);
  end;
end;

// shift the VLI N bits left

procedure TVLI.ShiftLeft(const N: Cardinal);
begin
  ShiftLeft(Self, N);
end;

// shift the X N bits left, the VLI will be replaced by the result

procedure TVLI.ShiftLeft(const X: TVLI; N: Cardinal);
var
  K, L, OldLen: Integer;
  I: Integer;
  Aux: UInt64;
begin
  Assign(X);
  if N > 0 then
  begin
    K := N div 32;
    L := N mod 32;

    OldLen := LenVLI;
    LenVLI := LenVLI + K + Math.Sign(L);

    if K > 0 then
    begin
      Move(FVLIAr[0], FVLIAr[K], SizeOf(FVLIAr[0]) * OldLen);
      FillChar(FVLIAr[0], SizeOf(FVLIAr[0]) * K, 0);
    end;

    if L > 0 then
    begin
      Aux := 0;
      for I := K to LenVLI - 1 do
      begin
        Aux := (UInt64(FVLIAr[I]) shl L) or (Aux shr 32);
        FVLIAr[I] := Aux and BaseMinusOne;
      end;
    end;
    Adjust;
  end;
end;

// shift the VLI N bits right

procedure TVLI.ShiftRight(const N: Integer);
begin
  ShiftRight(Self, N);
end;

// set the VLI to X shift right N

procedure TVLI.ShiftRight(const X: TVLI; N: Integer);
var
  K, L, NewLen: Integer;
  I: Integer;
  Aux: UInt64;
begin
  Assign(X);
  if N > 0 then
  begin
    K := N div 32;
    L := N mod 32;

    NewLen := LenVLI - K;

    if K > 0 then
    begin
      Move(FVLIAr[K], FVLIAr[0], SizeOf(FVLIAr[0]) * NewLen);
      FillChar(FVLIAr[NewLen], SizeOf(FVLIAr[0]) * (LenVLI - NewLen), 0);
    end;

    if L > 0 then
    begin
      Aux := 0;
      for I := NewLen - 1 downto 0 do
      begin
        Aux := (UInt64(FVLIAr[I]) shl (32 - L)) or (Aux shl 32);
        FVLIAr[I] := Aux shr 32;
      end;
    end;
    Adjust;
  end;
end;

function TVLI.Sign: Integer;
begin
  if IsZero then
    Result := 0
  else if FMinus then
    Result := -1
  else
    Result := 1;
end;

// calculate square of VLI

procedure TVLI.Sqr;
begin
  Multiply(Self);
end;

// calculate square of X, the VLI will be replaced by the reult

procedure TVLI.Sqr(const X: TVLI);
begin
  Assign(X);
  Multiply(X);
end;

// subtract an Int64 from the VLI

procedure TVLI.Subtract(const Value: Int64);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create(Value);
  try
    Subtract(Temp);
  finally
    Temp.Free;
  end;
end;

// subtract an Integer from the VLI

procedure TVLI.Subtract(const Value: Integer);
begin
  Subtract(Int64(Value));
end;

// set the VLI to the difference of X minus Y

procedure TVLI.Subtract(const X, Y: TVLI);
var
  RightMinus: Boolean;
begin
  if X = Y then
    Clear
  else
  begin
    RightMinus := Y.FMinus;
    try
      Y.FMinus := not RightMinus;
      Add(X, Y);
    finally
      Y.FMinus := RightMinus;
    end;
  end;
end;

// subtract Y from the VLI

procedure TVLI.Subtract(const Y: TVLI);
var
  Temp: TVLI;
begin
  Temp := TVLI.Create;
  try
    Temp.Subtract(Self, Y);
    Assign(Temp);
  finally
    Temp.Free;
  end;
end;

end.