lbbigint.pas

tool pour ubuntu 8.10

    10939, 10949, 10957, 10973, 10979, 10987, 10993, 11003,   // 167
    11027, 11047, 11057, 11059, 11069, 11071, 11083, 11087,   // 168
    11093, 11113, 11117, 11119, 11131, 11149, 11159, 11161,   // 169

    11171, 11173, 11177, 11197, 11213, 11239, 11243, 11251,   // 170
    11257, 11261, 11273, 11279, 11287, 11299, 11311, 11317,   // 171
    11321, 11329, 11351, 11353, 11369, 11383, 11393, 11399,   // 172
    11411, 11423, 11437, 11443, 11447, 11467, 11471, 11483,   // 173
    11489, 11491, 11497, 11503, 11519, 11527, 11549, 11551,   // 174
    11579, 11587, 11593, 11597, 11617, 11621, 11633, 11657,   // 175
    11677, 11681, 11689, 11699, 11701, 11717, 11719, 11731,   // 176
    11743, 11777, 11779, 11783, 11789, 11801, 11807, 11813,   // 177
    11821, 11827, 11831, 11833, 11839, 11863, 11867, 11887,   // 178
    11897, 11903, 11909, 11923, 11927, 11933, 11939, 11941,   // 179

    11953, 11959, 11969, 11971, 11981, 11987, 12007, 12011,   // 180
    12037, 12041, 12043, 12049, 12071, 12073, 12097, 12101,   // 181
    12107, 12109, 12113, 12119, 12143, 12149, 12157, 12161,   // 182
    12163, 12197, 12203, 12211, 12227, 12239, 12241, 12251,   // 183
    12253, 12263, 12269, 12277, 12281, 12289, 12301, 12323,   // 184
    12329, 12343, 12347, 12373, 12377, 12379, 12391, 12401,   // 185
    12409, 12413, 12421, 12433, 12437, 12451, 12457, 12473,   // 186
    12479, 12487, 12491, 12497, 12503, 12511, 12517, 12527,   // 187
    12539, 12541, 12547, 12553, 12569, 12577, 12583, 12589,   // 188
    12601, 12611, 12613, 12619, 12637, 12641, 12647, 12653,   // 189

    12659, 12671, 12689, 12697, 12703, 12713, 12721, 12739,   // 190
    12743, 12757, 12763, 12781, 12791, 12799, 12809, 12821,   // 191
    12823, 12829, 12841, 12853, 12889, 12893, 12899, 12907,   // 192
    12911, 12917, 12919, 12923, 12941, 12953, 12959, 12967,   // 193
    12973, 12979, 12983, 13001, 13003, 13007, 13009, 13033,   // 194
    13037, 13043, 13049, 13063, 13093, 13099, 13103, 13109,   // 195
    13121, 13127, 13147, 13151, 13159, 13163, 13171, 13177,   // 196
    13183, 13187, 13217, 13219, 13229, 13241, 13249, 13259,   // 197
    13267, 13291, 13297, 13309, 13313, 13327, 13331, 13337,   // 198
    13339, 13367, 13381, 13397, 13399, 13411, 13417, 13421,   // 199

    13441, 13451, 13457, 13463, 13469, 13477, 13487, 13499,   // 200
    13513, 13523, 13537, 13553, 13567, 13577, 13591, 13597,   // 201
    13613, 13619, 13627, 13633, 13649, 13669, 13679, 13681,   // 202
    13687, 13691, 13693, 13697, 13709, 13711, 13721, 13723,   // 203
    13729, 13751, 13757, 13759, 13763, 13781, 13789, 13799,   // 204
    13807, 13829, 13831, 13841, 13859, 13873, 13877, 13879,   // 205
    13883, 13901, 13903, 13907, 13913, 13921, 13931, 13933,   // 206
    13963, 13967, 13997, 13999, 14009, 14011, 14029, 14033,   // 207
    14051, 14057, 14071, 14081, 14083, 14087, 14107, 14143,   // 208
    14149, 14153, 14159, 14173, 14177, 14197, 14207, 14221,   // 209

    14243, 14249, 14251, 14281, 14293, 14303, 14321, 14323,   // 210
    14327, 14341, 14347, 14369, 14387, 14389, 14401, 14407,   // 211
    14411, 14419, 14423, 14431, 14437, 14447, 14449, 14461,   // 212
    14479, 14489, 14503, 14519, 14533, 14537, 14543, 14549,   // 213
    14551, 14557, 14561, 14563, 14591, 14593, 14621, 14627,   // 214
    14629, 14633, 14639, 14653, 14657, 14669, 14683, 14699,   // 215
    14713, 14717, 14723, 14731, 14737, 14741, 14747, 14753,   // 216
    14759, 14767, 14771, 14779, 14783, 14797, 14813, 14821,   // 217
    14827, 14831, 14843, 14851, 14867, 14869, 14879, 14887,   // 218
    14891, 14897, 14923, 14929, 14939, 14947, 14951, 14957,   // 219

    14969, 14983, 15013, 15017, 15031, 15053, 15061, 15073,   // 220
    15077, 15083, 15091, 15101, 15107, 15121, 15131, 15137,   // 221
    15139, 15149, 15161, 15173, 15187, 15193, 15199, 15217,   // 222
    15227, 15233, 15241, 15259, 15263, 15269, 15271, 15277,   // 223
    15287, 15289, 15299, 15307, 15313, 15319, 15329, 15331,   // 224
    15349, 15359, 15361, 15373, 15377, 15383, 15391, 15401,   // 225
    15413, 15427, 15439, 15443, 15451, 15461, 15467, 15473,   // 226
    15493, 15497, 15511, 15527, 15541, 15551, 15559, 15569,   // 227
    15581, 15583, 15601, 15607, 15619, 15629, 15641, 15643,   // 228
    15647, 15649, 15661, 15667, 15671, 15679, 15683, 15727,   // 229

    15731, 15733, 15737, 15739, 15749, 15761, 15767, 15773,   // 230
    15787, 15791, 15797, 15803, 15809, 15817, 15823, 15859,   // 231
    15877, 15881, 15887, 15889, 15901, 15907, 15913, 15919,   // 232
    15923, 15937, 15959, 15971, 15973, 15991, 16001, 16007,   // 233
    16033, 16057, 16061, 16063, 16067, 16069, 16073, 16087,   // 234
    16091, 16097, 16103, 16111, 16127, 16139, 16141, 16183,   // 235
    16187, 16189, 16193, 16217, 16223, 16229, 16231, 16249,   // 236
    16253, 16267, 16273, 16301, 16319, 16333, 16339, 16349,   // 237
    16361, 16363, 16369, 16381, 16411, 16417, 16421, 16427,   // 238
    16433, 16447, 16451, 16453, 16477, 16481, 16487, 16493,   // 239

    16519, 16529, 16547, 16553, 16561, 16567, 16573, 16603,   // 240
    16607, 16619, 16631, 16633, 16649, 16651, 16657, 16661,   // 241
    16673, 16691, 16693, 16699, 16703, 16729, 16741, 16747,   // 242
    16759, 16763, 16787, 16811, 16823, 16829, 16831, 16843,   // 243
    16871, 16879, 16883, 16889, 16901, 16903, 16921, 16927,   // 244
    16931, 16937, 16943, 16963, 16979, 16981, 16987, 16993,   // 245
    17011, 17021, 17027, 17029, 17033, 17041, 17047, 17053,   // 246
    17077, 17093, 17099, 17107, 17117, 17123, 17137, 17159,   // 247
    17167, 17183, 17189, 17191, 17203, 17207, 17209, 17231,   // 248
    17239, 17257, 17291, 17293, 17299, 17317, 17321, 17327,   // 249

    17333, 17341, 17351, 17359, 17377, 17383, 17387, 17389,   // 250
    17393, 17401, 17417, 17419, 17431, 17443, 17449, 17467,   // 251
    17471, 17477, 17483, 17489, 17491, 17497, 17509, 17519,   // 252
    17539, 17551, 17569, 17573, 17579, 17581, 17597, 17599,   // 253
    17609, 17623, 17627, 17657, 17659, 17669, 17681, 17683,   // 254
    17707, 17713, 17729, 17737, 17747, 17749, 17761, 17783,   // 255
    17789, 17791, 17807, 17827, 17837, 17839, 17851, 17863,   // 256
    17881, 17891, 17903, 17909, 17911, 17921, 17923, 17929,   // 257
    17939, 17957, 17959, 17971, 17977, 17981, 17987, 17989); // 258  < 18,000



