Floating Point exceptions raised by external 64-bit library crashes my application, even though exception masks are in place

Question

I have stumbled upon a stubborn problem in my task to port a Delphi 5 32-bit application to a Delphi 10.4 64-bit application. I have succeeded in porting the application to a Delphi 10 32-bit application, but when converting to 64-bit I also need to use a different external library and this is where the problem occurs.

The application interfaces with an external mathematical solver (a Lingo solver, version 9 in case of the 32-bit application and version 17 in case of the 64-bit application).

We have a number of relatively simple basemodels, which are combined into more complex models based on live production parameters.

One of the basemodels raises an exception when calling the 64-bit library that is not there when calling the 32-bit library. Before moving on with further development of the modeling environment, we really want to get to the bottom of this exception, as it seems to be simply dependent on in/output and intermediate calculation values that can happen in any of the other basemodels as well, depending on their configuration.

But enough with the context, let's dive into the details:

The 64-bit external library raises an exception:

exception class $C0000091 with message 'c0000091 FLOAT_OVERFLOW'

Sometimes the message is:

exception class $C000008F with message 'c000008f FLOAT_INEXACT_RESULT'

I believe the inconsistency in which exact exception is thrown can be explained by the stochastic nature of Lingo's solver to assign starting values for the free variable of the model.

In this topic: W10 + Delphi Seattle, TFileOpenDialog + fdoForcePreviewPaneOn = crash on some images, I found a suggestion on how to mask these kind of Floating Point exceptions. I'm not saying this is correct coding, but at least in that case we would be able to see the output/results of the model and go on from there. So the call now becomes this:

orgMask : TArithmeticExceptionMask;

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

But the exception is still being raised! Could this mean that the exception masking is turned off within the external library?

Furthermore, in the original code there seems to be code that seems to aim for the same result of masking floating point exceptions. In the 32-bit version this apparently works, but in the 64-bit version it does not.

Here is the code and some of the comments that lead me to believe the code is used to mask floating point exceptions:

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;

The Get8087CW and Init8087FPU calls are handled in a different unit:

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

Am I correct in my assumption that the Set8087CW and SetExceptionMask codes are essentially different ways to achieve the same goal?

When I run the model in the GUI provided with the Lingo install, the model solves fine, while presumably, this GUI calls the same external library.

For reference, here is a condensed version of the modeltext that is sent to the external library to solve:

EDIT: removed the modeltext as it seems it's not relevant to the issue and there's some IP in there.

Answer 1

In 64 bit floating point uses SSE2 and not 8087. So, you aren't masking exceptions on the appropriate floating point unit. In my code base it looks like this:

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;

And then when I call into external code I do this:

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