From 84f04ad2ce25ab06ce3f10e82e41a7630321fb30 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Mon, 23 Feb 2015 22:50:48 +0000
Subject: [PATCH]   + aarch64 fpu rounding mode/exception support

git-svn-id: trunk@29879 -
---
 .gitattributes        |   1 +
 rtl/aarch64/mathu.inc | 136 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 137 insertions(+)
 create mode 100644 rtl/aarch64/mathu.inc

diff --git a/.gitattributes b/.gitattributes
index 195f47060b..a62ce3d32b 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/rtl/aarch64/mathu.inc b/rtl/aarch64/mathu.inc
new file mode 100644
index 0000000000..db78d8a088
--- /dev/null
+++ b/rtl/aarch64/mathu.inc
@@ -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;