[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{
Here is how to trap errors on the 80X87.  I am not sure yet how it works with
the FP emulation library, but if you have a math coprocessor, you can trap
any FP exceptions:
}

{$N+,E+}
program FloatTest;
{ compliments of Steve Schafer, Compuserve address 76711, 522 }
const
  feInvalidOp  = $01;
  feDenormalOp = $02;
  feZeroDivide = $04;
  feOverFlow   = $08;
  feUnderFlow  = $10;
  fePrecision  = $20;

procedure SetFpuExceptionMask (MaskBits: Byte); assembler;
{ Masks floating point exceptions so that they won't cause a crash }
var
  Temp: word;
asm
  fstcw Temp
  fwait
  mov ax, Temp
  and al, $F0
  or al, MaskBits
  mov Temp, ax
  fldcw Temp
  fwait
end;

function GetFpuStatus: Byte; assembler;
{ determines the status of a previous FP operation }
var
  Temp: word;
asm
  fstsw Temp
  fwait
  mov ax, Temp
end;

procedure WriteStatus(Status: Byte);
{ This procedure is not necessary, it simply illustrates how to determine
  what happenend }
begin
  if (Status and fePrecision) <> 0 then Write('P')
  else Write('-');
  if (Status and feUnderflow) <> 0 then Write('U')
  else Write('-');
  if (Status and feOverflow) <> 0 then Write('O')
  else Write('-');
  if (Status and feZeroDivide) <> 0 then Write('Z')
  else Write('-');
  if (Status and feDenormalOp) <> 0 then Write('D')
  else Write('-');
  if (Status and feInvalidOp) <> 0 then Write('I')
  else Write('-');
end;

var
  X,Y: Single;

begin
  SetFPUExceptionMask (feInvalidOp + feDenormalOp + feZeroDivide
                     + feOverflow  + feUnderflow  + fePrecision);

  X:= -1.0;
  Y:= Sqrt(X);  { Invalid Operation }
  WriteStatus(GetFPUStatus);  
  Writeln('  ', Y:12, '  ', X:12);

  X:= 0.0;
  Y:= 1.0;
  Y:= Y/X;  { divide by Zero }
  WriteStatus(GetFPUStatus);
  Writeln('  ', Y:12, '  ', X:12);

  X:= 1.0E-34;
  Y:= 1.0E-34;
  Y:= Y*X;  { Underflow }
  WriteStatus(GetFPUStatus);
  Writeln('  ', Y:12, '  ', X:12);

end.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]