← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/arm/mathu.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/rtl/arm/mathu.inc
 
1
{
 
2
    This file is part of the Free Pascal run time library.
 
3
    Copyright (c) 2004 by Florian Klaempfl
 
4
    member of the Free Pascal development team
 
5
 
 
6
    See the file COPYING.FPC, included in this distribution,
 
7
    for details about the copyright.
 
8
 
 
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.
 
12
 
 
13
 **********************************************************************}
 
14
 
 
15
{$ifdef wince}
 
16
 
 
17
const
 
18
  _DN_SAVE  = $00000000;
 
19
  _DN_FLUSH = $01000000;
 
20
 
 
21
  _EM_INVALID    = $00000010;
 
22
  _EM_DENORMAL   = $00080000;
 
23
  _EM_ZERODIVIDE = $00000008;
 
24
  _EM_OVERFLOW   = $00000004;
 
25
  _EM_UNDERFLOW  = $00000002;
 
26
  _EM_INEXACT    = $00000001;
 
27
 
 
28
  _IC_AFFINE     = $00040000;
 
29
  _IC_PROJECTIVE = $00000000;
 
30
 
 
31
  _RC_CHOP       = $00000300;
 
32
  _RC_UP         = $00000200;
 
33
  _RC_DOWN       = $00000100;
 
34
  _RC_NEAR       = $00000000;
 
35
 
 
36
  _PC_24         = $00020000;
 
37
  _PC_53         = $00010000;
 
38
  _PC_64         = $00000000;
 
39
 
 
40
  _MCW_DN        = $03000000;
 
41
  _MCW_EM        = $0008001F;
 
42
  _MCW_IC        = $00040000;
 
43
  _MCW_RC        = $00000300;
 
44
  _MCW_PC        = $00030000;
 
45
 
 
46
function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
 
47
 
 
48
function GetRoundMode: TFPURoundingMode;
 
49
var
 
50
  c: dword;
 
51
begin
 
52
  c:=_controlfp(0, 0);
 
53
  Result:=TFPURoundingMode((c shr 16) and 3);
 
54
end;
 
55
 
 
56
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 
57
var
 
58
  c: dword;
 
59
begin
 
60
  c:=Ord(RoundMode) shl 16;
 
61
  c:=_controlfp(c, _MCW_RC);
 
62
  Result:=TFPURoundingMode((c shr 16) and 3);
 
63
end;
 
64
 
 
65
function GetPrecisionMode: TFPUPrecisionMode;
 
66
var
 
67
  c: dword;
 
68
begin
 
69
  c:=_controlfp(0, 0);
 
70
  if c and _MCW_PC = _PC_64 then
 
71
    Result:=pmDouble
 
72
  else
 
73
    Result:=pmSingle;
 
74
end;
 
75
 
 
76
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
 
77
var
 
78
  c: dword;
 
79
begin
 
80
  Result:=GetPrecisionMode;
 
81
  if Precision = pmSingle then
 
82
    c:=_PC_24
 
83
  else
 
84
    c:=_PC_64;
 
85
  _controlfp(c, _MCW_PC);
 
86
end;
 
87
 
 
88
function ConvertExceptionMask(em: dword): TFPUExceptionMask;
 
89
begin
 
90
  Result:=[];
 
91
  if em and _EM_INVALID <> 0 then
 
92
    Result:=Result + [exInvalidOp];
 
93
  if em and _EM_DENORMAL <> 0 then
 
94
    Result:=Result + [exDenormalized];
 
95
  if em and _EM_ZERODIVIDE <> 0 then
 
96
    Result:=Result + [exZeroDivide];
 
97
  if em and _EM_OVERFLOW <> 0 then
 
98
    Result:=Result + [exOverflow];
 
99
  if em and _EM_UNDERFLOW <> 0 then
 
100
    Result:=Result + [exUnderflow];
 
101
  if em and _EM_INEXACT <> 0 then
 
102
    Result:=Result + [exPrecision];
 
103
end;
 
104
 
 
105
function GetExceptionMask: TFPUExceptionMask;
 
106
begin
 
107
  Result:=ConvertExceptionMask(_controlfp(0, 0));
 
108
end;
 
109
 
 
110
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 
111
var
 
112
  c: dword;
 
113
begin
 
114
  c:=0;
 
115
  if exInvalidOp in Mask then
 
