|
@@ -0,0 +1,136 @@
|
|
|
+{
|
|
|
+ This file is part of the Free Pascal run time library.
|
|
|
+ Copyright (c) 2014 by Jonas Maebe
|
|
|
+ member of the Free Pascal development team
|
|
|
+
|
|
|
+ See the file COPYING.FPC, included in this distribution,
|
|
|
+ for details about the copyright.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
+
|
|
|
+**********************************************************************}
|
|
|
+
|
|
|
+{$asmmode gas}
|
|
|
+
|
|
|
+function getfpcr: dword; nostackframe; assembler;
|
|
|
+ asm
|
|
|
+ mrs x0,fpcr
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+procedure setfpcr(val: dword); nostackframe; assembler;
|
|
|
+ asm
|
|
|
+ msr fpcr,x0
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function getfpsr: dword; nostackframe; assembler;
|
|
|
+ asm
|
|
|
+ mrs x0,fpsr
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+procedure setfpsr(val: dword); nostackframe; assembler;
|
|
|
+ asm
|
|
|
+ msr fpsr, x0
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function GetRoundMode: TFPURoundingMode;
|
|
|
+ const
|
|
|
+ bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmUp,rmDown,rmTruncate);
|
|
|
+ begin
|
|
|
+ result:=TFPURoundingMode(bits2rm[(getfpcr shr 22) and 3])
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
|
|
|
+ const
|
|
|
+ rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
|
|
|
+ begin
|
|
|
+ softfloat_rounding_mode:=RoundMode;
|
|
|
+ SetRoundMode:=RoundMode;
|
|
|
+ setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function GetPrecisionMode: TFPUPrecisionMode;
|
|
|
+ begin
|
|
|
+ result:=pmDouble;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
|
|
|
+ begin
|
|
|
+ result:=pmDouble;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+ fpu_ioe = 1 shl 8;
|
|
|
+ fpu_dze = 1 shl 9;
|
|
|
+ fpu_ofe = 1 shl 10;
|
|
|
+ fpu_ufe = 1 shl 11;
|
|
|
+ fpu_ixe = 1 shl 12;
|
|
|
+ fpu_ide = 1 shl 15;
|
|
|
+ fpu_exception_mask = fpu_ioe or fpu_dze or fpu_ofe or fpu_ufe or fpu_ixe or fpu_ide;
|
|
|
+ fpu_exception_mask_to_status_mask_shift = 8;
|
|
|
+
|
|
|
+
|
|
|
+function GetExceptionMask: TFPUExceptionMask;
|
|
|
+ var
|
|
|
+ fpcr: dword;
|
|
|
+ begin
|
|
|
+ fpcr:=getfpcr;
|
|
|
+ result:=[];
|
|
|
+ if ((fpcr and fpu_ioe)=0) then
|
|
|
+ result := result+[exInvalidOp];
|
|
|
+ if ((fpcr and fpu_ofe)=0) then
|
|
|
+ result := result+[exOverflow];
|
|
|
+ if ((fpcr and fpu_ufe)=0) then
|
|
|
+ result := result+[exUnderflow];
|
|
|
+ if ((fpcr and fpu_dze)=0) then
|
|
|
+ result := result+[exZeroDivide];
|
|
|
+ if ((fpcr and fpu_ixe)=0) then
|
|
|
+ result := result+[exPrecision];
|
|
|
+ if ((fpcr and fpu_ide)=0) then
|
|
|
+ result := result+[exDenormalized];
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
|
|
+ var
|
|
|
+ newfpcr: dword;
|
|
|
+ begin
|
|
|
+ softfloat_exception_mask:=mask;
|
|
|
+ newfpcr:=fpu_exception_mask;
|
|
|
+ if exInvalidOp in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_ioe);
|
|
|
+ if exOverflow in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_ofe);
|
|
|
+ if exUnderflow in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_ufe);
|
|
|
+ if exZeroDivide in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_dze);
|
|
|
+ if exPrecision in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_ixe);
|
|
|
+ if exDenormalized in Mask then
|
|
|
+ newfpcr:=newfpcr and not(fpu_ide);
|
|
|
+ { clear "exception happened" flags }
|
|
|
+ ClearExceptions(false);
|
|
|
+ { set new exception mask }
|
|
|
+ setfpcr((getfpcr and not(fpu_exception_mask)) or newfpcr);
|
|
|
+ { unsupported mask bits will remain 0 -> read exception mask again }
|
|
|
+ result:=GetExceptionMask;
|
|
|
+ softfloat_exception_mask:=result;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+procedure ClearExceptions(RaisePending: Boolean);
|
|
|
+ begin
|
|
|
+ { todo: RaisePending = true }
|
|
|
+ softfloat_exception_flags:=[];
|
|
|
+ setfpsr(getfpsr and not(fpu_exception_mask shr fpu_exception_mask_to_status_mask_shift));
|
|
|
+ end;
|