kennedym@topaz.ucq.edu.au (01/02/91)
{$N+,E+}{Must compile using 8087,and emulator}
Program NoFpError;
{
Program to demostrate how to catch floating pointer errors
with acknowledgement to Turbo Power's Object 1.0 where the original idea
came from.
Works by telling the 8087 chip not to generate an exception in case of a
floating point error
Author: Matthew Kennedy,
UCCQ Rockhampton Australia
}
Type
Float=Double;{
Don't want any type conversion,other wise
you'll get runtime errors when doing the double->real
conversion
}
Var
StatusWord:Word;
ControlWord:Word;
{$ifdef ver60}
Procedure Exception8087Off; assembler;
{
* Turns off 8087 error checking
}
Asm
FSTCW ControlWord {get the control word}
OR ControlWord,00FFH {mask out error checking}
FLDCW ControlWord {write the control word}
End;
Procedure Exception8087On; assembler;
{
* turn on 8087 error checking
}
Asm
MOV ControlWord,0372h {set default control word}
FLDCW ControlWord
End;
Function Error8087:Word;Assembler;
{
* Checks to see if 8087 exception has occurred
}
Asm
FSTSW StatusWord {get the status word}
MOV AX,StatusWord
AND AX,$3F {only the error codes}
FCLEX
End;
{$else}
{$ifopt e-}
the emulator must be on
{$endif}
{
note the emulator uses the intr(35 - 39),
}
Procedure Exception8087Off;
{Turn off 8087 error checking}
Begin
Inline(
$CD/$35/$3E/ ControlWord/ {FSTCW ControlWord }
$81/$0E/ ControlWord/ $FF/$00/ {OR ControlWord,00FFH}
$CD/$35/$2E/ ControlWord {FLDCW ControlWord }
);
end;
Procedure Exception8087On;
{turn on 8087 error checking}
begin
Inline(
$C7/$06/ ControlWord/ >$0372/ {Mov ControlWord,0372h}
$CD/$35/$2E/ ControlWord {FLDCW ControlWord }
);
end;
Function Error8087:Word;
Inline(
$CD/$39/$3E/ ControlWord/ {FSTSW ControlWord}
$A1/ ControlWord/ {mov Ax,ControlWord}
$25/ >$003F/ {AND AX,03Fh}
$CD/$37/$E2 {FCLEX}
);
{$endif}
Function Error8087Str(Err:Word):string;
{
* Converts an 8087 error code to english
}
var
s:string;
Begin{Error8087Str}
case err of
0 :Error8087Str:='No Error';
1 :Error8087Str:='Invalid Operation';
2 :Error8087Str:='Denormalised Operand';
4 :Error8087Str:='Zero Divide';
8 :Error8087Str:='Overflow';
16:Error8087Str:='Underflow';
32:Error8087Str:='Precision';
Else
Begin
Str(err,s);
Error8087Str:='Error Code '+s;
End
End;{Case}
End;{Error8087Str}
Var
x,y,z:Float;
err:word;
Begin
Exception8087Off;
x:=1;
y:=0;
z:=x/y;
err:=Error8087;
writeln(x:1:13,'/',y:1:13,'=',z:1:13);
writeln(Error8087Str(Err));
Exception8087on;
End.