delphi 外部64位库引发的浮点异常使我的应用程序崩溃,即使存在异常掩码

qv7cva1a  于 2022-11-04  发布在  其他
关注(0)|答案(1)|浏览(287)

我在将 Delphi 5 32位应用程序移植到Delphi 10.4 64位应用程序的过程中遇到了一个棘手的问题。我已经成功地将应用程序移植到了Delphi 10 32位应用程序,但在转换到64位时,我还需要使用不同的外部库,这就是问题发生的地方。
该应用程序与外部数学解算器(Lingo解算器,在32位应用程序的情况下为版本9,在64位应用程序的情况下为版本17)接口。
我们有许多相对简单的基本模型,这些模型根据现场生产参数组合成更复杂的模型。
其中一个basemodel在调用64位库时引发了一个异常,而在调用32位库时,该库并不存在。在继续进一步开发建模环境之前,我们真的想了解一下这个异常的底部,因为它似乎只是简单地依赖于输入/输出和中间计算值,这也可能发生在任何其他basemodel中,具体取决于它们的配置。
但是,上下文已经够多了,让我们深入了解一下细节:
64位外部库引发异常:
异常类$C0000091包含消息'c 0000091 FLOAT_OVERFLOW'
有时候传达的信息是:
异常类$C000008F,包含消息'c 000008 f FLOAT_INEXACT_RESULT'
我相信,抛出确切异常的不一致性可以用Lingo的求解器为模型的自由变量分配初始值的随机性来解释。
在本主题中:W10 + Delphi 西雅图,TFileOpenDialog + fdoForcePreviewPaneOn = crash在一些图像上,我找到了一个关于如何屏蔽这类浮点异常的建议。我不是说这是正确的编码,但至少在这种情况下,我们将能够看到模型的输出/结果,并从那里继续下去。所以现在的调用变成了这样:

orgMask : TArithmeticExceptionMask;

OrgMask := GetExceptionMask;
// disable all exceptions
SetExceptioNMask([exInvalidOp,exDenormalized, exZeroDivide, exOverflow,
                                exUnderflow, exPrecision]);
intLingoError := LSexecuteScriptLng(pintLingoEnvironment, pAnsiChar(AnsiString(strModelExecuteScript)));
SetExceptionMask(OrgMask);

但仍会引发异常!这是否意味着外部库中的异常屏蔽已关闭?
此外,在原始代码中,似乎有一些代码的目标是屏蔽浮点异常。在32位版本中,这显然是有效的,但在64位版本中却不行。
下面是代码和一些注解,它们让我相信代码是用来屏蔽浮点异常的:

SetLingo8087CW();
intLingoError := LSexecuteScriptLng(pintLingoEnvironment, pAnsiChar(AnsiString(strModelExecuteScript)));
ReSetLingo8087CW();

procedure TLingoSolver.SetLingo8087CW();
begin
  Saved8087CW := Get8087CW();
  Init8087FPU($137F);  //FPU Exceptions handled by processor.
  // PERSONAL ADDITION: I've tried a number of different masks here, but to no avail
end;

procedure TLingoSolver.ReSetLingo8087CW();
begin
  Init8087FPU(Saved8087CW)
end;

Get8087CWInit8087FPU调用在不同的单元中处理:

{Problem: Unexpected OverFlow and Zero Divide occured sometimes when executing
  a Lingo script.
  Solution: C++ DLL's can use different Exception settings then Delphi.
  If Lingo use automatic exception handling then masked exceptions are still registered.
  After returning to Delphi the registration is still there
  and triggers Delphi to raise an exception.
  Therefore we use automatic exception handling in this Delphi part too.
  }

  {
  ><  ><  ><  >
  2109876543210
  1001100110010 $1332 4914 Default Delphi settings
  1001001110010 $1272 4722 Double precision, no special masks, bit 6 set
  1001100111111 $133F 4927 Extended precision, masked exception
  1001101111111 $137F 4991 Extended precision, masked exception, bit 6 set
  1001001111111 $127F 4735 Double precision, masked exception
  1001101110010 $1372 4978
  1001001110010 $1272 4722 After Oracle logon -> From extended to double precision.
  1000001110010 $1072 4210 Single precision, no special masks, bit 6 set
     1101111111 $ 237F 895 FNINIT
  }

  function Get8087CW: word;
  ASM
    FWAIT
    FStCW [Result]
    FWAIT
  End ;

  procedure Init8087FPU(NewCW: Word);
  asm
    FWAIT
    FINIT
    FWAIT
    MOV     Default8087CW,AX
    FWAIT
    FLDCW   Default8087CW
    FWAIT
  end;