{ == Local LbInteger routines ============================================= }
procedure LbBiInit(var N1 : LbInteger; Precision : Integer);
begin
  FillChar(N1, SizeOf(LbInteger), $00);

  if (Precision > 0) then
    N1.IntBuf.dwLen := Precision
  else
    N1.IntBuf.dwLen := cDEFAULT_PRECISION;

  N1.bSign := cDEFAULT_SIGN;
  N1.dwUsed := cDEFAULT_USED;

  N1.IntBuf.pBuf := pByte(AllocMem(N1.IntBuf.dwLen));
end;
{ ------------------------------------------------------------------- }
procedure LbBiRealloc(var N1 : LbInteger; Len : integer);                 {!!03}
var
  tmpPtr : pByte;
begin
  if (N1.dwUsed > Len) then
    Exit;
  tmpPtr := AllocMem(Len);
  move(N1.IntBuf.pBuf^, tmpPtr^, N1.dwUsed);
  FreeMem(N1.IntBuf.pBuf);
  N1.IntBuf.dwLen := Len;
  N1.IntBuf.pBuf := tmpPtr;
end;
{ ------------------------------------------------------------------- }
procedure LbBiFree(var N1 : LbInteger);
begin
  if (assigned(N1.IntBuf.pBuf)) then
    FreeMem(N1.IntBuf.pBuf);
  FillChar(N1, SizeOf(LbInteger), $00);
