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.