mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 02:19:40 +02:00
122 lines
3.1 KiB
PHP
122 lines
3.1 KiB
PHP
{
|
|
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2008 by the Free Pascal development team.
|
|
|
|
Processor dependent implementation for the system unit for
|
|
RiscV which is common to all RiscV types
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
{****************************************************************************
|
|
fpu exception related stuff
|
|
****************************************************************************}
|
|
|
|
{$ifdef FPUFD}
|
|
const
|
|
fpu_nx = 1 shl 0;
|
|
fpu_uf = 1 shl 1;
|
|
fpu_of = 1 shl 2;
|
|
fpu_dz = 1 shl 3;
|
|
fpu_nv = 1 shl 4;
|
|
|
|
function getfflags: sizeuint; nostackframe; assembler;
|
|
asm
|
|
frflags a0
|
|
end;
|
|
|
|
|
|
procedure setfflags(flags : sizeuint);
|
|
begin
|
|
DefaultFPUControlWord.cw:=flags;
|
|
asm
|
|
{$ifdef cpuriscv32}
|
|
lw a0, flags
|
|
{$else}
|
|
ld a0, flags
|
|
{$endif}
|
|
fsflags a0
|
|
end;
|
|
end;
|
|
|
|
function getrm: dword; nostackframe; assembler;
|
|
asm
|
|
frrm a0
|
|
end;
|
|
|
|
|
|
procedure setrm(val: dword);
|
|
begin
|
|
DefaultFPUControlWord.cw:=val;
|
|
asm
|
|
lw a0, val
|
|
fsrm a0
|
|
end;
|
|
end;
|
|
|
|
|
|
function GetNativeFPUControlWord: TNativeFPUControlWord; {$if defined(SYSTEMINLINE)}inline;{$endif}
|
|
begin
|
|
result.cw:=getfflags;
|
|
result.rndmode:=getrm;
|
|
end;
|
|
|
|
|
|
procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord); {$if defined(SYSTEMINLINE)}inline;{$endif}
|
|
begin
|
|
setfflags(cw.cw);
|
|
setrm(cw.rndmode);
|
|
end;
|
|
|
|
|
|
procedure RaisePendingExceptions;
|
|
var
|
|
fflags : sizeuint;
|
|
f: TFPUException;
|
|
begin
|
|
fflags:=getfflags;
|
|
if (fflags and fpu_dz) <> 0 then
|
|
float_raise(exZeroDivide);
|
|
if (fflags and fpu_of) <> 0 then
|
|
float_raise(exOverflow);
|
|
if (fflags and fpu_uf) <> 0 then
|
|
float_raise(exUnderflow);
|
|
if (fflags and fpu_nv) <> 0 then
|
|
float_raise(exInvalidOp);
|
|
if (fflags and fpu_nx) <> 0 then
|
|
float_raise(exPrecision);
|
|
{ now the soft float exceptions }
|
|
for f in softfloat_exception_flags do
|
|
float_raise(f);
|
|
end;
|
|
|
|
|
|
procedure fpc_throwfpuexception;[public,alias:'FPC_THROWFPUEXCEPTION'];
|
|
var
|
|
fflags : sizeuint;
|
|
begin
|
|
fflags:=getfflags;
|
|
{ check, if the exception is masked }
|
|
if ((fflags and fpu_dz) <> 0) and (exZeroDivide in softfloat_exception_mask) then
|
|
fflags:=fflags and not(fpu_dz);
|
|
if ((fflags and fpu_of) <> 0) and (exOverflow in softfloat_exception_mask) then
|
|
fflags:=fflags and not(fpu_of);
|
|
if ((fflags and fpu_uf) <> 0) and (exUnderflow in softfloat_exception_mask) then
|
|
fflags:=fflags and not(fpu_uf);
|
|
if ((fflags and fpu_nv) <> 0) and (exInvalidOp in softfloat_exception_mask) then
|
|
fflags:=fflags and not(fpu_nv);
|
|
if ((fflags and fpu_nx) <> 0) and (exPrecision in softfloat_exception_mask) then
|
|
fflags:=fflags and not(fpu_nx);
|
|
setfflags(fflags);
|
|
if fflags<>0 then
|
|
RaisePendingExceptions;
|
|
end;
|
|
{$endif FPUFD}
|