qow 14: prime number dismantling

Btw, it would be more interesting to have this for values up to 2^30 or so. Because that's when inefficient algorithms will start being slower...

this is my collection of stuff regarding this supbject, your question will be awnserd with the p-row functions p-pow stands for prime-row

() =1
(1) = 2
(0,1) =3
(0,0,1) =5


unit Udw6;

interface

Uses sysutils,math,primes;

Type
    TProw = Array of Byte;
    TNumberRow = Array of Cardinal;
    EFactorizeException = class(Exception);
    TLargeNumber = class
    private
      FNumber : TNumberRow;
    public
      Constructor Create(Number : String);
    end;

Function IsPrime(N: Cardinal): Boolean; register;
Function LargestKnownPrime : Cardinal;
Function NumberToPRow(a : Cardinal):TProw;
Function PRowToString(PRow:TProw):String;
Function IsDevider(Number,devisor:Cardinal):Boolean;
Function PRowToNumber(PRow:TProw):Cardinal;
Function CommonMultiple(a,b:Cardinal):Cardinal;
Function CommonDenominator(a,b:Cardinal):Cardinal;
Function CommonDenominator_1(a,b:Cardinal):Cardinal;
Function Euler(a:Cardinal):Cardinal;



//function CommonDenominator(a,b: Cardinal) : Cardinal;


implementation

function IsPrime(N: Cardinal): Boolean; register;
// test if N is prime, do some small Pseudo Prime test in certain bounds
// copyright (c) 2000 Hagen Reddmann, don't remove
asm
      TEST  EAX,1           // Odd(N) ??
      JNZ   @@1
      CMP   EAX,2           // N == 2 ??
      SETE  AL
      RET
@@1:   CMP   EAX,73           // N  < 73 ??
      JB    @@C
      JE    @@E           // N == 73 ??
      PUSH  ESI
      PUSH  EDI
      PUSH  EBX
      PUSH  EBP
      PUSH  EAX           // save N as Param for @@5
      LEA   EBP,[EAX - 1]    // M == N -1, Exponent
      MOV   ECX,32           // calc remaining Bits of M and shift M'
      MOV   ESI,EBP
@@2:   DEC   ECX
      SHL   ESI,1
      JNC   @@2
      PUSH  ECX           // save Bits as Param for @@5
      PUSH  ESI           // save M' as Param for @@5
      CMP   EAX,08A8D7Fh     // N >= 9080191 ??
      JAE   @@3
// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime
      MOV   EAX,31
      CALL  @@5           // 31^((N-1)(2^s)) mod N
      JC    @@4
      MOV   EAX,73           // 73^((N-1)(2^s)) mod N
      PUSH  OFFSET @@4
      JMP   @@5
// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime
@@3:   MOV   EAX,2
      CALL  @@5
      JC    @@4
      MOV   EAX,7
      CALL  @@5
      JC    @@4
      MOV   EAX,61
      CALL  @@5
@@4:   SETNC AL
      ADD   ESP,4 * 3
      POP   EBP
      POP   EBX
      POP   EDI
      POP   ESI
      RET
// do a Strong Pseudo Prime Test
@@5:   MOV   EBX,[ESP + 12]   // N on stack
      MOV   ECX,[ESP +  8]   // remaining Bits
      MOV   ESI,[ESP +  4]   // M'
      MOV   EDI,EAX           // T = b, temp. Base
@@6:   DEC   ECX
      MUL   EAX
      DIV   EBX
      MOV   EAX,EDX
      SHL   ESI,1
      JNC   @@7
      MUL   EDI
      DIV   EBX
      AND   ESI,ESI
      MOV   EAX,EDX
@@7:   JNZ   @@6
      CMP   EAX,1           // b^((N -1)(2^s)) mod N ==  1 mod N ??
      JE    @@A
@@8:   CMP   EAX,EBP           // b^((N -1)(2^s)) mod N == -1 mod N ?? , EBP = N -1
      JE    @@A
      DEC   ECX           // second part to 2^s
      JNG   @@9
      MUL   EAX
      DIV   EBX
      CMP   EDX,1
      MOV   EAX,EDX
      JNE   @@8