116
    c:=c or _EM_INVALID;
 
117
  if exDenormalized in Mask then
 
118
    c:=c or _EM_DENORMAL;
 
119
  if exZeroDivide in Mask then
 
120
    c:=c or _EM_ZERODIVIDE;
 
121
  if exOverflow in Mask then
 
122
    c:=c or _EM_OVERFLOW;
 
123
  if exUnderflow in Mask then
 
124
    c:=c or _EM_UNDERFLOW;
 
125
  if exPrecision in Mask then
 
126
    c:=c or _EM_INEXACT;
 
127
  c:=_controlfp(c, _MCW_EM);
 
128
  Result:=ConvertExceptionMask(c);
 
129
  softfloat_exception_mask:=dword(Mask);
 
130
end;
 
131
 
 
132
procedure ClearExceptions(RaisePending: Boolean =true);
 
133
begin
 
134
end;
 
135
 
 
136
{$else wince}
 
137
 
 
138
{*****************************************************************************
 
139
                                   FPA code
 
140
 *****************************************************************************}
 
141
{
 
142
 Docs from uclib
 
143
 
 
144
 * We have a slight terminology confusion here.  On the ARM, the register
 
145
 * we're interested in is actually the FPU status word - the FPU control
 
146
 * word is something different (which is implementation-defined and only
 
147
 * accessible from supervisor mode.)
 
148
 *
 
149
 * The FPSR looks like this:
 
150
 *
 
151
 *     31-24        23-16          15-8              7-0
 
152
 * | system ID | trap enable | system control | exception flags |
 
153
 *
 
154
 * We ignore the system ID bits; for interest's sake they are:
 
155
 *
 
156
 *  0000        "old" FPE
 
157
 *  1000        FPPC hardware
 
158
 *  0001        FPE 400
 
159
 *  1001        FPA hardware
 
160
 *
 
161
 * The trap enable and exception flags are both structured like this:
 
162
 *
 
163
 *     7 - 5     4     3     2     1     0
 
164
 * | reserved | INX | UFL | OFL | DVZ | IVO |
 
165
 *
 
166
 * where a `1' bit in the enable byte means that the trap can occur, and
 
167
 * a `1' bit in the flags byte means the exception has occurred.
 
168
 *
 
169
 * The exceptions are:
 
170
 *
 
171
 *  IVO - invalid operation
 
172
 *  DVZ - divide by zero
 
173
 *  OFL - overflow
 
174
 *  UFL - underflow
 
175
 *  INX - inexact (do not use; implementations differ)
 
176
 *
 
177
 * The system control byte looks like this:
 
178
 *
 
179
 *     7-5      4    3    2    1    0
 
180
 * | reserved | AC | EP | SO | NE | ND |
 
181
 *
 
182
 * where the bits mean
 
183
 *
 
184
 *  ND - no denormalised numbers (force them all to zero)
 
185
 *  NE - enable NaN exceptions
 
186
 *  SO - synchronous operation
 
187
 *  EP - use expanded packed-decimal format
 
188
 *  AC - use alternate definition for C flag on compare operations
 
189
 */
 
190
 
 
191
/* masking of interrupts */
 
192
#define _FPU_MASK_IM    0x00010000      /* invalid operation */
 
193
#define _FPU_MASK_ZM    0x00020000      /* divide by zero */
 
194
#define _FPU_MASK_OM    0x00040000      /* overflow */
 
195
#define _FPU_MASK_UM    0x00080000      /* underflow */
 
196
#define _FPU_MASK_PM    0x00100000      /* inexact */
 
197
#define _FPU_MASK_DM    0x00000000      /* denormalized operation */
 
198
 
 
199
/* The system id bytes cannot be changed.
 
200
   Only the bottom 5 bits in the trap enable byte can be changed.
 
201
   Only the bottom 5 bits in the system control byte can be changed.
 
202
   Only the bottom 5 bits in the exception flags are used.
 
203
   The exception flags are set by the fpu, but can be zeroed by the user. */
 
204
#define _FPU_RESERVED   0xffe0e0e0      /* These bits are reserved.  */
 
205
 
 
206
/* The fdlibm code requires strict IEEE double precision arithmetic,
 
207
   no interrupts for exceptions, rounding to nearest.  Changing the
 
208
   rounding mode will break long double I/O.  Turn on the AC bit,
 
209
   the compiler generates code that assumes it is on.  */
 
210
#define _FPU_DEFAULT    0x00001000      /* Default value.  */
 
211
#define _FPU_IEEE       0x001f1000      /* Default + exceptions enabled. */
 
212
}
 