end;
{ ------------------------------------------------------------------- }
procedure LbBiClear(var N1 : LbInteger);
begin
  N1.bSign := cDEFAULT_SIGN;
  N1.dwUsed := cDEFAULT_USED;
  FillChar(N1.IntBuf.pBuf^, N1.IntBuf.dwLen, $00);
end;
{ ------------------------------------------------------------------- }
function LbBiGetByteValue (N1 : LbInteger; place : integer): byte;        {!!03}
begin
  if (N1.dwUsed < place) then begin
    Result := 0;
    exit;
  end;
  Result := pBiByteArray( N1.IntBuf.pBuf )[pred(place)];
end;
{ ------------------------------------------------------------------- }
procedure LbBiTrimSigZeros(var N1 : LbInteger);
begin
  if (not assigned(N1.IntBuf.pBuf)) then
    raise Exception.Create(sBIBufferNotAssigned);

  while(pBiByteArray( N1.IntBuf.pBuf )[pred(N1.dwUsed)] = 0)do begin
    dec(N1.dwUsed);
    { leave at least 1 zero }
    if (N1.dwUsed <= 0) then begin
      N1.dwUsed := 1;
      exit;
    end;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiVerify(var N1 : LbInteger);
begin
  { check to see that pointer points at data }
  if (not(assigned(N1.IntBuf.pBuf))) then
      raise Exception.Create(sBIBufferNotAssigned);

  { make sure that there are some numbers }
  if (N1.dwUsed = 0) then
      raise Exception.Create(sBINoNumber);

  LbBiTrimSigZeros(N1);  
end;
{ ------------------------------------------------------------------- }
procedure LbBiFindLargestUsed(N1 : LbInteger; N2 : LbInteger; var count : integer); {!!03}
begin
  if (N1.dwUsed >= N2.dwUsed) then
    Count := N1.dwUsed
  else
    Count := N2.dwUsed;
end;
{ ------------------------------------------------------------------- }
function LbBiFindFactor(B1 : byte) : byte;
begin
  Result := 1;
  while(B1 < $80)do begin
    B1 := (B1 shl 1);
    Result := Result * 2;
  end;
end;
{ ------------------------------------------------------------------- }
procedure LbBiPrepare(N1 : LbInteger; N2 : LbInteger;
                       var N3 : LbInteger);
begin
  { if pointer does not point at data then we make some }
  if (not(assigned(N3.IntBuf.pBuf))) then
    LbBiRealloc(N3, cDEFAULT_PRECISION);

  fillchar(N3.IntBuf.pBuf^, N3.IntBuf.dwLen, $00);
  N3.dwUsed := cDEFAULT_USED;
end;
{ ------------------------------------------------------------------- }
procedure LbBiCopy(var dest : LbInteger; src : LbInteger; len : Integer);
var
  ptr : pByte;
  size : integer;                                                         {!!03}
begin
  fillchar(dest.IntBuf.pBuf^, dest.IntBuf.dwLen, $00);

  size := integer(len);                                                   {!!03}

  if size > dest.IntBuf.dwLen then
    LbBiRealloc(dest, size);

  ptr := dest.IntBuf.pBuf;
  move(src.IntBuf.pBuf^, ptr^, len);

  if (dest.dwUsed < size) then
    dest.dwUsed := size;
end;
{ ------------------------------------------------------------------- }
function LbBiGetBit(N1 : LbInteger; bit : Integer) : Boolean;
var
  tmp : Integer;
  mask : byte;
begin
  mask := $01;
  mask := mask shl (bit mod 8);

  tmp := (bit div 8) + 1 ;
  tmp := LbBiGetByteValue(N1, tmp);

  Result := ((mask and tmp) = mask);

