Delphi – Michael Justin had strange floating point results when his 8087 FPU Control Word got hosed

Two days ago, [Wayback] Michael Justin (who just released version 1.7 of the [Wayback] Habari Active MQ Client components) posted a blog entry about a strange circumstance [Wayback] when 1.99 would not compare equally to 1.99.
He tracked it down to the [Wayback] 8087 (more formally: Intel [Wayback] FPU) Control Word being hosed on his system.

I could not reproduce his particular case, but since I have seen similar issues in the past, I wrote the DUnit test case below which shows you what can happen by manually setting the 8087 Control Word.

The difference between the 8087 Control Word values $1372 (default) and $1272 (failure) is the internal mantissa precision (see the [Wayback] “Art of Assembly Language” and the [Wayback] Intel FPU Control Word documentation on this).
Edit: Found a [Wayback] much more complete description of the bits in the FPU Control word.

It changes from 64 bits to 53 bits, which is enough to make 1.99 not equal to 1.99.

I have seen behaviour like this in the past with some networking stacks in the Turbo Pascal 7 era, with some C++ DLL’s in the Delphi 1-3 era, and some printer drivers in the Delphi 5-7 era.
Let me know in the comments (or using the contact form) where you have bumped into this.

The code below makes use of the Jcl8087 unit which is part of the JCL ([Wayback] JEDI Code Library) at [Wayback] SourceForge.
Add the unit to any DUnit test project you created and observe the results.

unit TestControlWordUnit;

interface

uses
  TestFramework;

type
  TTestControlWord = class(TTestCase)
  strict protected
    procedure CurrencyCheckEquals;
    procedure ShowCW(const ControlWord: Word);
  published
    procedure TestCurrencyCheckEqualsWith1272CW;
    procedure TestCurrencyCheckEqualsWith1372CW;
    procedure Show1272CW;
    procedure Show1372CW;
  end;

implementation

uses
  Jcl8087, TypInfo;

const
  BadCW = $1272;
  GoodCW = $1372;

procedure TTestControlWord.Show1272CW;
begin
  ShowCW(BadCW);
end;

procedure TTestControlWord.Show1372CW;
begin
  ShowCW(GoodCW);
end;

procedure TTestControlWord.CurrencyCheckEquals;
var
  CurrencyValue: Currency;
begin
  CurrencyValue := 1.99;
  CheckEquals(1.99, CurrencyValue);
end;

procedure TTestControlWord.ShowCW(const ControlWord: Word);
var
  Precision: T8087Precision;
  Line: string;
begin
  Set8087CW(ControlWord);
  Precision := Get8087Precision;
  Line := GetEnumName(TypeInfo(T8087Precision), Ord(Precision));
  Assert(False, Line); // quick hack to show this in DUnit
end;

procedure TTestControlWord.TestCurrencyCheckEqualsWith1272CW;
begin
  // bad: result is not equal
  Set8087CW(BadCW);
  CurrencyCheckEquals;
end;

procedure TTestControlWord.TestCurrencyCheckEqualsWith1372CW;
begin
  // default CW value
  // good: result is not equal
  Set8087CW(GoodCW);
  CurrencyCheckEquals();
end;

initialization
  RegisterTest(TTestControlWord.Suite);
end.

Edit – Guus Creuwels added a comment and wondered what his control words meant, so there is the list:

  $027F - [cweAllowInvalidNumbers, cweAllowDenormals, cweAllowDivideByZero, cweAllowOverflow, cweAllowUnderflow, cweAllowInexactPrecision], icProjective, pcDouble,   rcNearestOrEven
  $1272 - [                        cweAllowDenormals,                                         cweAllowUnderflow, cweAllowInexactPrecision], icAffine,     pcDouble,   rcNearestOrEven
  $133F - [cweAllowInvalidNumbers, cweAllowDenormals, cweAllowDivideByZero, cweAllowOverflow, cweAllowUnderflow, cweAllowInexactPrecision], icAffine,     pcExtended, rcNearestOrEven
  $1372 - [                        cweAllowDenormals,                                         cweAllowUnderflow, cweAllowInexactPrecision], icAffine,     pcExtended, rcNearestOrEven
Default - [                        cweAllowDenormals,                                         cweAllowUnderflow, cweAllowInexactPrecision], icAffine,     pcExtended, rcNearestOrEven

Setting the 8087 FPU Control word to $133F effectively disables all floating point exceptions (the lower 6 bits with mask $3F determine the exception behaviour).

–jeroen