paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 06:29:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

* ppc32: added FPU configuration code in math unit (fixes tw3161)

Browse Source 
git-svn-id: trunk@1787 -
This commit is contained in:
tom_at_work 2005-11-20 01:21:55 +00:00
parent 651f34e27c
commit 174297c4cf
2 changed files with 129 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
rtl/powerpc/mathu.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Florian Klaempfl
Copyright (c) 2005 by Thomas Schatzl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
@ -11,3 +11,110 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
const
RoundModeMask = %00000011;
NonIEEEModeMask = %00000100;
InvalidOperationMask = %10000000;
OverflowMask = %01000000;
UnderflowMask = %00100000;
ZeroDivideMask = %00010000;
InexactMask = %00001000;
ExceptionMask = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
AllConfigBits = ExceptionMask or NonIEEEModeMask or RoundModeMask;
function getFPSCR : DWord; assembler; nostackframe;
asm
mffs f0
stfd f0, -8(r1)
lwz r3, -12(r1)
end;
procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
asm
stw r3, -12(r1)
lfd f0, -8(r1)
mtfsf 255, f0
end;
function GetRoundMode: TFPURoundingMode;
begin
case (getFPSCR and RoundModeMask) of
0 : result := rmNearest;
1 : result := rmTruncate;
2 : result := rmUp;
3 : result := rmDown;
end;
end;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
var
mode : DWord;
begin
case (RoundMode) of
rmNearest : mode := 0;
rmTruncate : mode := 1;
rmUp : mode := 2;
rmDown : mode := 3;
end;
setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
result := RoundMode;
end;
function GetPrecisionMode: TFPUPrecisionMode;
begin
result := pmDouble;
end;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
begin
{ nothing to do, not supported }
end;
function GetExceptionMask: TFPUExceptionMask;
begin
result := [];
if ((getFPSCR and InvalidOperationMask) <> 0) then
result := result + [exInvalidOp];
if ((getFPSCR and OverflowMask) <> 0) then
result := result + [exOverflow];
if ((getFPSCR and UnderflowMask) <> 0) then
result := result + [exUnderflow];
if ((getFPSCR and ZeroDivideMask) <> 0) then
result := result + [exZeroDivide];
if ((getFPSCR and InexactMask) <> 0) then
result := result + [exPrecision];
end;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
var
mode : DWord;
begin
mode := 0;
if (exInvalidOp in Mask) then
mode := mode or InvalidOperationMask;
if (exOverflow in Mask) then
mode := mode or OverflowMask;
if (exUnderflow in Mask) then
mode := mode or UnderflowMask;
if (exZeroDivide in Mask) then
mode := mode or ZeroDivideMask;
if (exPrecision in Mask) then
mode := mode or InexactMask;
setFPSCR((getFPSCR and (not ExceptionMask)) or mode);
result := Mask - [exDenormalized];
end;
procedure ClearExceptions(RaisePending: Boolean = true);
begin
{ RaisePending has no effect on PPC, always raises them at the correct location }
setFPSCR(getFPSCR and (not AllConfigBits));
end;

22
rtl/powerpc/mathuh.inc
View File

@ -1,6 +1,6 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Florian Klaempfl
Copyright (c) 1999-2005 by Florian Klaempfl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
@ -11,3 +11,23 @@
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 = true);