The Wiert Corner – irregular stream of stuff

Jeroen W. Pluimers on .NET, C#, Delphi, databases, and personal interests

  • My badges

  • Twitter Updates

  • My Flickr Stream

  • Pages

  • All categories

  • Enter your email address to subscribe to this blog and receive notifications of new posts by email.

    Join 2,164 other followers

Delphi still doesn’t raise overflow exception on Int64 multiplication…

Posted by jpluimers on 2018/06/28

Thanks to Stefan Glienke for pointing me at the below patch for [WayBack] Why doesn’t raise overflow exception on multiplication example or how to detect in this case?{$RANGECHECKS ON} {$OVERFLOWCHECKS ON}varvalue: Int64;… – Rafael Dipold – Google+.

It’s basically an issue in __llmulo that has been documented but not solved since “forever”:

some people “some while ago” reported this and even posted a solution: [WayBackhttp://qc.embarcadero.com/wc/qcmain.aspx?d=34049

And there it is again: [WayBackhttp://qc.embarcadero.com/wc/qcmain.aspx?d=119146

And most recently: https://quality.embarcadero.com/browse/RSP-16617

FWIW here is a runtime patch that corrects this (using the version posted in QC#119146): https://pastebin.com/jzLgYeqm

The bug tracking of the Delphi team is so bad, that some of the reports actually mark this issue “As Designed” like in [WayBackhttp://qc.embarcadero.com/wc/qcmain.aspx?d=118287

The below patch requires rights to call [WayBackWriteProcessMemory as documented in [WayBackHow to Read and Write Other Process Memory.

–jeroen

Patch at [WayBack] https://pastebin.com/jzLgYeqm

unit PatchInt64Multiplication;
interface
implementation
{$IF Defined(MSWINDOWS) and not Defined(CPUX64)}
uses
SysUtils,
Windows;
function GetActualAddr(Proc: Pointer): Pointer;
type
PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
OpCode: Word;
Addr: PPointer;
end;
begin
Result := Proc;
if (Proc <> nil) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
Result := PAbsoluteIndirectJmp(Proc).Addr^;
end;
procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
TJmpBuffer = packed record
Jmp: Byte;
Offset: Integer;
end;
var
n: UINT_PTR;
JmpBuffer: TJmpBuffer;
begin
JmpBuffer.Jmp := $E9;
JmpBuffer.Offset := PByte(NewProc) – (PByte(OrgProc) + 5);
if not WriteProcessMemory(GetCurrentProcess, OrgProc, @JmpBuffer, SizeOf(JmpBuffer), n) then
RaiseLastOSError;
end;
procedure __llmulo_patch;
asm
test edx, edx {Param1-Hi = 0?}
jne @@Large {No, More than one multiply may be needed}
cmp edx, [esp+8] {Param2-Hi = 0?}
jne @@Large {No, More than one multiply may be needed}
mul dword ptr [esp+4] {Only one multiply needed, Set Result}
and eax, eax {Clear Overflow Flag}
ret 8
@@Large:
sub esp, 28 {allocate local storage}
mov [esp], ebx {save used registers}
mov [esp+4], esi
mov [esp+8], edi
mov [esp+12], ebp
mov ebx, [esp+32] {Param2-Lo}
mov ecx, [esp+36] {Param2-Hi}
mov esi, edx
mov edi, ecx
sar esi, 31
sar edi, 31
xor eax, esi
xor edx, esi
sub eax, esi
sbb edx, esi {edx:eax (a1:a0) = abs(Param1)}
xor ebx, edi
xor ecx, edi
sub ebx, edi
sbb ecx, edi {ecx:ebx (b1:b0) = abs(Param2)}
xor esi, edi {Sign Flag, 0 if Params have same sign else -1}
mov [esp+16], eax {a0}
mov [esp+20], edx {a1}
mov [esp+24], ecx {b1}
mul ebx {edx:eax (c1:c0) = a0*b0}
xchg ebx, edx {ebx = c1, edx = b0}
mov edi, eax {abs(Result-Lo) = c0}
xor ecx, ecx {Upper 32 bits of 128 bit result}
xor ebp, ebp {Second 32 bits of 128 bit result}
mov eax, [esp+20] {a1}
mul edx {edx:eax (d1:d0) = a1*b0}
add ebx, eax {c1 + d0}
adc ebp, edx {d1 + carry}
adc ecx, 0 {Possible carry into Upper 32 bits}
mov eax, [esp+16] {a0}
mov edx, [esp+24] {b1}
mul edx {edx:eax (e1:e0) = a0*b1}
add ebx, eax {abs(Result-Hi) = c1 + d0 + e0}
adc ebp, edx {d1 + e1 + carry}
adc ecx, 0 {Possible carry into Upper 32 bits}
mov eax, [esp+20] {a1}
mov edx, [esp+24] {b1}
mul edx {edx:eax (f1:f0) = a1*b1}
add ebp, eax {d1 + e1 + f0 + carry}
adc ecx, edx {f1 + carry}
or ecx, ebp {Overflow if ecx <> 0 or ebp <> 0}
jnz @@Overflow
mov edx, ebx {Set abs(Result-Hi)}
mov eax, edi {Set abs(Result-Lo)}
cmp edx, $80000000
jae @@CheckRange {Possible Overflow if edx>=$80000000}
@@SetSign:
xor eax, esi {Correct Sign of Result}
xor edx, esi
sub eax, esi
sbb edx, esi
mov ebx, [esp] {restore used registers}
mov esi, [esp+4]
mov edi, [esp+8]
mov ebp, [esp+12]
add esp, 28 {Clears Overflow flag}
ret 8
@@CheckRange:
jne @@Overflow {Overflow if edx>$80000000}
test esi, esi {edx=$80000000, Is Sign Flag=0?}
jnz @@SetSign {No, Result is Ok (-MaxInt64)}
@@Overflow:
mov ebx, [esp] {restore used registers}
mov esi, [esp+4]
mov edi, [esp+8]
mov ebp, [esp+12]
add esp, 28
mov ecx, $80000000
dec ecx {Set Overflow Flag}
ret 8
end;
function GetSystem__llmulo: Pointer;
asm
mov eax,offset System.@_llmulo
end;
procedure PatchIt;
begin
RedirectFunction(GetActualAddr(GetSystem__llmulo), @__llmulo_patch);
end;
initialization
PatchIt;
{$IFEND}
end.

 

 

 

3 Responses to “Delphi still doesn’t raise overflow exception on Int64 multiplication…”

  1. rvelthuis said

    As others said, it was fixed. I reported https://quality.embarcadero.com/browse/RSP-16617 and I checked it regularly. It is fixed.

  2. Marco Cantu said

    As https://quality.embarcadero.com/browse/RSP-16617 indicates it was fixed in 10.2 Tokyo

  3. HeartWare said

    It sems to have been fixed in 10.2.3

    VAR
    I : Int64;

    BEGIN
    {$Q+}
    I:=Int64.MaxValue; I:=I*2;
    END;

    produces an integer overflow exception…

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.

 
%d bloggers like this: