外部64位库引发的浮点异常会使我的应用程序崩溃，即使异常掩码已经到位

Question

在将Delphi 5 32位应用程序移植到Delphi 10.4 64位应用程序的任务中，我偶然发现了一个棘手的问题。我已经成功地将该应用程序移植到Delphi 10 32位应用程序，但当转换到64位时，我还需要使用不同的外部库，这就是问题发生的地方。

应用程序与外部数学求解器(Lingo求解器，32位应用程序为版本9，64位应用程序则为版本17(对接。

我们有许多相对简单的基础模型，这些模型根据现场生产参数组合成更复杂的模型。

其中一个基础模型在调用64位库时引发异常，而在调用32位库时不存在该异常。在进一步开发建模环境之前，我们真的想弄清这个异常，因为它似乎只是取决于输入/输出和中间计算值，而这些值也可能发生在任何其他基础模型中，具体取决于它们的配置。

但是，有了足够的上下文，让我们深入了解细节：

64位外部库引发异常：

异常类$C00091，带有消息"C0000091 FLOAT_OVERFLOW">

有时消息是：

异常类$C0008F，带有消息"C000008F FLOAT_INEXACT_RESULT">

我相信，抛出确切异常的不一致性可以通过Lingo求解器为模型的自由变量分配起始值的随机性来解释。

在这个主题中：W10+Delphi Seattle，TFileOpenDialog+fdoForcePreviewPaneOn=在一些图像上崩溃，我发现了一个关于如何屏蔽这些浮点异常的建议。我并不是说这是正确的编码，但至少在这种情况下，我们能够看到模型的输出/结果，并从那里继续下去。所以现在的呼叫变成了：

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;

Get8087CW和Init8087FPU调用在不同的单元中处理：

{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;

我认为Set8087CW和SetExceptionMask代码本质上是实现相同目标的不同方式，这一假设正确吗

当我在Lingo安装提供的GUI中运行该模型时，该模型解决得很好，而据推测，该GUI调用相同的外部库。

作为参考，这里是发送到外部库以解决的模型文本的浓缩版本：

编辑：删除了模型文本，因为它似乎与问题无关，而且其中有一些IP。

Answer 1

在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;