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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
{
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.
**********************************************************************}
{ i386 FPU Controlword }
{$if defined(cpui8086) or defined(cpui386) or defined(cpux86_64)}
const
Default8087CW : word = $1332;
procedure Set8087CW(cw:word);
function Get8087CW:word;
{$endif}
{$if defined (cpui386) or defined(cpux86_64)}
const
DefaultMXCSR: dword = $1900;
procedure SetMXCSR(w: dword);
function GetMXCSR: dword;
procedure SetSSECSR(w : dword); deprecated 'Renamed to SetMXCSR';
function GetSSECSR : dword; deprecated 'Renamed to GetMXCSR';
{$endif}
{$if defined(cpum68k)}
{$if defined(fpu68881) or defined(fpucoldfire)}
const
{$ifdef FPC_68K_SYSTEM_HAS_FPU_EXCEPTIONS}
Default68KFPCR: DWord = $3400; { Enable OVFL, OPERR and DZ, round to nearest, default precision }
{$else}
Default68KFPCR: DWord = 0;
{$endif}
procedure SetFPCR(x: DWord);
procedure SetFPSR(x: DWord);
function GetFPCR: DWord;
function GetFPSR: DWord;
{$endif}
{$endif}
type
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
exOverflow, exUnderflow, exPrecision);
TFPUExceptionMask = set of TFPUException;
const
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point exception flags.
-------------------------------------------------------------------------------
*}
float_flag_invalid = exInvalidOp;
float_flag_denormal = exDenormalized;
float_flag_divbyzero = exZeroDivide;
float_flag_overflow = exOverflow;
float_flag_underflow = exUnderflow;
float_flag_inexact = exPrecision;
{*
-------------------------------------------------------------------------------
Software IEC/IEEE floating-point rounding mode.
-------------------------------------------------------------------------------
*}
float_round_nearest_even = rmNearest;
float_round_down = rmDown;
float_round_up = rmUp;
float_round_to_zero = rmTruncate;
{$ifdef FPC_HAS_FEATURE_THREADING}
ThreadVar
{$else FPC_HAS_FEATURE_THREADING}
Var
{$endif FPC_HAS_FEATURE_THREADING}
softfloat_exception_mask : TFPUExceptionMask;
softfloat_exception_flags : TFPUExceptionMask;
softfloat_rounding_mode : TFPURoundingMode;
procedure float_raise(i: TFPUException);
procedure float_raise(i: TFPUExceptionMask);
{$ifdef cpui386}
{$define INTERNMATH}
{$endif}
{$ifndef INTERNMATH}
{$ifdef FPC_USE_LIBC}
{$ifdef SYSTEMINLINE}
{$define MATHINLINE}
{$endif}
{$endif}
{$endif}
function Pi : ValReal;[internproc:fpc_in_pi_real];
function Abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
function Sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
function Sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
function ArcTan(d : ValReal) : ValReal;[internproc:fpc_in_arctan_real];
function Ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
function Sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
function Cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
function Exp(d : ValReal) : ValReal;[internproc:fpc_in_exp_real];
function Round(d : ValReal) : int64;[internproc:fpc_in_round_real];
function Frac(d : ValReal) : ValReal;[internproc:fpc_in_frac_real];
function Int(d : ValReal) : ValReal;[internproc:fpc_in_int_real];
function Trunc(d : ValReal) : int64;[internproc:fpc_in_trunc_real];
{$ifdef SUPPORT_EXTENDED}
function FPower10(val: Extended; Power: Longint): Extended;
{$endif SUPPORT_EXTENDED}
type
Real48 = array[0..5] of byte;
{$ifdef SUPPORT_DOUBLE}
function Real2Double(r : real48) : double;
operator := (b:real48) d:double;
{$endif}
{$ifdef SUPPORT_EXTENDED}
operator := (b:real48) e:extended;
{$endif SUPPORT_EXTENDED}
type
TFloatSpecial = (fsZero,fsNZero,fsDenormal,fsNDenormal,fsPositive,fsNegative,
fsInf,fsNInf,fsNaN,fsInvalidOp);
{$if defined(SUPPORT_EXTENDED) or defined(FPC_SOFT_FPUX80)}
TExtended80Rec = packed record
private
const
Bias = $3FFF;
function GetExp : QWord;
procedure SetExp(e : QWord);
function GetSign : Boolean;
procedure SetSign(s : Boolean);
public
function Mantissa(IncludeHiddenBit: Boolean = False) : QWord; // unused parameter inserted to have consistent function signature
function Fraction : Extended;
function Exponent : Longint;
property Sign : Boolean read GetSign write SetSign;
property Exp : QWord read GetExp write SetExp;
function SpecialType : TFloatSpecial;
procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint);
case byte of
0: (Bytes : array[0..9] of Byte);
1: (Words : array[0..4] of Word);
{$ifdef ENDIAN_LITTLE}
2: (Frac : QWord; _Exp: Word);
{$else ENDIAN_LITTLE}
2: (_Exp: Word; Frac : QWord);
{$endif ENDIAN_LITTLE}
{$ifdef SUPPORT_EXTENDED}
3: (Value: Extended);
{$else}
3: (Value: array[0..9] of Byte);
{$endif}
end;
{$endif SUPPORT_EXTENDED or FPC_SOFT_FPUX80}
{$ifdef SUPPORT_DOUBLE}
TDoubleRec = packed record
private
const
Bias = $3FF;
function GetExp : QWord;
procedure SetExp(e : QWord);
function GetSign : Boolean;
procedure SetSign(s : Boolean);
function GetFrac : QWord;
procedure SetFrac(e : QWord);
public
function Mantissa(IncludeHiddenBit: Boolean = False) : QWord;
function Fraction : ValReal;
function Exponent : Longint;
property Sign : Boolean read GetSign write SetSign;
property Exp : QWord read GetExp write SetExp;
property Frac : QWord read Getfrac write SetFrac;
function SpecialType : TFloatSpecial;
procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint);
case byte of
0: (Bytes : array[0..7] of Byte);
1: (Words : array[0..3] of Word);
2: (Data : QWord);
3: (Value: Double);
end;
{$endif SUPPORT_DOUBLE}
{$ifdef SUPPORT_SINGLE}
TSingleRec = packed record
private
const
Bias = $7F;
function GetExp : QWord;
procedure SetExp(e : QWord);
function GetSign : Boolean;
procedure SetSign(s : Boolean);
function GetFrac : QWord;
procedure SetFrac(e : QWord);
public
function Mantissa(IncludeHiddenBit: Boolean = False) : QWord;
function Fraction : ValReal;
function Exponent : Longint;
property Sign : Boolean read GetSign write SetSign;
property Exp : QWord read GetExp write SetExp;
property Frac : QWord read Getfrac write SetFrac;
function SpecialType : TFloatSpecial;
procedure BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const _Exponent : Longint);
case byte of
0: (Bytes : array[0..3] of Byte);
1: (Words : array[0..1] of Word);
2: (Data : DWord);
3: (Value: Single);
end;
{$endif SUPPORT_SINGLE}
function FMASingle(s1,s2,s3 : single) : single;[internproc:fpc_in_fma_single];
{$ifdef SUPPORT_DOUBLE}
function FMADouble(d1,d2,d3 : double) : double;[internproc:fpc_in_fma_double];
{$endif SUPPORT_DOUBLE}
{$ifdef SUPPORT_EXTENDED}
function FMAExtended(e1,e2,e3 : extended) : extended;[internproc:fpc_in_fma_extended];
{$endif SUPPORT_EXTENDED}
{$ifdef SUPPORT_FLOAT128}
function FMAFloat128(f1,f2,f3 : float128) : float128;[internproc:fpc_in_fma_float128];
{$endif SUPPORT_FLOAT128}
|
