lbbigint.pas

tool pour ubuntu 8.10

  tmp.IntBuf.dwLen := N1.IntBuf.dwLen;                           {!!.01}
  tmp.IntBuf.pBuf := N1.IntBuf.pBuf;                             {!!.01}

  N1.bSign := N2.bSign;                                          {!!.01}
  N1.dwUsed := N2.dwUsed;                                        {!!.01}
  N1.IntBuf.dwLen := N2.IntBuf.dwLen;                            {!!.01}
  N1.IntBuf.pBuf := N2.IntBuf.pBuf;                              {!!.01}

  N2.bSign := tmp.bSign;                                         {!!.01}
  N2.dwUsed := tmp.dwUsed;                                       {!!.01}
  N2.IntBuf.dwLen := tmp.IntBuf.dwLen;                           {!!.01}
  N2.IntBuf.pBuf := tmp.IntBuf.pBuf;                             {!!.01}
end;
{ ------------------------------------------------------------------- }
function LbBiReverseBits(byt : Byte) : Byte;
var
  i : byte;
  rBit : Byte;
begin
  Result := 0;
  rBit := $80;
  for i := 1 to 8 do begin
    if ((byt and $01) <> 0) then
      Result := Result or rBit;
    rBit := rBit shr 1;
    byt := byt shr 1;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiShr(var N1 : LbInteger; _shr : Integer);
var
  bitShr : byte;
  byteShr : Integer;
  carry : byte;
  tmp : word;
  shifted : byte;
  i : Integer;
  t : LbInteger;
begin
  if _shr < 1 then exit;                       {!!.01}

  LbBiVerify(N1);
  LbBiInit(t, cDEFAULT_PRECISION);
  LbBiAddByte(t, cPREPEND_ARRAY, $00);

  byteShr := _shr div 8;       
  bitShr := _shr mod 8;
  if( byteShr > integer( N1.dwUsed ))then begin
    LbBiClear( N1 );
    LbBiAddByte( N1, cPREPEND_ARRAY, $00 );
  end;

  carry := 0;
  try
    for i := N1.dwUsed downto 1 do begin
      if (i - byteShr) < 1 then break;
      tmp := pBiByteArray( N1.IntBuf.pBuf )[pred(i)];
      shifted := (tmp shr bitShr) or carry;
      LbBiAddByte(t, i - byteShr, byte(shifted and $00FF));
      carry := ((tmp shl (8 - bitShr)) and $00FF);
    end;
    LbBiCopy(N1, t, t.dwUsed);
  finally
    LbBiTrimSigZeros( N1 );
    LbBiFree(t);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiShl(var N1 : LbInteger; _shl : Integer);
var
  bitShl : byte;
  byteShl : Integer;
  tmp : word;
  shifted : byte;
  carry : byte;
  t : LbInteger;
  i : Integer;
  x : Integer;
begin

  if _shl < 1 then exit;                       {!!.01}
  LbBiVerify(N1);
  LbBiInit(t, cDEFAULT_PRECISION);
  LbBiAddByte(t, cPREPEND_ARRAY, $00);

  byteShl := _shl div 8;
  bitShl := _shl mod 8;

  try
    carry := 0;
    x := 0;
    for i := 1 to N1.dwUsed do begin
      tmp := pBiByteArray( N1.IntBuf.pBuf )[pred(i)];
      shifted := ((tmp shl bitShl) and $00FF) or carry;
      LbBiAddByte(t, i + byteShl, byte(shifted and $00FF));
      carry := ((tmp shr (8 - bitShl)) and $00FF);
      x := i;
    end;
    LbBiAddByte(t, succ(x) + byteShl, carry);
    LbBiCopy(N1, t, t.dwUsed);
  finally
    LbBiTrimSigZeros(N1);
    LbBiFree(t);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiOR(N1 : LbInteger; N2 : LbInteger; var NOR : LbInteger);
var
  count : integer;                                                        {!!03}
  i : integer;                                                            {!!03}
  a : byte;
  b : byte;
begin
  LbBiVerify(N1);
  LbBiVerify(N2);
  LbBiPrepare(N1, N2, NOR);

  LbBiAddByte(NOR, cPREPEND_ARRAY, $00);
  LbBiFindLargestUsed(N1, N2, count);
  for i := 1 to count do begin
    a := LbBiGetByteValue(N1, i);
    b := LbBiGetByteValue(N2, i);
    a := a or b;
    LbBiAddByte(NOR, i, a);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiORInPlace(var N1 : LbInteger; N2 : LbInteger);
