lbbigint.pas

tool pour ubuntu 8.10

    N1.bSign := Difference.bSign;
    if (N1.IntBuf.dwLen < Difference.IntBuf.dwLen) then
      LbBiRealloc(N1, Difference.IntBuf.dwLen);

    LbBiCopy(N1, Difference, Difference.dwUsed);
  finally
    LbBiFree(Difference);
  end;
end;
{ ------------------------------------------------------------------- }
function MultSpecialCase(N1 : LbInteger; N2 : LbInteger;
                        var Product : LbInteger) : Boolean;
begin
  Result := False;
  { if either one is zero then the product is zero }
  if (LbBiIsZero(N1) or LbBiIsZero(N2)) then begin
    LbBiAddByte(Product, cPREPEND_ARRAY, $00);
    Result := True;
    exit;
  end;

  { if N1 := 1 }
  if (LbBiIsOne(N1)) then begin
    product.dwUsed := N2.dwUsed;

    if (product.IntBuf.dwLen < N2.IntBuf.dwLen) then
      LbBiRealloc(product, N2.IntBuf.dwLen);

    LbBiCopy(product, N2, N2.dwUsed);
    Result := True;
    exit;
  end;

  { if N2 := 1 }
  if (LbBiIsOne(N2)) then begin
    product.dwUsed := N1.dwUsed;

    if (product.IntBuf.dwLen < N1.IntBuf.dwLen) then
      LbBiRealloc(product, N1.IntBuf.dwLen);

    LbBiCopy(product, N1, N1.dwUsed);
    Result := True;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiMultBase(N1 : LbInteger; N2 : LbInteger;
                        var Product : LbInteger);
var
  InxX : integer;                                                         {!!03}
  InxY : integer;                                                         {!!03}
  MaxX : integer;                                                         {!!03}
  Carry : integer;                                                        {!!03}
  prd : integer;                                                          {!!03}
  plc : integer;                                                          {!!03}
  byt : byte;
  tmp : integer;                                                          {!!03}
begin
  if (MultSpecialCase(N1, N2, Product)) then
    exit;
  MaxX := pred(N1.dwUsed);
  tmp := pred(N2.dwUsed);
  for InxY := 0 to tmp do begin
    if pBiByteArray(N2.IntBuf.pBuf)[InxY] <> 0 then begin
      Carry := 0;
      for InxX := 0 to MaxX do begin
        plc := InxX + InxY;
        prd := pBiByteArray(N1.IntBuf.pBuf)[InxX];
        prd := prd * pBiByteArray(N2.IntBuf.pBuf)[InxY];
        if (Product.dwUsed < plc) then
          prd := prd + Carry
        else
          prd := prd + pBiByteArray(Product.IntBuf.pBuf)[plc] + Carry;

        byt := prd and $00FF;
        Carry := prd shr 8;

        if (succ(plc) > Product.IntBuf.dwLen) then
          LbBiRealloc(Product, plc + 100);
        pBiByteArray(Product.IntBuf.pBuf )[plc] := byt;
        if (Product.dwUsed < succ(plc)) then
          N1.dwUsed := succ(plc);
      end;
      LbBiAddByte(Product, (MaxX + InxY + 2), Carry);
    end;
   end;
  { trim off any significant zeros }
  LbBiTrimSigZeros(Product);
end;
{ ------------------------------------------------------------------- }
procedure LbBiMult(N1 : LbInteger; N2 : LbInteger;
                    var Product : LbInteger);
begin
  LbBiMultBase(N1, N2, Product);
  if (N1.bSign = N2.bSign) then
    Product.bSign := cPOSITIVE
  else
    Product.bSign := cNEGATIVE;
end;
{ ------------------------------------------------------------------- }
procedure LbBiMultInPlace(var N1 : LbInteger; N2 : LbInteger);
var
  product : LbInteger;
  precis : Integer;
begin
  precis := (N1.dwUsed + N2.dwUsed) * 2;
  LbBiInit(product, precis);
  LbBiMult(N1, N2, product);
  LbBiClear(N1);
  N1.dwUsed := product.dwUsed;
  N1.bSign := product.bSign;
  if (N1.IntBuf.dwLen < product.IntBuf.dwLen) then
    LbBiRealloc(N1, product.IntBuf.dwLen);
  LbBiCopy(N1, product, product.dwUsed);
  LbBiFree(product);
end;
{ ------------------------------------------------------------------- }
procedure LbBiMulByDigitBase(N1 : LbInteger; N2 : byte;
                             var product : LbInteger);