我假设Set8087CWSetExceptionMask代码本质上是实现同一目标的不同方法,对吗?

当我在Lingo安装提供的GUI中运行模型时,模型求解得很好,而这个GUI可能调用相同的外部库。
以下是发送到外部库进行求解的模型文本的精简版本,以供参考:
编辑:删除了模型文本,因为它似乎与问题无关,而且其中有一些IP。

mctunoxg

mctunoxg1#

在64位浮点中,使用SSE2而不是8087。因此,您没有在适当的浮点单元上屏蔽异常。在我的代码库中,它看起来像这样:

type
{$IF Defined(CPUX86)}
  TFPControlState = record
  private
    Fx87CW: Word;
  public
    property x87CW: Word read Fx87CW;
  end;
{$ELSEIF Defined(CPUX64)}
  TFPControlState = record
  private
    FMXCSR: UInt32;
  public
    property MXCSR: UInt32 read FMXCSR;
  end;
{$ELSE}
{$Message Fatal 'TFPControlState has not been implemented for this architecture.'}
{$ENDIF}

function GetFPControlState: TFPControlState;
begin
{$IF Defined(CPUX86)}
  Result.Fx87CW := Get8087CW;
{$ELSEIF Defined(CPUX64)}
  Result.FMXCSR := GetMXCSR;
{$ELSE}
{$Message Fatal 'GetFPControlState has not been implemented for this architecture.'}
{$ENDIF}
end;

procedure RestoreFPControlState(const State: TFPControlState);
begin
{$IF Defined(CPUX86)}
  Set8087CW(State.x87CW);
{$ELSEIF Defined(CPUX64)}
  SetMXCSR(State.MXCSR);
{$ELSE}
{$Message Fatal 'RestoreFPControlState has not been implemented for this architecture.'}
{$ENDIF}
end;

procedure MaskFPExceptions(out PreviousState: TFPControlState);
begin
  PreviousState := GetFPControlState;
{$IF Defined(CPUX86)}
  SetFPUExceptionMask(exAllArithmeticExceptions);
{$ELSEIF Defined(CPUX64)}
  SetSSEExceptionMask(exAllArithmeticExceptions);
{$ELSE}
{$Message Fatal 'MaskFPExceptions has not been implemented for this architecture.'}
{$ENDIF}
end;

function FGetMaskedExceptFlag(const State: TFPControlState): UInt32;
var
  Mask: UInt32;
begin
{$IF Defined(CPUX86)}
  Mask := State.x87CW and feeALLEXCEPT;
{$ELSEIF Defined(CPUX64)}
  Mask := (State.MXCSR shr 7) and feeALLEXCEPT;
{$ELSE}
{$Message Fatal 'FGetMaskedExceptFlag has not been implemented for this architecture.'}
{$ENDIF}
  Result := FGetExceptFlag and not Mask;
end;

procedure RestoreFPControlStateRaiseExceptions(const State: TFPControlState);
var
  excepts: UInt32;
begin
  excepts := FGetMaskedExceptFlag(State);
  RestoreFPControlState(State);
  if excepts=0 then begin
    Exit;
  end;
  FSetExceptFlag(excepts, feeALLEXCEPT);
  FRaiseExcept(excepts, False);
end;

然后当我调用外部代码时,我会这样做:

var
  PreviousState: TFPControlState;
....
MaskFPExceptions(PreviousState);
try
  // call external code
finally
  RestoreFPControlStateRaiseExceptions(PreviousState);
end;

相关问题