Recent

Author Topic: possible bug in 32bit related to calling convention  (Read 628 times)

440bx

  • Hero Member
  • *****
  • Posts: 1205
possible bug in 32bit related to calling convention
« on: April 22, 2019, 08:11:24 am »
Hello,

It seems the compiler ignores the calling convention declared in a procedural type.  This causes the compiler to accept a procedure with a different calling convention than the one declared in the procedural type which can result in access violations.

Attached is a sample console program that exhibits the problem.

the notable parts of the program are as follows:

1. declare a procedural type
Code: Pascal  [Select]
  1. type
  2.   { NOTE the cdecl calling convention - important when compiling for 32bit    }
  3.  
  4.   TCompareFunction = function (key : pointer; data : pointer) : ptrint; cdecl;
  5.  
  6.   { calling convention is part of the declared type                 } {^^^^^^^}
  7.  

2. declare a function that is supposed to be of that declared type:
Code: Pascal  [Select]
  1. {$ifdef CauseProblem}
  2.   { will cause an access violation due to wrong calling convention            }
  3.  
  4.   function CompareInt(arg1 : PDWORD; arg2 : PDWORD) : ptrint;
  5. {$else}
  6.   { will work as expected because the calling convention is correct           }
  7.  
  8.   function CompareInt(arg1 : PDWORD; arg2 : PDWORD) : ptrint; cdecl;
  9. {$endif}
  10.   begin
  11.     result := COMPARE_EQUAL;
  12.     if arg1^ = arg2^ then exit;
  13.  
  14.     result := COMPARE_GREATER;
  15.     if arg1^ > arg2^ then exit;
  16.  
  17.     result := COMPARE_LESS;
  18.   end;
  19.  
if the calling convention is left out, the compiler emits no error or warning when the function is used.  For instance, using the following definitions:
Code: Pascal  [Select]
  1. procedure qsort(base            : pointer;
  2.                 num             : ptruint;
  3.                 width           : ptruint;
  4.                 CompareFunction : TCompareFunction);
  5.   cdecl; external ntdll;
  6.  
3.The call
Code: Pascal  [Select]
  1.   qsort(@IntTable,                    // pointer to the array/table to be sorted
  2.          high(IntTable),              // count of elements in the array/table
  3.          sizeof(DWORD),               // sort the dwords
  4.          TCompareFunction(@CompareInt));
  5.  
will accept a "CompareInt" function with a different calling convention than the one declared in the procedural type which will cause an access violation.
« Last Edit: April 22, 2019, 08:14:12 am by 440bx »
using FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.

ASerge

  • Hero Member
  • *****
  • Posts: 1412