@@9:   STC
@@A:   RET
@@B:   DB    3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71
@@C:   MOV   EDX,OFFSET @@B
      MOV   ECX,18
@@D:   CMP   AL,[EDX + ECX]
      JE    @@E
      DEC   ECX
      JNL   @@D
@@E:   SETE  AL
end;

Function IsDevider(Number,devisor:Cardinal):Boolean;
Begin
  Result := Number mod devisor = 0;
End;

Function LargestKnownPrime : Cardinal;
Begin
  Result := PrimeTable[CPrimeLast];
End;

Function NumberToPRow(a : Cardinal):TProw;
Var Prow : TPRow;
    Pindex : Integer;

Begin
  Pindex:=1;
  SetLength(Prow,0);
  While not(a=1) Do
  Begin
    SetLength(Prow,Pindex);
    If (a mod PrimeTable[Pindex]) = 0 Then
    Begin
      a := a div PrimeTable[Pindex];
      Inc(Prow[Pindex-1]);
    End Else
    Begin
      Pindex := Pindex+1;
      if (Pindex=CPrimeLast) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    End;
  End;
  result := Prow;
End;

Function PRowToNumber(PRow:TProw):Cardinal;
var r,i,j:Cardinal;
Begin
  r:=1;
  i:=0;
  While i<length(Prow) Do
  Begin
    inc(i);
    if (Prow[i-1])>0 then
    Begin
      j:=0;
      while not (Prow[i-1] = j) do
      Begin
        r:=r *  PrimeTable[i];
        inc(j);
      end;
    end;
  End;
  result := r;
End;

Function PRowToString(PRow:TProw):String;
Var     I:Integer;
        S:String;
Begin
  s:='(';
  For i:=0 to Length(PRow)-1 Do
    s := s + IntToStr(Prow[i])+',';
  delete(s,length(s),1);
  s := s+')';
  result := s;
End;

Function CommonDenominator(a,b:Cardinal):Cardinal;
Begin
  while (a>0) and (b>0) do
  Begin
    if a>b then
      a := a - b
    else
      b := b - a;
  end;
  if a=0 then
    result := b
  else
    result := a;
End;

