blob: 9f3ffff15ac0ac58efd3248baacb19f4c79d36f1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Florian Klaempfl
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.
**********************************************************************}
{ exported by the system unit }
//!!!function get_fsr : dword;external name 'FPC_GETFSR';
//!!!procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
begin
result:=0;
if exInvalidOp in Mask then
result:=result or (1 shl ord(exInvalidOp));
if exDenormalized in Mask then
result:=result or (1 shl ord(exDenormalized));
if exZeroDivide in Mask then
result:=result or (1 shl ord(exZeroDivide));
if exOverflow in Mask then
result:=result or (1 shl ord(exOverflow));
if exUnderflow in Mask then
result:=result or (1 shl ord(exUnderflow));
if exPrecision in Mask then
result:=result or (1 shl ord(exPrecision));
end;
function GetRoundMode: TFPURoundingMode;
begin
//!!! result:=TFPURoundingMode(get_fsr shr 30);
end;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
begin
case (RoundMode) of
rmNearest :
softfloat_rounding_mode := float_round_nearest_even;
rmTruncate :
softfloat_rounding_mode := float_round_to_zero;
rmUp :
softfloat_rounding_mode := float_round_up;
rmDown :
softfloat_rounding_mode := float_round_down;
end;
//!!! 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);
softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
end;
procedure ClearExceptions(RaisePending: Boolean =true);
begin
//!!! set_fsr(get_fsr and $fffffc1f);
end;
|
