I may have increased the Delphi performance by 45%

[thebugger2000]

Check it out and see if i'm correct

program Project6;

{$APPTYPE CONSOLE}

uses
	System.SysUtils,
	Classes,
	System.Generics.Collections,
	System.Timespan,
	Math,
  Windows,
  System.DateUtils;

type
	TPrimeSieve = record
	private
		FSieveSize: Integer;
		FBitArray: array of ByteBool; //ByteBool: 4644. WordBool: 4232. LongBool: 3673
		FMyDict: TDictionary<Integer, Integer>;

		function GetBit(Index: Integer): Boolean; inline;
		procedure ClearBit(Index: Integer); inline;
		procedure InitializeBits;
	public
		constructor Create(Size: Integer);
    procedure Free;

		procedure RunSieve; // Calculate the primes up to the specified limit

		function CountPrimes: Integer;
		function ValidateResults: Boolean;

		procedure PrintResults(ShowResults: Boolean; Duration: Double; Passes: Integer);
	end;

{ TPrimeSieve }

constructor TPrimeSieve.Create(Size: Integer);
begin
//	inherited Create;

	FSieveSize := Size;

	//The optimization here is that we only store bits for *odd* numbers.
	// So FBitArray[3] is if 3 is prime
	// and FBitArray[4] is if 5 is prime
	//GetBit and SetBit do the work of "div 2"
	SetLength(FBitArray, (FSieveSize+1) div 2);
	InitializeBits;

	FMyDict := TDictionary<Integer, Integer>.Create;

	// Historical data for validating our results - the number of primes
	// to be found under some limit, such as 168 primes under 1000
	FMyDict.Add(       10, 4); //nobody noticed that 1 is wrong? [2, 3, 5, 7]
	FMyDict.Add(      100, 25);
	FMyDict.Add(     1000, 168);
	FMyDict.Add(    10000, 1229);
	FMyDict.Add(   100000, 9592);
	FMyDict.Add(  1000000, 78498);
	FMyDict.Add( 10000000, 664579);
	FMyDict.Add(100000000, 5761455);
end;

procedure TPrimeSieve.Free;
begin
	FreeAndNil({var}FMyDict);

	inherited;
end;

function TPrimeSieve.CountPrimes: Integer;
var
	count: Integer;
	i: Integer;
begin
	count := 0;
	for i := 0 to High(FBitArray) do
	begin
		if FBitArray[i] then
			Inc(count);
	end;

	Result := count;
end;

function TPrimeSieve.ValidateResults: Boolean;
begin
	if FMyDict.ContainsKey(FSieveSize) then
		Result := FMyDict[FSieveSize] = Self.CountPrimes
	else
		Result := False;
end;

function TPrimeSieve.GetBit(Index: Integer): Boolean;
begin
	Result := (Index and $1 <> 0) and FBitArray[Index SHR 1];
end;

procedure TPrimeSieve.InitializeBits;
var
	i: Integer;
	remaining: Integer;
begin
	remaining := Length(FBitArray);
  FillChar(FBitArray[0],remaining*Sizeof(FBitArray[0]),Ord(True));
end;

procedure TPrimeSieve.ClearBit(Index: Integer);
begin
{
	Profiling shows 99% of the execution is spent here in ClearBit.

	Testing index using and 1:        4387 passes
	Testing index using mod 2:        4644 passes
			WriteLine with inline text: 4644 passes
			WriteLine with const  text: 4636 passes
			No WriteLine:               4840 passes
	Omit testing of index:            5280 passes

	Which is surprising, as you'd think the branch predictor would realize this branch is **never** taken.
}
	if (Index and $1) = 0 then
	begin
//		Writeln('You are setting even bits, which is sub-optimal');
		Exit;
	end;

	//Any compiler worth its salt converts "div 2" into "shr 1".
	//In this case Delphi is worth it's salt; emitting "sar".
	//(But don't forget: Delphi still can't hoist loop variables)
	FBitArray[Index SHR 1] := False;
end;


procedure TPrimeSieve.RunSieve;
var
	factor: Integer;
	q: Integer;
	num: Integer;
begin
	factor := 3;
	q := Floor(Sqrt(FSieveSize));

	while (factor <= q) do
	begin
		for num := factor to FSieveSize do
		begin
			if GetBit(num) then
			begin
				factor := num;
				Break;
			end;
		end;

		// If marking factor 3, you wouldn't mark 6 (it's a mult of 2) so start with the 3rd instance of this factor's multiple.
		// We can then step by factor * 2 because every second one is going to be even by definition
		num := factor*3;
		while num <= FSieveSize do
		begin
			ClearBit(num);
			Inc(num, factor*2);
		end;

		Inc(factor, 2);
	end;
end;

procedure TPrimeSieve.PrintResults(ShowResults: Boolean; Duration: Double; Passes: Integer);
var
	count: Integer;
	num: Integer;
const
	SYesNo: array[Boolean] of string = ('No', 'Yes');
begin
	if ShowResults then
		Write('2, ');

	count := 1;
	for num := 3 to FSieveSize do
	begin
		if GetBit(num) then
		begin
			if ShowResults then
				Write(IntToStr(num) + ', ');
			Inc(count);
		end;
	end;

	if ShowResults then
		WriteLn('');

	WriteLn(Format('Passes: %d, Time: %.3f sec, Avg: %.4f ms, Limit: %d, Count: %d, Valid: %s',
			[Passes, Duration, Duration/Passes*1000, FSieveSize, count, SYesNo[ValidateResults]]));
end;

procedure Main;
var
	sieve: TPrimeSieve;
	dtStart: TDateTime;
	passes: Integer;

	tD: TTimeSpan;
begin
	passes := 0;

	dtStart := Now;
  sieve := TPrimeSieve.Create(1000000);
	while TTimeSpan.Subtract(Now,dtStart).Seconds < 5 do
	begin
    Sieve.InitializeBits;
		sieve.RunSieve;
		Inc(passes);
	end;

	tD := TTimeSpan.Subtract(Now, dtStart);
//	if Assigned(sieve) then
		sieve.PrintResults(False, tD.TotalSeconds, passes);
  sieve.Free;
end;

{
	Intel Core i5-9400 @ 2.90 GHz

	- 32-bit: 4,809 passes
	- 64-bit: 2,587 passes
}
begin
	try
		Main;
		WriteLn('Press enter to close...');
		Readln;
	except
		on E: Exception do
			Writeln(E.ClassName, ': ', E.Message);
	end;
end.

[rbergen]

This is not an issue, but a show & tell discussion. Converting this to that.