fpc/rtl/aarch64/mathu.inc

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