var
  Nor : LbInteger;
  prec : Integer;
begin
  if (N1.dwUsed > N2.dwUsed) then prec := succ(N1.dwUsed)
  else                            prec := succ(N2.dwUsed);
  LbBiInit(Nor, prec);
  try
    LbBiOR(N1, N2, Nor);
    LbBiClear(N1);
    N1.dwUsed := Nor.dwUsed;
    N1.bSign := Nor.bSign;
    if (N1.IntBuf.dwLen < Nor.IntBuf.dwLen) then
      LbBiRealloc(N1, Nor.IntBuf.dwLen);
    LbBiCopy(N1 , Nor, Nor.dwUsed);
  finally
    LbBiFree(Nor);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiXOR(N1 : LbInteger; N2 : LbInteger; var NXOR : LbInteger);
var
  count : integer;                                                        {!!03}
  i : integer;                                                            {!!03}
  a : byte;
  b : byte;
begin
  LbBiVerify(N1);
  LbBiVerify(N2);
  LbBiPrepare(N1, N2, NXOR);

  LbBiAddByte(NXOR, cPREPEND_ARRAY, $00);
  LbBiFindLargestUsed(N1, N2, count);
  for i := 1 to count do begin
    a := LbBiGetByteValue(N1, i);
    b := LbBiGetByteValue(N2, i);
    a := a xor b;
    LbBiAddByte(NXOR, i, a);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiXORInPlace(var N1 : LbInteger; N2 : LbInteger);
var
  Nxor : LbInteger;
  prec : Integer;
begin
  if (N1.dwUsed > N2.dwUsed) then prec := succ(N1.dwUsed)
  else                            prec := succ(N2.dwUsed);
  LbBiInit(Nxor, prec);
  try
    LbBiXOR(N1, N2, Nxor);
    LbBiClear(N1);
    N1.dwUsed := Nxor.dwUsed;
    N1.bSign := Nxor.bSign;
    if (N1.IntBuf.dwLen < Nxor.IntBuf.dwLen) then
      LbBiRealloc(N1, Nxor.IntBuf.dwLen);
    LbBiCopy(N1 , Nxor, Nxor.dwUsed);
  finally
    LbBiFree(Nxor);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiMove(var dest : LbInteger; src : LbInteger;
                    place : integer; len : Integer);                      {!!03}
var
  ptr : pByte;
  size : integer;                                                         {!!03}
begin
  if (not assigned(dest.IntBuf.pBuf)) then
    raise Exception.Create(sBIBufferNotAssigned);

  if (place = cAPPEND_ARRAY) then begin
    if ((integer(len) + dest.dwUsed) > dest.IntBuf.dwLen) then            {!!03}
      LbBiRealloc(dest, (integer(len) + dest.dwUsed));                    {!!03}

    ptr := dest.IntBuf.pBuf;
    inc(ptr, dest.dwUsed);
    move(src.IntBuf.pBuf^, ptr^, len);
    inc(dest.dwUsed, len);
  end else begin
    size := pred(place) + integer(len);                                   {!!03}
    if size > dest.IntBuf.dwLen then
      LbBiRealloc(dest, size);
    ptr := dest.IntBuf.pBuf;
    inc(ptr, pred(place));
    move(src.IntBuf.pBuf^, ptr^, len);
    if (dest.dwUsed < size) then
      dest.dwUsed := size;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiAddBase(N1 : LbInteger; N2 : LbInteger; var Sum : LbInteger);
var
  Carry : byte;
  cnt : Integer;
  Count : integer;                                                        {!!03}
  tmp_wrd : WORD;
  tmp_byt : byte;
begin
  LbBiFindLargestUsed(N1, N2, Count);

  if( LbBiIsZero( N1 ))then begin
    LbBiCopy(sum, N2, N2.dwUsed);
    exit;
  end;

  if( LbBiIsZero( N2 ))then begin
    LbBiCopy(sum, N1, N1.dwUsed);
    exit;
  end;

  Carry := 0;
  if (succ(count) > Sum.dwUsed) then
    LbBiRealloc(Sum, succ(count));
  { add digits }
  for cnt := 1 to count do begin
    tmp_wrd := LbBiGetByteValue(N1, cnt) +
               LbBiGetByteValue(N2, cnt) + Carry;
    tmp_byt := tmp_wrd and $00FF;
    Carry   := tmp_wrd shr 8;
    pBiByteArray(Sum.IntBuf.pBuf )[Sum.dwUsed] := tmp_byt;
    inc(Sum.dwUsed);
  end;
  { finish by adding the carry }
  LbBiAddByte(Sum, cAPPEND_ARRAY, Carry);
  { trim off any significant zeros }
  LbBiTrimSigZeros(Sum);
