+ aarch64 fpu rounding mode/exception support

git-svn-id: trunk@29879 -
This commit is contained in:
Jonas Maebe 2015-02-23 22:50:48 +00:00
parent 9c55fa6f6c
commit 84f04ad2ce
2 changed files with 137 additions and 0 deletions

1
.gitattributes vendored
View File

@ -7868,6 +7868,7 @@ rtl/COPYING.txt svneol=native#text/plain
rtl/Makefile svneol=native#text/plain
rtl/Makefile.fpc svneol=native#text/plain
rtl/README.txt svneol=native#text/plain
rtl/aarch64/mathu.inc svneol=native#text/plain
rtl/aix/Makefile svneol=native#text/plain
rtl/aix/Makefile.fpc svneol=native#text/plain
rtl/aix/dlaix.inc svneol=native#text/plain

136
rtl/aarch64/mathu.inc Normal file
View File

@ -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;