Function CommonDenominator_1(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := min(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := 0
      else
        Pc[i] := 0;
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

Function Euler(a:Cardinal):Cardinal;
var t,i:Cardinal;
Begin
  t:=0;i:=0;
  while i<a do
  Begin
    if commonDenominator(i,a) = 1 then inc(t);
    inc(i);
  end;
  result := t;
End;

Function CommonMultiple(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := max(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := Pa[i]
      else
        Pc[i] := Pb[i];
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

//TLargeNumber

Constructor TLargeNumber.Create(Number : String);
Var pos,x : Cardinal;
    l,t:Cardinal;
Begin
  //Max       0..999999999 [9 char]
  //Cardinal      0..4294967295      unsigned 32-bit

  l := Length(Number);
  T := (l div 6) + 1; //calculate how many cardinals are nessesary
  SetLength(FNumber,t);

  pos :=0;
  While l>5 Do
  Begin
    x := StrToInt(Copy(Number,pos,5));
    Inc(Pos,5);
    Fnumber[t] := x;
    Dec(T);
    Dec(l,5);
  End;

  If l>0 Then
  Begin
    x := StrToInt(Copy(Number,1,l));
    Fnumber[T] := x;
  End;

End;

end.


btw i made an unit of constants

unit primes;
interface
Const
  CPrimeLast = 78498;

  PrimeTable : array[1..CPrimeLast] of cardinal =(
      2,3,5,7,11,13,17,
      19,23,29,31,37,41,43,
      47,53,59,61,67,71,73,
      79,83,89,97,101,103,107,
      109,113,127,131,137,139,149,
etc..
etc..
etc..

  999983);

i could mail the file (ziped) to you if you want..

well, ok, NEW upper limit := maxlongint

hopefully, some more will join this quest

meikl ;-)

yep, god ares,
mail it to me at
info@meikl.de

because i must test the performance
(two solutions at the moment)
(i may ignore the new limit for you, as i see there is a constant prime-number-array defined there, which may not high enough)

send it, god ares

meikl ;-)

It isn't speed optimized due to embedded pretty output formatting ;)


procedure TForm1.Button2Click(Sender: TObject);
var
        PrList:Tlist;
        MulList:TStringList;
        i,Num,Temp,MaxPrime:integer;
        s:string;
        N:integer;
begin
N:=10000;
PrList:=Tlist.Create;
PrList.Capacity:=100;
MulList:=TStringList.Create;
MulList.Capacity:=N;
for Num:=2 to N do begin
  Temp:=Num;
  MaxPrime:=2;
  s:=IntToStr(Temp)+'=';
  i:=-1;
  while (Temp >= MaxPrime) and (i<PrList.Count-1) do begin
    inc(i);
    while (Temp >= MaxPrime) and (Temp mod Integer(PrList[i])=0) do begin
        MaxPrime:=Integer(PrList[i]);
        Temp:=Temp Div MaxPrime;
        s:=s+IntToStr(MaxPrime)+'*';
     end;
  end;
  if Temp=Num then begin
     PRList.Add(Pointer(Num));
     s:=s+'Prime';
     end
   else Delete(s,Length(s),1);
   MulList.add(s);
end;
PrList.Free;
MulList.SaveToFile('C:\Primes.txt');
MulList.Free;
end;

Ah, if you mean calculating not only one out of 1 to 10000 but all, use the following code:

function GetFactor(N: Integer): Integer;
const
     KnownPrimes: array[0..24] of Cardinal=(2,3,5,7,$B,$D,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97);
var
     I: Integer;
begin
     I:=Low(KnownPrimes);
     repeat
          if (N mod KnownPrimes[I])=0 then begin
               Result:=KnownPrimes[I];
               Exit;
          end;
          Inc(I);
     until I>High(KnownPrimes);
     Result:=N;
end;

function GetFactorString(N: Integer): string;
var
     F: Integer;
begin
     Result:=Format('%:5d = ',[N]);
     repeat
          F:=GetFactor(N);
          if F=N then begin
               Result:=Result+IntToStr(F);
               Exit;
          end else
               Result:=Result+IntToStr(F)+' * ';
          N:=N div F;
     until False;
end;

var
     I: integer;
     S: string;

begin
     for I:=1 to 10000 do begin
          S:=GetFactorString(I);
//          WriteLn(S);
     end;
     WriteLn('Done!');
     ReadLn;
end.

I commented out the WriteLn to allow measuring the speed of the computations (vs the speed of the display output *g*). Of course, you can uncomment it to veryfy the correctness of the string contents.

i guezz i should make a thread that calculates primes while running and make a nice data structure to store it. anyway i'm stuck to the limit of high(cardinal), I'm working on a !!!BIG!!! number structure..

shurl i'll lose but this may be code that other may improve on, or just (re*)-steal and use.

* i'v "stolen" isPrine(Cardinal)

seems i've much to do testing :-)

well, seems also that avonwyss got this q
(because as first, but i must check the result first)

well,
which code will be the fastest,
and gets the additional points?

i keep this q open until next friday,
so that all can tuning their codes
and others may join until then :-)

first performance tests this evening (in ~8 hours from now),
i will provide an intermediate resultlist then :-))

meikl ;-)

Well. For a greater range, actually for *any* number up to 9223372036854775807, I propose the following:

Include file with precomputed primes: http://web.bsn.ch/avonwyss/primes.inc

function GetFactor(N: Int64): Int64;
const
     KnownPrimes: array[0..102537] of Cardinal=({$I PRIMES.INC});
var
     I: Integer;
     M,J,Act: Cardinal;
     N64: Int64 absolute N;
     N32: Cardinal absolute N;
     NC: Comp absolute N;
begin
     I:=0;
     Act:=2;
     M:=Trunc(Sqrt(NC));
     if M<65536 then begin
          J:=N32;
          while (Act<=M) and (J mod Act>0) do begin //32 bit divisions
               Act:=KnownPrimes[I];
               Inc(I);
          end;
     end else begin
          if M>=KnownPrimes[High(KnownPrimes)] then
               J:=KnownPrimes[High(KnownPrimes)-1]
          else
               J:=M;
          while (Act<=J) and (N64 mod Act>0) do begin //64 bit divisions
               Act:=KnownPrimes[I];
               Inc(I);
          end;
          if Act<=M then begin
               J:=(3-(Act mod 3))*2;
               while (Act<=M) and (N64 mod Act>0) do begin //64 bit divisions without primes, avoiding 2 or 3-dividers
                    Inc(Act,J);
                    J:=6-J;
               end;
          end;
     end;
     if Act>M then // factor found?
          Result:=N
     else
          Result:=Act;
