Delphi - 检测 Int64 溢出错误

Posted 2023-02-22

【中文标题】Delphi - 检测 Int64 溢出错误

【英文标题】：Delphi - Detect Int64 Overflow Error

【发布时间】：2012-07-05 12:23:09

【问题描述】：

在 Delphi 中如何检测 Int64 的溢出错误？

对于整数，我们可以这样做：

type
MyInt = Integer; //Int64

function TryMaxTimes10(out Res: MyInt): boolean;
var
  a, b: MyInt;
begin
  $Q+
  try
    a := High(MyInt);
    b := 10;
    Res := a * b; //REF1
    Result := True; 
  except
    Result := False;
  end;
  $Q-
end;

对于MyInt = Integer，REF1 行给出异常，因此TryMaxTimes10 返回false。

但是如果我们将 MyInt 更改为MyInt = Int64，那么 REF1 不会给出异常并且TryMaxTimes10 返回true！

我了解$Q+ 的帮助没有具体提及Int64: ... $Q+ state, certain integer arithmetic operations ... are checked for overflow。

问题：所以我的问题是，我们如何检测 Int64 的溢出错误？

（我使用的是 Delphi 7。在较新版本的 Delphi 中也会发生同样的事情吗？）

【问题讨论】：

在进一步调查中，似乎 __llmulo (system.pas) 中存在错误。

我在这里找到了（某种）解决方法：qc.embarcadero.com/wc/qcmain.aspx?d=34049，我可以使用类似的 Fastcode 来修补 __llmulo。问题是解决方法代码可能包含错误（请参阅 QA 页面下方的 cmets）。有人有睾丸/工作 __llmulo？

【参考方案1】：

这是一个已知问题。见http://qc.embarcadero.com/wc/qcmain.aspx?d=10185，cmets 安迪写在底部。

我的建议是创建一个函数（我没有编译也没有测试这个 - 只是一个例子）：

function Foo(A, B : Int64) : Int64;
var bNeg : boolean;
begin
  // Do we expect a negative result?
  bNeg := ((a < 0) xor (b < 0));
  // Get the real result
  Result := a * b;
  // If the result is wrong, raise an error
  if ((Result < 0) xor bNeg) then begin
    // Raise EOverFlow
  end;
end;

【讨论】：

谢谢保罗。用上面的乘法函数调用替换所有 * 是很困难的。我正在寻找一个更全局的解决方案，也许可以修补 __llmulo（调用 system.pas 函数来执行 Int64 乘法），类似于 Fastcode。

是的，那会容易得多！作为一个仅供参考，我使用的是 Delphi XE2，我仍然可以复制这个错误。当然它在 D2005 中已被修复为“关闭”......所以“升级你的 Delphi”也不是一个答案。

嗨 Paul - 出于好奇，如果 __llmulo 过程（在 system.pas 中）仍然显示（在过程上方的 cmets 中）“64 位有符号乘法，带有溢出检查（ 98.05.15: 尚不支持溢出）”以及代码是否与 __llmul 过程相同？

是的，有相同的评论。这两个过程之间的代码实际上是 100% 相同的。

请注意QualityCentral has now been shut down，因此您无法再访问qc.embarcadero.com 链接。如果您需要访问旧的 QC 数据，请查看 QCScraper。

【参考方案2】：

此错误已在 RAD Studio 10.2 Tokyo 中修复。 该问题可以在here 找到（但必须使用 embarcadero 帐户登录才能查看）。

这是 John O'Harrow 的 __llmulo 的正确版本（在 MPL 1.1 下获得许可）随 Delphi 10.2 及更高版本一起提供：

//  Param 1(edx:eax), Param 2([esp+8]:[esp+4])
//  Result is stored in edx:eax
//  O-flag set on exit   => result is invalid
//  O-flag clear on exit => result is valid
procedure __llmulo();
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;

【讨论】：

点评来源： 欢迎提供解决方案的链接，但请确保您的答案在没有它的情况下有用：add context around the link 这样您的其他用户就会知道它是什么以及它为什么存在，然后引用在目标页面不可用的情况下，您链接到的页面中最相关的部分。答案只不过是一个链接may be deleted。见：How do I write a good answer?