1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:

Function Primzahlanzahl( N:integer ):integer;
var r, p:integer;
function isprime(n:integer):Boolean;
var i,w:integer;
    teiler:boolean;
begin
   if n = 1 then begin
     isprime:=false; exit;
   end;
   if n in [2,3,5,7,11,13] then begin
     isprime:=true; exit;
   end;
   if odd(n) then begin
     if n mod 3 = 0 then begin
       isprime:=false; exit;
     end;
     if n mod 5 = 0 then begin
       isprime:=false; exit;
     end;
     if n mod 7 = 0 then begin
       isprime:=false; exit;
     end;
     if n mod 11 = 0 then begin
       isprime:=false; exit;
     end;
     i:=13;
     w:=trunc(sqrt(n)+1);
     if w<13 then
     begin
       isprime:=true;
       exit;
     end;
     repeat
       teiler:=(n mod i = 0);
       inc(i,2);
     until teiler or (i>w);
     isprime:=not teiler;
   end
   else isprime:=false;
end;
Function Entfernen( n,p: integer):integer;
var nklein, p2, d: integer;
begin
    nklein := n div p;
    if nklein<p then
    begin
       Entfernen:=1;
       exit
    end;
    d := nklein;
    for p2:=2 to p-1 do
       if IsPrime(p2) then
          d := d - Entfernen(nklein,p2);
    Entfernen:=d
end;
begin
    r := N-1;
    for p:=2 to n do
       if p*p>n then
       begin
          Primzahlanzahl := r;
          exit
       end
       else
          if IsPrime(p) then
          begin
             r := r - Entfernen(n,p);
             r := r+1;
          end;
    Primzahlanzahl := r;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

PS ...\Primgen 1> Measure-Command {start-process Project1 -Wait}

Days              : 0
Hours             : 0
Minutes           : 0
Seconds           : 45
Milliseconds      : 590
Ticks             : 455905584
TotalDays         : 0,0005276685
TotalHours        : 0,012664044
TotalMinutes      : 0,75984264
TotalSeconds      : 45,5905584
TotalMilliseconds : 45590,5584					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

Procedure DoIt;
Var
  i,j : Integer;
  Buf : pABuffer;
  pq, Nexti : pCardinal;
  k,q,kPos,bits,data : Cardinal;

Begin
  fillChar (a,sizeOf (a), 0);
  For i:=0 to 7 do begin
    Nexti := @next[i];
    Buf := @a[i];
    pq := @qtab[0];
    For j:=0 to 3508 do Begin
      k := nexti^;
      if (k < ccBlockLen) Then Begin
        q := pq^;
        Repeat
          kPos := k shr 5;
          buf^[kPos] := buf^[kPos] or (1 shl (k and 31));
          inc (k,q);
        Until k >= ccBlockLen;
        End;
      nexti^ := k - ccBlockLen;  inc (pq);
      inc (nexti);
      End;
    End;
End;					

1:
2:
3:

X:\TMP>T_PS.EXE
Zeit [s]: 0.214
5000000-te Primzahl = 86028121					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

uses
  mp_prime;
var
  sieve: TSieve;
  np,n,p: longint;
begin
  prime_sieve_init(sieve,2);
  np := 5000000;
  for n:=1 to np do begin
    p := prime_sieve_next(sieve);
  end;
  writeln(np,'-te Primzahl = ',p);
end.					

1:
2:

bis  100 Millionen: Dein Original 0.318s,   meine V3: 0.048
bis 1000 Millionen: Dein Original 3.437s,   meine V3: 0.422					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:

program t_psv3;

{$i STD.INC}
{$i mp_conf.inc}

{$x+}  {pchar I/O}
{$i+}  {RTE on I/O error}

{$ifdef APPCONS}
  {$apptype console}
{$endif}

{$ifndef FPC}
{$N+}
{$endif}

uses
  HRTimer,
  mp_prime;


{---------------------------------------------------------------------------}
function remove(n,p: longint):longint;
var
  d: longint;
  k: integer;
  w: word;
begin
  {Basiert auf function Entfernen aus Mathematiker-Beitrag in}
  {<http://www.entwickler-ecke.de/viewtopic.php?t=109633>}
  n := n div p;
  if n<p then remove := 1
  else begin
    d := n;
    for k:=1 to NumPrimes16 do begin
      w := Primes16[k];
      if w+1 > p then break;
      d := d - remove(n,w);
    end;
    remove := d;
  end;
end;

{---------------------------------------------------------------------------}
function primepi(n: longint): longint;
  {-Returns the prime counting function pi(n) = #{p <= n, p prime}
var
  r: longint;
  k: integer;
  p: word;
  w: word;
begin
  r := n-1;
  if n > 2 then begin
    w := trunc(sqrt(n));
    for k:=1 to NumPrimes16 do begin
      p := Primes16[k];
      if p > w then break;
      r := succ(r) - remove(n,p);
    end;
  end;
  primepi := r;
end;

var
  np,n: longint;
  HR: THRTimer;
begin
  writeln('-----------------------');
  np := 2100000000;
  StartTimer(HR);
  n := primepi(np);
  writeln('Zeit [s]: ',ReadSeconds(HR):1:3);
  writeln('V3 PrimePi(',np,') = ',n);
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:

  nsmall := n div p;
  if nsmall<p then  begin
    DismissedBy :=1;
    exit
    end;
  d := nsmall; 
  for p2:=2 to p-1 do
      if IsPrime(p2) then
          d := d - DismissedBy( nsmall, p2 );