end;

function GetFactorString(N: Int64): string;
var
     F: Int64;
begin
     Result:=Format('%d = ',[N]);
     repeat
          F:=GetFactor(N);
          if F=N then begin
               Result:=Result+IntToStr(F);
               Exit;
          end else
               Result:=Result+IntToStr(F)+' * ';
          N:=N div F;
     until False;
end;

:-)

well, an array of known prime-numbers,
which contains all until maxlongint,
will push performance, of course :-))

(maybe a new quest?
a list/array a prime numbers until maxlongint is needed,
how to build it at runtime?)

meikl ;-)

(maybe a new quest?
a list/array a prime numbers until maxlongint is needed,
how to build it at runtime?)

= ongoing progress...

Well, with the include file I use, there are about 400 kbyte worth of primes... :-))
That's already a good starting point...

To all: I respectfully give up..

i would like to leave this link :

http://www.mail-archive.com/cryptography%40wasabisystems.com/msg01830.html

:-(
god ares, why give up?

interested

sorry,
had no time for testing this evening,
family catched me before :-(

tomorrow evening,
i will post the first results (hopefully)

meikl ;-)

k done it...
i'm running a thread that makes the primetable on the run (linkedList)..
i'm dumping all code to kretzschmar.

unit Udw6;

interface

Uses sysutils,math,primes,classes;

Type
    TProw = Array of Byte;
    TNumberRow = Array of Cardinal;
    EFactorizeException = class(Exception);
    PPrimeList = ^TPrimeList;
    TPrimeList = record
                   prime : Cardinal;
                   nr    : Cardinal;
                   pref  : PPrimeList;
                   next  : PPrimeList;
                 end;


    TLargeNumber = class //not operational
    private
      FNumber : TNumberRow;
    public
      Constructor Create(Number : String);
    end;

    TPrimeThread = class(TThread)
    private
      fTestNumber : Cardinal;
      fprimeNr : Cardinal;
      fWork : PPrimeList;
    protected
      procedure Execute; override;
    public
      Constructor Create(first : PPrimeList);
      Destructor Destroy; override;
    end;

Function IsPrime(N: Cardinal): Boolean; register;
Function LargestKnownPrime : Cardinal;
Function NumberToPRow(a : Cardinal):TProw;
Function PRowToString(PRow:TProw):String;
Function IsDevider(Number,devisor:Cardinal):Boolean;
Function PRowToNumber(PRow:TProw):Cardinal;
Function CommonMultiple(a,b:Cardinal):Cardinal;
Function CommonDenominator(a,b:Cardinal):Cardinal;
Function CommonDenominator_1(a,b:Cardinal):Cardinal;
Function Euler(a:Cardinal):Cardinal;
Function FindPrime(nr:Cardinal):Cardinal;

//function CommonDenominator(a,b: Cardinal) : Cardinal;
var PrimeThread : TPrimeThread;


implementation

var last,first : PPrimeList;

function IsPrime(N: Cardinal): Boolean; register;
// test if N is prime, do some small Pseudo Prime test in certain bounds
// copyright (c) 2000 Hagen Reddmann, don't remove
asm
      TEST  EAX,1           // Odd(N) ??
      JNZ   @@1
      CMP   EAX,2           // N == 2 ??
      SETE  AL
      RET
@@1:   CMP   EAX,73           // N  < 73 ??
      JB    @@C
      JE    @@E           // N == 73 ??
      PUSH  ESI
      PUSH  EDI
      PUSH  EBX
      PUSH  EBP
      PUSH  EAX           // save N as Param for @@5
      LEA   EBP,[EAX - 1]    // M == N -1, Exponent
      MOV   ECX,32           // calc remaining Bits of M and shift M'
      MOV   ESI,EBP
@@2:   DEC   ECX
      SHL   ESI,1
      JNC   @@2
      PUSH  ECX           // save Bits as Param for @@5
      PUSH  ESI           // save M' as Param for @@5
      CMP   EAX,08A8D7Fh     // N >= 9080191 ??
      JAE   @@3
// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime
      MOV   EAX,31
      CALL  @@5           // 31^((N-1)(2^s)) mod N
      JC    @@4
      MOV   EAX,73           // 73^((N-1)(2^s)) mod N
      PUSH  OFFSET @@4
      JMP   @@5
// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime
@@3:   MOV   EAX,2
      CALL  @@5
      JC    @@4
      MOV   EAX,7
      CALL  @@5
      JC    @@4
      MOV   EAX,61
      CALL  @@5
@@4:   SETNC AL
      ADD   ESP,4 * 3
      POP   EBP
      POP   EBX
      POP   EDI
      POP   ESI
      RET
// do a Strong Pseudo Prime Test
@@5:   MOV   EBX,[ESP + 12]   // N on stack
      MOV   ECX,[ESP +  8]   // remaining Bits
      MOV   ESI,[ESP +  4]   // M'
      MOV   EDI,EAX           // T = b, temp. Base
@@6:   DEC   ECX
      MUL   EAX
      DIV   EBX
      MOV   EAX,EDX
      SHL   ESI,1
      JNC   @@7
      MUL   EDI
      DIV   EBX
      AND   ESI,ESI
      MOV   EAX,EDX
@@7:   JNZ   @@6
      CMP   EAX,1           // b^((N -1)(2^s)) mod N ==  1 mod N ??
      JE    @@A
@@8:   CMP   EAX,EBP           // b^((N -1)(2^s)) mod N == -1 mod N ?? , EBP = N -1
      JE    @@A
      DEC   ECX           // second part to 2^s
      JNG   @@9
      MUL   EAX
      DIV   EBX
      CMP   EDX,1
      MOV   EAX,EDX
      JNE   @@8
@@9:   STC
@@A:   RET
@@B:   DB    3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71
@@C:   MOV   EDX,OFFSET @@B
      MOV   ECX,18
@@D:   CMP   AL,[EDX + ECX]
      JE    @@E
      DEC   ECX
      JNL   @@D
@@E:   SETE  AL
end;

Function IsDevider(Number,devisor:Cardinal):Boolean;
Begin
  Result := Number mod devisor = 0;
End;

Function LargestKnownPrime : Cardinal;
Begin
  Result := last^.prime;
End;

Function NumberToPRow(a : Cardinal):TProw;
Var Prow : TPRow;
    Pindex : Integer;
    Prime : Cardinal;
    UsingList : PPrimeList;

Begin
  Pindex:=1;
  SetLength(Prow,0);
  UsingList := first;
  While not(a=1) Do
  Begin
    SetLength(Prow,Pindex);

    if Pindex <=CPrimeLast then
      Prime := PrimeTable[Pindex]
    else
    Begin
      Prime := UsingList^.prime;
      Usinglist := Usinglist^.next;
      if (UsingList = nil) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    end;
    If (a mod Prime) = 0 Then
    Begin
      a := a div PrimeTable[Pindex];
      Inc(Prow[Pindex-1]);
    End Else
    Begin
      Pindex := Pindex+1;
      if (Pindex=last^.nr) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    End;
  End;
  result := Prow;
End;

Function PRowToNumber(PRow:TProw):Cardinal;
var r,i,j:Cardinal;
Begin
  r:=1;
  i:=0;
  While i<length(Prow) Do
  Begin
    inc(i);
    if (Prow[i-1])>0 then
    Begin
      j:=0;
      while not (Prow[i-1] = j) do
      Begin
        r:=r *  PrimeTable[i];
        inc(j);
      end;
    end;
  End;
  result := r;
End;

Function PRowToString(PRow:TProw):String;
Var     I:Integer;
        S:String;
Begin
  s:='(';
  For i:=0 to Length(PRow)-1 Do
    s := s + IntToStr(Prow[i])+',';
  delete(s,length(s),1);
  s := s+')';
  result := s;
End;

Function CommonDenominator(a,b:Cardinal):Cardinal;
Begin
  while (a>0) and (b>0) do
  Begin
    if a>b then
      a := a - b
    else
      b := b - a;
  end;
  if a=0 then
    result := b
  else
    result := a;
End;

Function CommonDenominator_1(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := min(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := 0
      else
        Pc[i] := 0;
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

Function Euler(a:Cardinal):Cardinal;
var t,i:Cardinal;
Begin
  t:=0;i:=0;
  while i<a do
  Begin
    if commonDenominator(i,a) = 1 then inc(t);
    inc(i);
  end;
  result := t;
End;

Function CommonMultiple(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := max(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := Pa[i]
      else
        Pc[i] := Pb[i];
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

//TLargeNumber

Constructor TLargeNumber.Create(Number : String);
Var pos,x : Cardinal;
    l,t:Cardinal;
Begin
  //Max       0..999999999 [9 char]
  //Cardinal      0..4294967295      unsigned 32-bit

  l := Length(Number);
  T := (l div 6) + 1; //calculate how many cardinals are nessesary
  SetLength(FNumber,t);

  pos :=0;
  While l>5 Do
  Begin
    x := StrToInt(Copy(Number,pos,5));
    Inc(Pos,5);
    Fnumber[t] := x;
    Dec(T);
    Dec(l,5);
  End;

  If l>0 Then
  Begin
    x := StrToInt(Copy(Number,1,l));
    Fnumber[T] := x;
  End;

End;


Constructor TPrimeThread.Create(first : PPrimeList);
Begin

  inherited create(false);
  fTestNumber := PrimeTable[CPrimeLast];
  fprimeNr := first.nr;
  fWork := first;
End;

Procedure TPrimeThread.Execute;
var newP : PPrimeList;
Begin
  while Not((fTestNumber = 4294967295)) do
  Begin
    fTestNumber := fTestNumber + 2; //only odds qualify above 2
    if IsPrime(fTestNumber) then
    Begin
      fprimeNr := fprimeNr + 1;
      new(newP);                   //prepare new
      newP^.pref := fwork;
      newP^.nr := fprimeNr;
      newP^.prime := 0;            //prime not found

      fwork^.prime := fTestNumber; //save number
      fwork^.next := newP;         //make chain

      last := fwork;               //set new work unit
      fwork := newP;
    end;
  End;
End;

Destructor TPrimeThread.Destroy;
Var Pl : PPrimeList;
Begin

  //destroy prime list
  dispose(fWork);
  While Not (last^.pref = nil) Do
  Begin
    pl := Last^.pref;
    Dispose(last);
    last := pl;
  End;

  inherited;
end;

Function FindPrime(nr:Cardinal):Cardinal;
var find:PPrimeList;
Begin

  if nr <= CPrimeLast then
    result := PrimeTable[nr]
  else
  Begin
    find := first;
    while not ((find=nil) or (find^.nr = nr)) do
    Begin
      find := find^.next;
    end;
    if find = nil then
      result := 0 //not found
    else
      result := find^.prime;

  end;

end;


Begin
  new(first);
  first^.nr := CPrimeLast+1;
  PrimeThread := TPrimeThread.Create(first);  //create and GO!
  last := nil;
end.

function is suitable for cardinals

remeber (prime1 * prime2) could be > High(Cardinal)

well thanks god ares, got it

to all,
but it seems i have to do the tests coming weekend,
because i've just to do other things :-(

be patient

meikl ;-)

for the first solution

god_ares/MBo watch out for your q's
(didn't got the time for a performance test,
thats why i grade every, which are provising a solution,
but i guess god_ares code is the fastest)

thanks to all for participating on this quest
watch out for the next qow today
(also a mathematical problem)

meikl ;-)

hi all,

just another way :-)

var
  // after calling ResetNoPrimes this array
  // contains True for Prime indexes
  X: array [1..10000] of Boolean;

procedure ResetNoPrimes;
var
  I, J: Integer;
begin
  FillChar(X, SizeOf(X), True);
  for I := 2 to High(X) do
    for J := 2 to High(X) do
      if I * J <= High(X) then
        X[I * J] := False;
end;