end;
{ ------------------------------------------------------------------- }
procedure LbBiAddByte(var N1 : LbInteger; place : integer; _byte : byte); {!!03}
begin
  if (place = cAPPEND_ARRAY) then begin
    if (succ(N1.dwUsed) > N1.IntBuf.dwLen) then
      LbBiRealloc(N1, succ(N1.dwUsed));
    pBiByteArray( N1.IntBuf.pBuf )[N1.dwUsed] := _byte;
    inc(N1.dwUsed);
  end else begin
    if (place > N1.IntBuf.dwLen) then
      LbBiRealloc(N1, place);
    pBiByteArray(N1.IntBuf.pBuf)[pred(place)] := _byte;
    if (N1.dwUsed < place) then
      N1.dwUsed := place;
  end;
end;
{ ------------------------------------------------------------------- }
function  LbBiCompare(N1 : LbInteger; N2 : LbInteger): Shortint;
var
  cnt : Integer;
begin
  LbBiTrimSigZeros( N1 );
  LbBiTrimSigZeros( N2 );
  if (N1.bSign <> N2.bSign) then begin
    if (N1.bSign = cPOSITIVE) then
      Result := cGREATER_THAN
    else
      Result := cLESS_THAN;
    exit;
  end;

  if (N1.dwUsed <> N2.dwUsed) then begin
    if (N1.dwUsed > N2.dwUsed) then begin
      Result := cGREATER_THAN;
      exit;
    end else begin
      Result := cLESS_THAN;
      exit;
    end;
  end;

  cnt := N1.dwUsed;
  while pBiByteArray( N1.IntBuf.pBuf )[pred(cnt)] =
        pBiByteArray( N2.IntBuf.pBuf )[pred(cnt)] do begin
    dec(cnt);
    if (cnt = 0) then begin
      Result := cEQUAL_TO;
      exit;
    end;
  end;

  if pBiByteArray( N1.IntBuf.pBuf )[pred(cnt)] >
     pBiByteArray( N2.IntBuf.pBuf )[pred(cnt)] then
    Result := cGREATER_THAN
  else
    Result := cLESS_THAN;
end;
{ ------------------------------------------------------------------- }
function  LbBiAbs(N1 : LbInteger; N2 : LbInteger): Shortint;
var
  cnt : Integer;
begin
  LbBiTrimSigZeros(N1);
  LbBiTrimSigZeros(N2);

  if (N1.dwUsed <> N2.dwUsed) then begin
    if (N1.dwUsed > N2.dwUsed) then begin
      Result := cGREATER_THAN;
      exit;
    end else begin
      Result := cLESS_THAN;
      exit;
    end;
  end;

  cnt := N1.dwUsed;
  while pBiByteArray( N1.IntBuf.pBuf )[pred(cnt)] =
        pBiByteArray( N2.IntBuf.pBuf )[pred(cnt)] do begin
    dec(cnt);
    if (cnt = 0) then begin
      Result := cEQUAL_TO;
      exit;
    end;
  end;

  if pBiByteArray( N1.IntBuf.pBuf )[pred(cnt)] >
     pBiByteArray( N2.IntBuf.pBuf )[pred(cnt)] then 
    Result := cGREATER_THAN
  else
    Result := cLESS_THAN;
end;
{ ------------------------------------------------------------------- }
function LbBiIsZero(N1 : LbInteger) : Boolean;
begin
  LbBiTrimSigZeros( N1 );
  Result := False;
  if (N1.dwUsed = 1) and (pBiByteArray( N1.IntBuf.pBuf )[0] = 0) then
    Result := True
end;
{ ------------------------------------------------------------------- }
function LbBiIsOne(N1 : LbInteger) : Boolean;
begin
  LbBiTrimSigZeros( N1 );
  Result := False;
  if (N1.dwUsed = 1) and (pBiByteArray( N1.IntBuf.pBuf )[0] = 1) then
    Result := True
end;
{ ------------------------------------------------------------------- }
function LbBiIsOdd(N1 : LbInteger): Boolean;
begin
  Result := odd(LbBiGetByteValue(N1, 1));
end;
{ ------------------------------------------------------------------- }
function LbBiIsEven(N1 : LbInteger): Boolean;
begin
  Result := not (odd(LbBiGetByteValue(N1, 1)));
end;
{ ------------------------------------------------------------------- }
procedure LbBiSwap(var N1 : LbInteger; var N2 : LbInteger);
var
  tmp : LbInteger;
begin
  tmp.bSign := N1.bSign;                                         {!!.01}
  tmp.dwUsed := N1.dwUsed;                                       {!!.01}