Re: possible bug in 32bit related to calling convention
« Reply #1 on: April 22, 2019, 11:00:38 am »
It seems the compiler ignores the calling convention declared in a procedural type.  This causes the compiler to accept a procedure with a different calling convention than the one declared in the procedural type which can result in access violations.
Because you explicitly cast it to the wrong type:"TCompareFunction(@CompareInt)". Remove the type casting and you will see the compiler error.
And else, for qsort, bsearch functions it is better to specify Length(IntTable) instead of High(IntTable), because it requires the number of elements, not the last index. In this sample, they are equal.
I tweaked your example a bit to exclude hints and warnings (including that mentioned above):
Code: Pascal  [Select]
  1. program ntdll_qsort_bsearch_dword;
  2. {$MODE OBJFPC}
  3. {$APPTYPE CONSOLE}
  4. {$TYPEDADDRESS ON}
  5.  
  6. {-$define CauseProblem}         { comment out to make the program work }
  7. { 32bit : the program will cause an access violation when CauseProblem is defined. }
  8. { 64bit : under Windows the program will always work because the ABI determines the stack frame. }
  9.  
  10. type
  11.   { NOTE the cdecl calling convention - important when compiling for 32bit }
  12.   TCompareFunction = function(var Arg1, Arg2: DWORD): Integer; cdecl;
  13.  
  14. function bsearch(Key, Base: Pointer; Num, Width: SIZE_T;
  15.   CompareFunction: TCompareFunction): Pointer; cdecl; external 'ntdll.dll';
  16.  
  17. procedure qsort(Base: Pointer; Number, Width: SIZE_T;
  18.   CompareFunction: TCompareFunction); cdecl; external 'ntdll.dll';
  19.  
  20. var
  21.   IntTable: packed array[1..100] of DWORD;
  22.   IntKey: DWORD;
  23.   IntKeyIndex: SizeInt;
  24.   i: SizeInt;
  25.   FoundAddr: PDWORD;
  26.   FoundIndex: SizeInt;  // calculated index
  27.  
  28. {$ifdef CauseProblem}
  29. { will cause an access violation due to wrong calling convention      }
  30. function CompareInt(var Arg1, Arg2: DWORD): Integer;
  31. {$else}
  32. { will work as expected because the calling convention is correct      }
  33. function CompareInt(var Arg1, Arg2: DWORD): Integer; cdecl;
  34. {$endif}
  35. begin
  36.   if Arg1 < Arg2 then
  37.     Result := -1
  38.   else
  39.     if Arg1 > Arg2 then
  40.       Result := 1
  41.     else
  42.       Result := 0;
  43. end;
  44.  
  45. const
  46.   RANDOM_RANGE = 80000;
  47. begin
  48.   for i := Low(IntTable) to High(IntTable) do
  49.   begin
  50.     IntTable[i] := Random(RANDOM_RANGE);
  51.     Writeln(IntTable[i]);
  52.   end;
  53.   IntKey := IntTable[Low(IntTable)];  // use the first value as the value to search
  54.   Writeln('IntKey: ', IntKey);
  55.   qsort(@IntTable, Length(IntTable), SizeOf(DWORD), @CompareInt);
  56.   Writeln;
  57.   IntKeyIndex := 0;
  58.   for i := Low(IntTable) to High(IntTable) do
  59.   begin
  60.     Writeln(IntTable[i]);
  61.     if IntKey = IntTable[i] then
  62.       IntKeyIndex := i;
  63.   end;
  64.   Writeln('After sorting, the key is at index : ', IntKeyIndex);
  65.   // now that the table is sorted do a binary search for the dword pointed to
  66.   // by Key
  67.   FoundAddr := nil;
  68.   FoundAddr := bsearch(@IntKey, @IntTable, Length(IntTable), SizeOf(IntKey), @CompareInt);
  69.   if FoundAddr <> nil then
  70.   begin
  71.     Writeln(FoundAddr^);
  72.     Writeln('Found: ', HexStr(FoundAddr));
  73.     Writeln('IntTable: ', HexStr(@IntTable));
  74.     FoundIndex := (FoundAddr - @IntTable[Low(IntTable)]) + Low(IntTable);
  75.     Writeln('Found at calculated index: ', FoundIndex);
  76.     if FoundIndex <> IntKeyIndex then
  77.       Writeln('FATAL PROBLEM: calculated index is not as expected');
  78.   end
  79.   else
  80.     Writeln(IntKey, 'FATAL PROBLEM: existing key not found');
  81.  
  82.   Writeln;
  83.   Writeln('prese ENTER/RETURN to end this program');
  84.   Readln;
  85. end.

440bx

  • Hero Member
  • *****
  • Posts: 1205
Re: possible bug in 32bit related to calling convention
« Reply #2 on: April 22, 2019, 12:30:01 pm »
Because you explicitly cast it to the wrong type:"TCompareFunction(@CompareInt)". Remove the type casting and you will see the compiler error.
And else, for qsort, bsearch functions it is better to specify Length(IntTable) instead of High(IntTable), because it requires the number of elements, not the last index. In this sample, they are equal.
I tweaked your example a bit to exclude hints and warnings (including that mentioned above):
Code: Pascal  [Select]
  1. program ntdll_qsort_bsearch_dword;
  2. {$MODE OBJFPC}
  3. {$APPTYPE CONSOLE}
  4. {$TYPEDADDRESS ON}
  5.  
  6. {-$define CauseProblem}         { comment out to make the program work }
  7. { 32bit : the program will cause an access violation when CauseProblem is defined. }
  8. { 64bit : under Windows the program will always work because the ABI determines the stack frame. }
  9.  
  10. type
  11.   { NOTE the cdecl calling convention - important when compiling for 32bit }
  12.   TCompareFunction = function(var Arg1, Arg2: DWORD): Integer; cdecl;
  13.  
  14. function bsearch(Key, Base: Pointer; Num, Width: SIZE_T;
  15.   CompareFunction: TCompareFunction): Pointer; cdecl; external 'ntdll.dll';
  16.  
  17. procedure qsort(Base: Pointer; Number, Width: SIZE_T;
  18.   CompareFunction: TCompareFunction); cdecl; external 'ntdll.dll';
  19.  
  20. var
  21.   IntTable: packed array[1..100] of DWORD;
  22.   IntKey: DWORD;
  23.   IntKeyIndex: SizeInt;
  24.   i: SizeInt;
  25.   FoundAddr: PDWORD;
  26.   FoundIndex: SizeInt;  // calculated index
  27.  
  28. {$ifdef CauseProblem}
  29. { will cause an access violation due to wrong calling convention      }
  30. function CompareInt(var Arg1, Arg2: DWORD): Integer;
  31. {$else}
  32. { will work as expected because the calling convention is correct      }
  33. function CompareInt(var Arg1, Arg2: DWORD): Integer; cdecl;
  34. {$endif}
  35. begin
  36.   if Arg1 < Arg2 then
  37.     Result := -1
  38.   else
  39.     if Arg1 > Arg2 then
  40.       Result := 1
  41.     else
  42.       Result := 0;
  43. end;
  44.  
  45. const
  46.   RANDOM_RANGE = 80000;
  47. begin
  48.   for i := Low(IntTable) to High(IntTable) do
  49.   begin
  50.     IntTable[i] := Random(RANDOM_RANGE);
  51.     Writeln(IntTable[i]);
  52.   end;
  53.   IntKey := IntTable[Low(IntTable)];  // use the first value as the value to search
  54.   Writeln('IntKey: ', IntKey);
  55.   qsort(@IntTable, Length(IntTable), SizeOf(DWORD), @CompareInt);
  56.   Writeln;
  57.   IntKeyIndex := 0;
  58.   for i := Low(IntTable) to High(IntTable) do
  59.   begin
  60.     Writeln(IntTable[i]);
  61.     if IntKey = IntTable[i] then
  62.       IntKeyIndex := i;
  63.   end;
  64.   Writeln('After sorting, the key is at index : ', IntKeyIndex);
  65.   // now that the table is sorted do a binary search for the dword pointed to
  66.   // by Key
  67.   FoundAddr := nil;
  68.   FoundAddr := bsearch(@IntKey, @IntTable, Length(IntTable), SizeOf(IntKey), @CompareInt);
  69.   if FoundAddr <> nil then
  70.   begin
  71.     Writeln(FoundAddr^);
  72.     Writeln('Found: ', HexStr(FoundAddr));
  73.     Writeln('IntTable: ', HexStr(@IntTable));
  74.     FoundIndex := (FoundAddr - @IntTable[Low(IntTable)]) + Low(IntTable);
  75.     Writeln('Found at calculated index: ', FoundIndex);
  76.     if FoundIndex <> IntKeyIndex then
  77.       Writeln('FATAL PROBLEM: calculated index is not as expected');
  78.   end
  79.   else
  80.     Writeln(IntKey, 'FATAL PROBLEM: existing key not found');
  81.  
  82.   Writeln;
  83.   Writeln('prese ENTER/RETURN to end this program');
  84.   Readln;
  85. end.