end;
{ ------------------------------------------------------------------- }
procedure LbBiSubBase(N1 : LbInteger; N2 : LbInteger;
                       var Diff : LbInteger);
var
  tmp : integer;
  Borrow : WORD;
  cnt : integer;                                                          {!!03}
  x : integer;                                                            {!!03}
begin
  if( LbBiIsZero( N1 ))then begin
    LbBiCopy(Diff, N2, N2.dwUsed);
    exit;
  end;

  if( LbBiIsZero( N2 ))then begin
    LbBiCopy(Diff, N1, N1.dwUsed);
    exit;
  end;

  Borrow := 0;
  x := pred(N1.dwUsed);
  for cnt := 0 to x do begin
    tmp := pBiByteArray(N1.IntBuf.pBuf)[cnt];
    if (N2.dwUsed < succ(cnt)) then
      tmp := tmp - Borrow
    else
      tmp := tmp - (pBiByteArray(N2.IntBuf.pBuf)[cnt] + Borrow);

    if (tmp < 0) then begin
      inc(tmp, cBYTE_POSSIBLE_VALUES);
      Borrow := 1;
    end else
      Borrow := 0;

    if (succ(Diff.dwUsed) > Diff.IntBuf.dwLen) then
      LbBiRealloc(Diff, succ(Diff.dwUsed));
    pBiByteArray(Diff.IntBuf.pBuf )[Diff.dwUsed] := tmp;
    inc(Diff.dwUsed);
  end;
  if (Borrow <> 0) then
    raise Exception.Create(sBISubtractErr);
  { trim off any significant zeros }
  LbBiTrimSigZeros(Diff);
end;
{ ------------------------------------------------------------------- }
procedure LbBiAdd(N1 : LbInteger; N2 : LbInteger; var Sum : LbInteger);
var
  value : Shortint;
begin
  if (N1.bSign = N2.bSign) then begin
    Sum.bSign := N1.bSign;
    LbBiAddBase(N1, N2, Sum);
  end else begin
    value := LbBiAbs(N1, N2);
    if (value = cEQUAL_TO) then begin
      LbBiAddByte(Sum, cPREPEND_ARRAY, $00);
      exit;
    end else if (value = cGREATER_THAN) then begin
      Sum.bSign := N1.bSign;
      LbBiSubBase(N1, N2, Sum);
    end else begin
      Sum.bSign := N2.bSign;
      LbBiSubBase(N2, N1, Sum);
    end;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiSub(N1 : LbInteger; N2 : LbInteger; var diff : LbInteger);
begin
  N2.bSign := not N2.bSign;
  LbBiAdd(N1, N2, diff);
end;
{ ------------------------------------------------------------------- }
procedure LbBiAddInPlace(var N1 : LbInteger; N2 : LbInteger);
var
  sum : LbInteger;
  prec : Integer;
begin
  if (N1.dwUsed > N2.dwUsed) then
    prec := succ(N1.dwUsed)
  else
    prec := succ(N2.dwUsed);

  LbBiInit(sum, prec);
  try
    LbBiAdd(N1, N2, sum);
    LbBiClear(N1);
    N1.dwUsed := sum.dwUsed;
    N1.bSign := sum.bSign;
    if (N1.IntBuf.dwLen < sum.IntBuf.dwLen) then
      LbBiRealloc(N1, sum.IntBuf.dwLen);

    LbBiCopy(N1 , sum, sum.dwUsed);
  finally
    LbBiFree(sum);
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiSubInPlace(var N1 : LbInteger;  N2 : LbInteger);
var
  Difference : LbInteger;
  prec : Integer;
begin
  if (N1.dwUsed > N2.dwUsed) then
    prec := succ(N1.dwUsed)
  else
    prec := succ(N2.dwUsed);

  LbBiInit(Difference, prec);
  try
    LbBiSub(N1, N2, Difference);
    LbBiClear(N1);
    N1.dwUsed := Difference.dwUsed;