var
  cnt : integer;                                                          {!!03}
  carry : byte;
  prd : WORD;
  byt : byte;
  tmp : integer;                                                          {!!03}
begin                                                                     
  if (N2 = 1) then begin
    if (product.IntBuf.dwLen < N1.IntBuf.dwLen) then
      LbBiRealloc(product, N1.IntBuf.dwLen);
    product.dwUsed := N1.dwUsed;
    product.bSign := N1.bSign;
    LbBiCopy(product, N1, N1.dwUsed);
  end;

  if (n2 = 0) then begin
    product.dwUsed := 1;
    LbBiAddByte(product, cPREPEND_ARRAY, 0);
  end;

  if LbBiIsOne( N1 ) then begin
    product.dwUsed := 1;
    LbBiAddByte(product, cPREPEND_ARRAY, N2);
  end;
  { we can do this here since LbBiIsOne() did the clean up on N1 }
  if (N1.dwUsed = 1) and (pBiByteArray( N1.IntBuf.pBuf )[0] = 0) then begin {!!.01}
    product.dwUsed := 1;
    LbBiAddByte(product, cPREPEND_ARRAY, 0);
  end;

  Carry := 0;
  tmp := pred( N1.dwUsed );
  for cnt := 0 to tmp do begin
    prd   := (pBiByteArray( N1.IntBuf.pBuf )[cnt] * N2) + Carry;
    byt   := prd and $00FF;
    Carry := prd shr 8;
    pBiByteArray(Product.IntBuf.pBuf )[cnt] := byt;
    if (Product.dwUsed < succ(cnt)) then
      N1.dwUsed := succ(cnt);
  end;
  LbBiAddByte(Product, succ(N1.dwUsed), Carry);
  LbBiTrimSigZeros(Product);
end;
{ ------------------------------------------------------------------- }
procedure LbBiMulByDigit(N1 : LbInteger; N2 : byte;
                          var product : LbInteger);
begin
  LbBiMulByDigitBase(N1, N2, product);
  product.bSign := N1.bSign;
end;
{ ------------------------------------------------------------------- }
procedure LbBiMulByDigitInPlace(var N1 : LbInteger; N2 : byte);
var
 product : LbInteger;
 precis : Integer;
begin
  precis := (N1.dwUsed + 1) * 2;
  LbBiInit(product, precis);
  try
    LbBiMulByDigit(N1, N2, product);
    if (N1.IntBuf.dwLen < product.IntBuf.dwLen) then
      LbBiRealloc(N1, product.IntBuf.dwLen);
    N1.bSign := product.bSign;
    N1.dwUsed := product.dwUsed;
    LbBiCopy(N1, product, product.dwUsed);
  finally
    LbBiFree(product);

  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiDivByDigitBase(N1 : LbInteger; N2 : byte;
                              var quotient : LbInteger;
                              var remainder : byte);
var
  factor : byte;
  c : Integer;
  tmp : Integer;
  sigDivd : longint;
  lclQT : longint;
  Carry : WORD;
  plc : integer;                                                          {!!03}  
  lclDVD : LbInteger;
  divisor : byte;
begin
  LbBiInit(lclDVD, N1.dwUsed);
  Carry := 0;
  try
    if (LbBiIsZero(N1)) then begin
        LbBiAddByte(quotient, cPREPEND_ARRAY, $00);
        exit;
      end;
    if (N2 = 1) then begin
      LbBiCopy(quotient, N1, N1.dwUsed);
      exit;
    end;
    if (N2 = 0) then
      raise Exception.Create(sBIZeroDivide);

    LbBiCopy(lclDVD, N1, N1.dwUsed);
    divisor := N2;

    { Find the factor to increase the Significant byte greater than $80 }
    factor := LbBiFindFactor(N2);
    if (factor <> 1) then begin
      LbBiMulByDigitInPlace(lclDVD, factor);
      divisor := divisor * factor;
    end;


    if pBiByteArray( lclDVD.IntBuf.pBuf )[pred(lclDVD.dwUsed)] >= divisor then begin
      LbBiAddByte(lclDVD, cAPPEND_ARRAY, $00);
    end;

    LbBiClear(quotient);
    remainder := 0;

    plc := pred(lclDVD.dwUsed);
    if (lclDVD.dwUsed > quotient.dwUsed) then
       LbBiRealloc(quotient, lclDVD.dwUsed);
    Carry := 0;
    tmp := pred(lclDVD.dwUsed);
    for c := tmp downto 0 do begin
      sigDivd := (Carry shl 8) or (integer(pBiByteArray(lclDVD.IntBuf.pBuf)[c])); {!!03}
      if (SigDivd < divisor) then begin
        Carry := SigDivd;
        dec(plc);
        continue;
      end;

      lclQT := sigDivd div divisor;
      if (lclQT <> 0) then begin
        if (lclQT >= cBYTE_POSSIBLE_VALUES) then
          lclQT := pred(cBYTE_POSSIBLE_VALUES);

        while sigDivd < (divisor * lclQT)do begin
          dec(lclQT);
          if (lclQT = 0) then
            raise Exception.Create(sBIQuotientErr);
        end;
      end;

      if (lclQT <> 0) then begin
        pBiByteArray(quotient.IntBuf.pBuf )[plc] := lclQT;
        if (quotient.dwUsed < succ(plc)) then
          quotient.dwUsed := succ(plc);

        Carry := sigDivd - (divisor * lclQT);
      end;
      dec(plc);
    end;
  finally
    remainder := Carry;
    if (quotient.dwUsed = 0) then
      LbBiAddByte(quotient, cPREPEND_ARRAY, $00);

    LbBiFree(lclDVD);
    LbBiTrimSigZeros(quotient);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiDivByDigit(N1 : LbInteger; N2 : byte;
                          var quotient : LbInteger;
                          var remainder : byte);