213
 
 
214
 
 
215
{$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
 
216
const
 
217
  _FPU_MASK_IM  =  $00010000;      { invalid operation      }
 
218
  _FPU_MASK_ZM  =  $00020000;      { divide by zero         }
 
219
  _FPU_MASK_OM  =  $00040000;      { overflow               }
 
220
  _FPU_MASK_UM  =  $00080000;      { underflow              }
 
221
  _FPU_MASK_PM  =  $00100000;      { inexact                }
 
222
  _FPU_MASK_DM  =  $00000000;      { denormalized operation }
 
223
  _FPU_MASK_ALL =  $001f0000;      { mask for all flags     }
 
224
 
 
225
function FPU_GetCW : dword; nostackframe; assembler;
 
226
  asm
 
227
    rfs r0
 
228
  end;
 
229
 
 
230
 
 
231
procedure FPU_SetCW(cw : dword); nostackframe; assembler;
 
232
  asm
 
233
    wfs r0
 
234
  end;
 
235
{$endif}
 
236
 
 
237
 
 
238
function GetRoundMode: TFPURoundingMode;
 
239
  begin
 
240
    { does not apply }
 
241
  end;
 
242
 
 
243
 
 
244
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 
245
  begin
 
246
    { does not apply }
 
247
  end;
 
248
 
 
249
 
 
250
function GetPrecisionMode: TFPUPrecisionMode;
 
251
  begin
 
252
    { does not apply }
 
253
  end;
 
254
 
 
255
 
 
256
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
 
257
  begin
 
258
    { does not apply }
 
259
  end;
 
260
 
 
261
 
 
262
function GetExceptionMask: TFPUExceptionMask;
 
263
  var
 
264
    cw : dword;
 
265
  begin
 
266
{$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
 
267
    Result:=[];
 
268
    cw:=FPU_GetCW;
 
269
 
 
270
    if (cw and _FPU_MASK_IM)=0 then
 
271
      include(Result,exInvalidOp);
 
272
 
 
273
    if (cw and _FPU_MASK_DM)=0 then
 
274
      include(Result,exDenormalized);
 
275
 
 
276
    if (cw and _FPU_MASK_ZM)=0 then
 
277
      include(Result,exZeroDivide);
 
278
 
 
279
    if (cw and _FPU_MASK_OM)=0 then
 
280
      include(Result,exOverflow);
 
281
 
 
282
    if (cw and _FPU_MASK_UM)=0 then
 
283
      include(Result,exUnderflow);
 
284
 
 
285
    if (cw and _FPU_MASK_PM)=0 then
 
286
      include(Result,exPrecision);
 
287
{$else}
 
288
    dword(Result):=softfloat_exception_mask;
 
289
{$endif}
 
290
  end;
 
291
 
 
292
 
 
293
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 
294
  var
 
295
    cw : dword;
 
296
  begin
 
297
{$if not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
 
298
    cw:=FPU_GetCW or _FPU_MASK_ALL;
 
299
 
 
300
    if exInvalidOp in Mask then
 
301
      cw:=cw and not(_FPU_MASK_IM);
 
302
 
 
303
    if exDenormalized in Mask then
 
304
      cw:=cw and not(_FPU_MASK_DM);
 
305
 
 
306
    if exZeroDivide in Mask then
 
307
      cw:=cw and not(_FPU_MASK_ZM);
 
308
 
 
309
    if exOverflow in Mask then
 
310
      cw:=cw and not(_FPU_MASK_OM);
 
311
 
 
312
    if exUnderflow in Mask then
 
313
      cw:=cw and not(_FPU_MASK_UM);
 
314
 
 
315
    if exPrecision in Mask then
 
316
      cw:=cw and not(_FPU_MASK_PM);
 
317
 
 
318
    FPU_SetCW(cw);
 
319
{$endif}
 
320
    softfloat_exception_mask:=dword(Mask);
 
321
  end;
 
322
 
 
323
 
 
324
procedure ClearExceptions(RaisePending: Boolean =true);
 
325
  begin
 
326
  end;
 
327
 
 
328
{$endif wince}