program ntdll_qsort_bsearch_dword;
{$MODE OBJFPC}
{$APPTYPE CONSOLE}
{$TYPEDADDRESS ON}
{-$define CauseProblem} { comment out to make the program work }
{ 32bit : the program will cause an access violation when CauseProblem is defined. }
{ 64bit : under Windows the program will always work because the ABI determines the stack frame. }
type
{ NOTE the cdecl calling convention - important when compiling for 32bit }
TCompareFunction = function(var Arg1, Arg2: DWORD): Integer; cdecl;
function bsearch(Key, Base: Pointer; Num, Width: SIZE_T;
CompareFunction: TCompareFunction): Pointer; cdecl; external 'ntdll.dll';
procedure qsort(Base: Pointer; Number, Width: SIZE_T;
CompareFunction: TCompareFunction); cdecl; external 'ntdll.dll';
var
IntTable: packed array[1..100] of DWORD;
IntKey: DWORD;
IntKeyIndex: SizeInt;
i: SizeInt;
FoundAddr: PDWORD;
FoundIndex: SizeInt; // calculated index
{$ifdef CauseProblem}
{ will cause an access violation due to wrong calling convention }
function CompareInt(var Arg1, Arg2: DWORD): Integer;
{$else}
{ will work as expected because the calling convention is correct }
function CompareInt(var Arg1, Arg2: DWORD): Integer; cdecl;
{$endif}
begin
if Arg1 < Arg2 then
Result := -1
else
if Arg1 > Arg2 then
Result := 1
else
Result := 0;
end;
const
RANDOM_RANGE = 80000;
begin
for i := Low(IntTable) to High(IntTable) do
begin
IntTable[i] := Random(RANDOM_RANGE);
Writeln(IntTable[i]);
end;
IntKey := IntTable[Low(IntTable)]; // use the first value as the value to search
Writeln('IntKey: ', IntKey);
qsort(@IntTable, Length(IntTable), SizeOf(DWORD), @CompareInt);
Writeln;
IntKeyIndex := 0;
for i := Low(IntTable) to High(IntTable) do
begin
Writeln(IntTable[i]);
if IntKey = IntTable[i] then
IntKeyIndex := i;
end;
Writeln('After sorting, the key is at index : ', IntKeyIndex);
// now that the table is sorted do a binary search for the dword pointed to
// by Key
FoundAddr := nil;
FoundAddr := bsearch(@IntKey, @IntTable, Length(IntTable), SizeOf(IntKey), @CompareInt);
if FoundAddr <> nil then
begin
Writeln(FoundAddr^);
Writeln('Found: ', HexStr(FoundAddr));
Writeln('IntTable: ', HexStr(@IntTable));
FoundIndex := (FoundAddr - @IntTable[Low(IntTable)]) + Low(IntTable);
Writeln('Found at calculated index: ', FoundIndex);
if FoundIndex <> IntKeyIndex then
Writeln('FATAL PROBLEM: calculated index is not as expected');
end
else
Writeln(IntKey, 'FATAL PROBLEM: existing key not found');
Writeln;
Writeln('prese ENTER/RETURN to end this program');
Readln;
end.