begin
  LbBiDivByDigitBase(N1, N2, quotient, remainder);
  quotient.bSign := N1.bSign;
end;
{ ------------------------------------------------------------------- }
procedure LbBiDivByDigitInPlace(var N1 : LbInteger;
                                      N2 : byte;
                                  var remainder : byte);
var
  tmp : LbInteger;
  precis : Integer;
begin
  precis := (N1.dwUsed + 1) * 2;
  LbBiInit(tmp, precis);
  try
    LbBiDivByDigit(N1, N2, tmp, remainder);

    N1.dwUsed := tmp.dwUsed;
    N1.bSign := tmp.bSign;
    if (N1.IntBuf.dwLen < tmp.IntBuf.dwLen) then
      LbBiRealloc(N1, tmp.IntBuf.dwLen);
    LbBiCopy(N1, tmp, tmp.dwUsed);
  finally
    LbBiFree(tmp);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiDivBase(N1 : LbInteger; N2 : LbInteger;
                       var quotient : LbInteger;
                       var remainder : LbInteger);
var
  factor : byte;
  InxQ : Integer;
  InxX : Integer;
  tmpByte : byte;
  tmpInt : integer;
  sigDigit : byte;
  lclQT : longint;
  lclDVD : LbInteger;
  lclDSR : LbInteger;
  tmpDR : LbInteger;
  tmpBN : LbInteger;
  sigDivd : longint;
begin
  LbBiInit(lclDVD, N1.dwUsed);
  LbBiInit(lclDSR, N1.dwUsed);
  LbBiInit(tmpDR, N1.dwUsed);
  LbBiInit(tmpBN, N1.dwUsed);
  try
    { Should move special cases to a seperate procedure }
    if (N1.dwUsed < 1)or
      (N2.dwUsed < 1) then
        raise Exception.Create(sBINoNumber);

    if LbBiIsZero( N1 )then begin
      LbBiAddByte(quotient , cPREPEND_ARRAY, $00);
      LbBiAddByte(remainder, cPREPEND_ARRAY, $00);
      exit;
    end;

    if LbBiIsOne( N2 )then begin
      LbBiCopy(quotient, N1, N1.dwUsed);
      LbBiAddByte(remainder, cPREPEND_ARRAY, $00);
      exit;
    end;
    if LbBiIsZero( N2 )then  
        raise Exception.Create(sBIZeroDivide);


    { since only the pointer is saved and not the memory pointed at we }
    { need to move it over to preserve the numbers                     }
    LbBiCopy(lclDVD, N1, N1.dwUsed);
    LbBiCopy(lclDSR, N2, N2.dwUsed);

    { Find the factor to increase the Significant byte greater than $80 }
    LbBiTrimSigZeros(lclDSR);

    tmpByte := pBiByteArray(lclDSR.IntBuf.pBuf)[pred(lclDSR.dwUsed)];
    if (tmpByte = 0) then
      raise Exception.Create(sBIZeroFactor);

    factor := LbBiFindFactor(tmpByte);
    if (factor <> 1) then begin
      LbBiMulByDigitInPlace(lclDVD, factor);
      LbBiMulByDigitInPlace(lclDSR, factor);
    end;