2
This file is part of the Free Pascal run time library.
3
Copyright (c) 2005 by Thomas Schatzl
4
member of the Free Pascal development team
6
See the file COPYING.FPC, included in this distribution,
7
for details about the copyright.
9
This program is distributed in the hope that it will be useful,
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
**********************************************************************}
16
RoundModeMask = %00000011;
17
NonIEEEModeMask = %00000100;
19
InvalidOperationMask = %10000000;
20
OverflowMask = %01000000;
21
UnderflowMask = %00100000;
22
ZeroDivideMask = %00010000;
23
InexactMask = %00001000;
24
ExceptionsPendingMask = %11111111111111100000011100000000;
26
ExceptionMask = InvalidOperationMask or OverflowMask or UnderflowMask or ZeroDivideMask or InexactMask;
28
AllConfigBits = ExceptionMask or NonIEEEModeMask or RoundModeMask;
30
function getFPSCR : DWord; assembler; nostackframe;
37
procedure setFPSCR(newFPSCR : DWord); assembler; nostackframe;
44
function GetRoundMode: TFPURoundingMode;
46
case (getFPSCR and RoundModeMask) of
47
0 : result := rmNearest;
48
1 : result := rmTruncate;
54
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
59
rmNearest : mode := 0;
60
rmTruncate : mode := 1;
64
setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
69
function GetPrecisionMode: TFPUPrecisionMode;
74
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
76
{ nothing to do, not supported }
81
function GetExceptionMask: TFPUExceptionMask;
84
if ((getFPSCR and InvalidOperationMask) = 0) then
85
result := result + [exInvalidOp];
86
if ((getFPSCR and OverflowMask) = 0) then
87
result := result + [exOverflow];
88
if ((getFPSCR and UnderflowMask) = 0) then
89
result := result + [exUnderflow];
90
if ((getFPSCR and ZeroDivideMask) = 0) then
91
result := result + [exZeroDivide];
92
if ((getFPSCR and InexactMask) = 0) then
93
result := result + [exPrecision];
96
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
101
if (exInvalidOp in Mask) then
102
mode := mode or InvalidOperationMask;
103
if (exOverflow in Mask) then
104
mode := mode or OverflowMask;
105
if (exUnderflow in Mask) then
106
mode := mode or UnderflowMask;
107
if (exZeroDivide in Mask) then
108
mode := mode or ZeroDivideMask;
109
if (exPrecision in Mask) then
110
mode := mode or InexactMask;
112
setFPSCR((getFPSCR or ExceptionMask) and not mode and not ExceptionsPendingMask);
113
result := Mask - [exDenormalized];
117
procedure ClearExceptions(RaisePending: Boolean = true);
119
{ RaisePending has no effect on PPC, always raises them at the correct location }
120
setFPSCR(getFPSCR and (not AllConfigBits));