get_primes7 - Free Pascal version

type
  IntArray = array of integer;

procedure generate(var Res: IntArray; Start: Integer; Cnt: Integer; Step: integer);
var
  Idx: integer;
  CurrVal: Integer;
begin
  Idx := 0;
  CurrVal := Start;
  while (Idx < Cnt) do
  begin
     Res[Idx] := CurrVal;
     Inc(CurrVal, Step);
     Inc(Idx);
  end;
end;

procedure get_primes7(n: integer; var res: IntArray);
var
  cnt: integer;
  s: IntArray;
  mroot: Integer;
  half: Integer;
  i: Integer;
  m: Integer;
  j: Integer;
  CurrLen, FoundCnt: Integer;
begin
  SetLength(res, 0);
  if n < 2 then exit;

  if n = 2 then
  begin
    SetLength(res, 1);
    res[0] := 2;
    exit;
  end;

  cnt := round((n - 3 + 2)/2);
  SetLength(s, cnt);

  generate(s, 3, cnt, 2);

  mroot := round(sqrt(n));
  half := Length(s);
  i := 0;
  m := 3;

  while (m <= mroot) do
  begin
    if s[i] > 0 then
    begin
      j := round((m * m - 3) / 2);
      s[j] := 0;
      while (j < half) do
      begin
        s[j] := 0;
        Inc(j, m);
      end;
    end;

    Inc(i);
    m := 2 * i + 3;
  end;


  CurrLen := 1;
  FoundCnt := 1;
  SetLength(res, CurrLen);
  res[0] := 2;
  for i := 0 to cnt - 1 do
  begin
    if s[i] > 0 then
    begin
      if FoundCnt = CurrLen then
      begin
        // Realokacja
        CurrLen := round((CurrLen * 15) / 10);
        SetLength(res, CurrLen);
      end;
      res[FoundCnt] := s[i];
      Inc(FoundCnt);
    end;
  end;
  SetLength(res, FoundCnt);
end;

procedure RunTest;
var
  Res: IntArray;
  i: Integer;
begin
  for i := 1 to 50 do
  begin
    get_primes7(1000000, res);
    writeln('Found ', Length(res), ' prime numbers.');
  end;
end;