paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 10:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ FPU controll routines in math unit

Browse Source
This commit is contained in:
florian 2005-02-13 18:58:27 +00:00
parent f58fcdf401
commit ad3a4a93ef
3 changed files with 142 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
rtl/sparc/mathu.inc
View File

@ -12,9 +12,117 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ exported by the system unit }
function get_fsr : dword;external name 'FPC_GETFSR';
procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
function GetRoundMode: TFPURoundingMode;
begin
result:=TFPURoundingMode(get_fsr shr 30);
end;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
begin
set_fsr((get_fsr and $3fffffff) or (dword(RoundMode) shl 30));
result:=TFPURoundingMode(get_fsr shr 30);
end;
function GetPrecisionMode: TFPUPrecisionMode;
begin
result:=pmDouble;
end;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
begin
result:=pmDouble;
end;
function GetExceptionMask: TFPUExceptionMask;
var
fsr : dword;
begin
fsr:=get_fsr;
result:=[];
{ invalid operation: bit 27 }
if (fsr and (1 shl 27))=0 then
include(result,exInvalidOp);
{ zero divide: bit 24 }
if (fsr and (1 shl 24))=0 then
include(result,exInvalidOp);
{ overflow: bit 26 }
if (fsr and (1 shl 26))=0 then
include(result,exInvalidOp);
{ underflow: bit 25 }
if (fsr and (1 shl 25))=0 then
include(result,exUnderflow);
{ Precision (inexact result): bit 23 }
if (fsr and (1 shl 23))=0 then
include(result,exPrecision);
end;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
var
fsr : dword;
begin
fsr:=get_fsr;
{ invalid operation: bit 27 }
if (exInvalidOp in mask) then
fsr:=fsr and not(1 shl 27)
else
fsr:=fsr or (1 shl 27);
{ zero divide: bit 24 }
if (exZeroDivide in mask) then
fsr:=fsr and not(1 shl 24)
else
fsr:=fsr or (1 shl 24);
{ overflow: bit 26 }
if (exOverflow in mask) then
fsr:=fsr and not(1 shl 26)
else
fsr:=fsr or (1 shl 26);
{ underflow: bit 25 }
if (exUnderflow in mask) then
fsr:=fsr and not(1 shl 25)
else
fsr:=fsr or (1 shl 25);
{ Precision (inexact result): bit 23 }
if (exPrecision in mask) then
fsr:=fsr and not(1 shl 23)
else
fsr:=fsr or (1 shl 23);
{ update control register contents }
set_fsr(fsr);
end;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
begin
set_fsr(get_fsr and $fffffc1f);
end;
{
$Log$
Revision 1.1 2003-09-01 20:46:32 peter
Revision 1.2 2005-02-13 18:58:27 florian
+ FPU controll routines in math unit
Revision 1.1 2003/09/01 20:46:32 peter
* new dummies
Revision 1.1 2003/04/24 09:14:22 florian

21
rtl/sparc/mathuh.inc
View File

@ -12,9 +12,28 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
type
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
exOverflow, exUnderflow, exPrecision);
TFPUExceptionMask = set of TFPUException;
function GetRoundMode: TFPURoundingMode;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
function GetPrecisionMode: TFPUPrecisionMode;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
{
$Log$
Revision 1.1 2003-09-01 20:46:32 peter
Revision 1.2 2005-02-13 18:58:27 florian
+ FPU controll routines in math unit
Revision 1.1 2003/09/01 20:46:32 peter
* new dummies
Revision 1.1 2003/04/24 09:14:22 florian

23
rtl/sparc/sparc.inc
View File

@ -20,7 +20,7 @@
{****************************************************************************
SPARC specific stuff
****************************************************************************}
function get_fsr : dword;assembler;nostackframe;
function get_fsr : dword;assembler;nostackframe;[public, alias: 'FPC_GETFSR'];
var
fsr : dword;
asm
@ -29,14 +29,7 @@ function get_fsr : dword;assembler;nostackframe;
end;
function get_got : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT'];
asm
retl
add %o7,%l7,%l7
end;
procedure set_fsr(fsr : dword);assembler;
procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
var
_fsr : dword;
asm
@ -46,6 +39,13 @@ procedure set_fsr(fsr : dword);assembler;
end;
function get_got : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT'];
asm
retl
add %o7,%l7,%l7
end;
procedure fpc_cpuinit;
begin
{ enable div by 0 and invalid operation fpu exceptions }
@ -362,7 +362,10 @@ end;
{
$Log$
Revision 1.19 2005-02-07 22:17:48 peter
Revision 1.20 2005-02-13 18:58:27 florian
+ FPU controll routines in math unit
Revision 1.19 2005/02/07 22:17:48 peter
* add $ifdef for move
Revision 1.18 2005/01/27 21:26:39 florian