Thank you Serge. 

Your point about the typecast is most definitely valid but, I didn't have much choice. 

I am porting code from Delphi 2 to FPC.  Delphi 2 _requires_ the typecast when {$TYPEDADDRESS ON} is enabled (which I always enable), otherwise it complains that I am passing a pointer where it expects a procedural parameter.  That's the reason for the typecast.

I cannot complain about the compiler doing what I told it to do even if it is the wrong thing.  It would be nice if it emitted a warning about typecasting a calling convention into another which is very unlikely to work (to say the least).  Can't fault FPC for not doing that, Delphi didn't say anything about it either.

Because I am using Delphi 2, I cannot use some of your suggestions because that version of Delphi does not allow it (such as length on something other than a string.)

Thank you very much for looking into that.  I will be very mindful about the fact that a typecast can override a calling convention.  I didn't think the compiler(s) would allow that, I thought it would consider it an illegal typecast.  Thanks to you, I know better now.
using FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.

Jonas Maebe

  • Hero Member
  • *****
  • Posts: 671
Re: possible bug in 32bit related to calling convention
« Reply #3 on: April 22, 2019, 05:44:59 pm »
In both Delphi and in FPC's Delphi and TP modes, you create a procedural variable type from a procedure/function by just typing the procedure/function's name (without an "@" or parentheses). This looks ambiguous in case the function has no (or only default) parameters (in that case you can force it to be called by adding empty parenthesis), but that's how it is defined (it was like that in the official Pascal standards as well). You do not need a typecast in that case, even with {$TYPEDADDRESS ON}. @procedure/function indeed returns an untyped pointer in those compilers/compiler modes.

In FPC and ObjFPC mode we got rid of the ambiguity by having requiring you to use "@procedure/function" to get a procedural variable type instead (and if you want an untyped pointer, you just add a pointer() typecast around that).

440bx

  • Hero Member
  • *****
  • Posts: 1205
Re: possible bug in 32bit related to calling convention
« Reply #4 on: April 23, 2019, 12:36:50 am »
In both Delphi and in FPC's Delphi and TP modes, you create a procedural variable type from a procedure/function by just typing the procedure/function's name (without an "@" or parentheses). This looks ambiguous in case the function has no (or only default) parameters (in that case you can force it to be called by adding empty parenthesis), but that's how it is defined (it was like that in the official Pascal standards as well).
<snip>
In FPC and ObjFPC mode we got rid of the ambiguity by having requiring you to use "@procedure/function" to get a procedural variable type instead (and if you want an untyped pointer, you just add a pointer() typecast around that).
The ambiguous look of just using the function name is the reason I use the address-of operator, which in the case of Delphi forces a typecast when {$TYPEDADDRESS ON} is enabled.

I think the way FPC does it, is the cleanest and simplest.
« Last Edit: April 23, 2019, 12:39:38 am by 440bx »
using FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.