← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/powerpc/math.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/powerpc/math.inc
1
1
{
2
 
    $Id: math.inc,v 1.33 2004/02/09 20:21:06 olle Exp $
 
2
    $Id: math.inc,v 1.39 2005/02/14 17:13:31 peter Exp $
3
3
    This file is part of the Free Pascal run time library.
4
4
    Copyright (c) 2000 by Jonas Maebe and other members of the
5
5
    Free Pascal development team
26
26
                       EXTENDED data type routines
27
27
 ****************************************************************************}
28
28
 
29
 
    {$define FPC_SYSTEM_HAS_PI}
30
 
    function pi : double;[internproc:in_pi];
31
 
 
32
 
    {$define FPC_SYSTEM_HAS_ABS}
33
 
    function abs(d : extended) : extended;[internproc:in_abs_extended];
34
 
 
35
 
    {$define FPC_SYSTEM_HAS_SQR}
36
 
    function sqr(d : extended) : extended;[internproc:in_sqr_extended];
37
 
 
38
 
    {
39
 
    function arctan(d : extended) : extended;[internconst:in_arctan_extended];
40
 
      begin
41
 
        runerror(207);
42
 
      end;
43
 
 
44
 
    function ln(d : extended) : extended;[internconst:in_ln_extended];
45
 
      begin
46
 
        runerror(207);
47
 
      end;
48
 
 
49
 
    function sin(d : extended) : extended;[internconst: in_sin_extended];
50
 
      begin
51
 
        runerror(207);
52
 
      end;
53
 
 
54
 
    function cos(d : extended) : extended;[internconst:in_cos_extended];
55
 
      begin
56
 
        runerror(207);
57
 
      end;
58
 
 
59
 
    function exp(d : extended) : extended;[internconst:in_const_exp];
60
 
      begin
61
 
        runerror(207);
62
 
      end;
63
 
 
64
 
    }
 
29
{$ifdef INTERNCONSTINTF}
 
30
    {$define FPC_SYSTEM_HAS_PI}
 
31
    function fpc_pi_real : valreal;compilerproc;
 
32
    begin
 
33
      { Function is handled internal in the compiler }
 
34
      runerror(207);
 
35
      result:=0;
 
36
    end;
 
37
 
 
38
    {$define FPC_SYSTEM_HAS_ABS}
 
39
    function fpc_abs_real(d : valreal) : valreal;compilerproc;
 
40
    begin
 
41
      { Function is handled internal in the compiler }
 
42
      runerror(207);
 
43
      result:=0;
 
44
    end;
 
45
 
 
46
    {$define FPC_SYSTEM_HAS_SQR}
 
47
    function fpc_sqr_real(d : valreal) : valreal;compilerproc;
 
48
    begin
 
49
      { Function is handled internal in the compiler }
 
50
      runerror(207);
 
51
      result:=0;
 
52
    end;
 
53
 
 
54
{$else}
 
55
    {$define FPC_SYSTEM_HAS_PI}
 
56
    function pi : double;[internproc:fpc_in_pi];
 
57
 
 
58
    {$define FPC_SYSTEM_HAS_ABS}
 
59
    function abs(d : extended) : extended;[internproc:fpc_in_abs_real];
 
60
 
 
61
    {$define FPC_SYSTEM_HAS_SQR}
 
62
    function sqr(d : extended) : extended;[internproc:fpc_in_sqr_real];
 
63
{$endif ndef INTERNCONSTINTF}
65
64
 
66
65
      const
67
66
        factor: double = double(int64(1) shl 32);
68
67
        factor2: double = double(int64(1) shl 31);
69
68
 
 
69
{$ifndef FPC_SYSTEM_HAS_TRUNC}
70
70
    {$define FPC_SYSTEM_HAS_TRUNC}
71
 
    function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
 
71
    {$ifdef INTERNCONSTINTF}
 
72
    function fpc_trunc_real(d : valreal) : int64;assembler;compilerproc;
 
73
    {$else}
 
74
    function trunc(d : extended) : int64;assembler;[internconst:fpc_in_const_trunc];
 
75
    {$endif}
72
76
      { input: d in fr1      }
73
77
      { output: result in r3 }
74
78
      assembler;
154
158
        subfze r3,r3
155
159
.LTruncPositive:
156
160
      end;
157
 
 
158
 
 
 
161
{$endif not FPC_SYSTEM_HAS_TRUNC}
 
162
 
 
163
 
 
164
(*
 
165
{$ifndef FPC_SYSTEM_HAS_ROUND}
159
166
    {$define FPC_SYSTEM_HAS_ROUND}
160
167
{$ifdef hascompilerproc}
161
 
    function round(d : extended) : int64;[internconst:in_const_round, external name 'FPC_ROUND'];
 
168
    function round(d : extended) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round, external name 'FPC_ROUND'];{$endif}
162
169
 
163
170
    function fpc_round(d : extended) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
164
171
{$else}
165
 
    function round(d : extended) : int64;assembler;[internconst:in_const_round];
 
172
    function round(d : extended) : int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
166
173
{$endif hascompilerproc}
167
174
      { exactly the same as trunc, except that one fctiwz has become fctiw }
168
175
      { input: d in fr1      }
250
257
        subfze r3,r3
251
258
.LRoundPositive:
252
259
      end;
253
 
 
254
 
 
255
 
   {$define FPC_SYSTEM_HAS_POWER}
256
 
   function power(bas,expo : extended) : extended;
257
 
     begin
258
 
        if bas=0 then
259
 
          begin
260
 
            if expo<>0 then
261
 
              power:=0.0
262
 
            else
263
 
              HandleError(207);
264
 
          end
265
 
        else if expo=0 then
266
 
         power:=1
267
 
        else
268
 
        { bas < 0 is not allowed }
269
 
         if bas<0 then
270
 
          handleerror(207)
271
 
         else
272
 
          power:=exp(ln(bas)*expo);
273
 
     end;
274
 
 
275
 
 
276
 
{****************************************************************************
277
 
                       Longint data type routines
278
 
 ****************************************************************************}
279
 
 
280
 
   {$define FPC_SYSTEM_HAS_POWER_INT64}
281
 
   function power(bas,expo : int64) : int64;
282
 
     begin
283
 
        if bas=0 then
284
 
          begin
285
 
            if expo<>0 then
286
 
              power:=0
287
 
            else
288
 
              HandleError(207);
289
 
          end
290
 
        else if expo=0 then
291
 
         power:=1
292
 
        else
293
 
         begin
294
 
           if bas<0 then
295
 
            begin
296
 
              if odd(expo) then
297
 
                power:=-round(exp(ln(-bas)*expo))
298
 
              else
299
 
                power:=round(exp(ln(-bas)*expo));
300
 
            end
301
 
           else
302
 
            power:=round(exp(ln(bas)*expo));
303
 
         end;
304
 
     end;
305
 
 
306
 
{****************************************************************************
307
 
                    Helper routines to support old TP styled reals
308
 
 ****************************************************************************}
309
 
 
310
 
    { warning: the following converts a little-endian TP-style real }
311
 
    { to a big-endian double. So don't byte-swap the TP real!       }
312
 
    {$define FPC_SYSTEM_HAS_REAL2DOUBLE}
313
 
    function real2double(r : real48) : double;
314
 
 
315
 
      var
316
 
         res : array[0..7] of byte;
317
 
         exponent : word;
318
 
 
319
 
      begin
320
 
         { copy mantissa }
321
 
         res[6]:=0;
322
 
         res[5]:=r[1] shl 5;
323
 
         res[4]:=(r[1] shr 3) or (r[2] shl 5);
324
 
         res[3]:=(r[2] shr 3) or (r[3] shl 5);
325
 
         res[2]:=(r[3] shr 3) or (r[4] shl 5);
326
 
         res[1]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
327
 
         res[0]:=(r[5] and $7f) shr 3;
328
 
 
329
 
         { copy exponent }
330
 
         { correct exponent: }
331
 
         exponent:=(word(r[0])+(1023-129));
332
 
         res[1]:=res[1] or ((exponent and $f) shl 4);
333
 
         res[0]:=exponent shr 4;
334
 
 
335
 
         { set sign }
336
 
         res[0]:=res[0] or (r[5] and $80);
337
 
         real2double:=double(res);
338
 
      end;
 
260
{$endif not FPC_SYSTEM_HAS_ROUND}
 
261
*)
339
262
 
340
263
 
341
264
{****************************************************************************
426
349
 
427
350
{
428
351
  $Log: math.inc,v $
429
 
  Revision 1.33  2004/02/09 20:21:06  olle
430
 
    * fixed global variable access in asm
431
 
 
432
 
  Revision 1.32  2003/12/07 19:55:37  jonas
433
 
    - reverted previous patch, solved with the new assembler reader
434
 
      (which didn't understand the new syntax)
435
 
 
436
 
  Revision 1.30  2003/11/15 19:01:27  florian
437
 
    * fixed rtl to work with the integrated fpc ppc assembler reader
438
 
 
439
 
  Revision 1.29  2003/09/04 16:07:31  florian
440
 
    * fixed qword_to_double conversion on powerpc
441
 
 
442
 
  Revision 1.28  2003/09/03 14:09:37  florian
443
 
    * arm fixes to the common rtl code
444
 
    * some generic math code fixed
445
 
    * ...
446
 
 
447
 
  Revision 1.27  2003/08/08 22:02:05  olle
448
 
    * small bugfix macos
449
 
 
450
 
  Revision 1.26  2003/06/14 12:41:08  jonas
451
 
    * fixed compilation problems (removed unnecessary modified registers
452
 
      lists from procedures)
453
 
 
454
 
  Revision 1.25  2003/05/31 20:22:06  jonas
455
 
    * fixed 64 bit results of trunc and round
456
 
 
457
 
  Revision 1.24  2003/05/30 23:56:41  florian
458
 
    * fixed parameter passing for int64
459
 
 
460
 
  Revision 1.23  2003/05/24 13:39:32  jonas
461
 
    * fsqrt is an optional instruction in the ppc architecture and isn't
462
 
      implemented by any current ppc afaik, so use the generic sqrt routine
463
 
      instead (adapted so it works with compilerproc)
464
 
 
465
 
  Revision 1.22  2003/05/16 16:04:33  jonas
466
 
    * fixed round() (almost the same as trunc)
467
 
 
468
 
  Revision 1.21  2003/05/11 18:09:45  jonas
469
 
    * fixed qword and int64 to double conversion
470
 
 
471
 
  Revision 1.20  2003/05/02 15:12:19  jonas
472
 
    - removed empty ppc-specific frac()
473
 
    + added correct generic frac() implementation for doubles (translated
474
 
      from glibc code)
475
 
 
476
 
  Revision 1.19  2003/04/26 20:36:24  jonas
477
 
    * trunc now also supports int64 (no NaN's etc though)
478
 
 
479
 
  Revision 1.18  2003/04/26 17:20:16  florian
480
 
    * fixed trunc, now it's working at least for longint range
481
 
 
482
 
  Revision 1.17  2003/04/23 21:28:21  peter
483
 
    * fpc_round added, needed for int64 currency
484
 
 
485
 
  Revision 1.16  2003/01/16 11:29:11  olle
486
 
    * changed access of globals to be indirect via TOC
487
 
 
488
 
  Revision 1.15  2003/01/15 01:09:04  florian
489
 
    * changed power(...) prototype to int64
490
 
 
491
 
  Revision 1.14  2002/11/28 11:04:16  olle
492
 
    * macos: refs to globals in asm adapted to macos
493
 
 
494
 
  Revision 1.13  2002/10/21 18:08:28  jonas
495
 
    * round has int64 instead of longint result
496
 
 
497
 
  Revision 1.12  2002/09/08 13:00:21  jonas
498
 
    * made pi an internproc instead of internconst
499
 
 
500
 
  Revision 1.11  2002/09/07 16:01:26  peter
501
 
    * old logs removed and tabs fixed
502
 
 
503
 
  Revision 1.10  2002/08/18 22:11:10  florian
504
 
    * fixed remaining assembler errors
505
 
 
506
 
  Revision 1.9  2002/08/18 21:37:48  florian
507
 
    * several errors in inline assembler fixed
508
 
 
509
 
  Revision 1.8  2002/08/10 17:14:36  jonas
510
 
    * various fixes, mostly changing the names of the modifies registers to
511
 
      upper case since that seems to be required by the compiler
512
 
 
513
 
  Revision 1.7  2002/07/31 16:58:12  jonas
514
 
    * fixed conversion from int64/qword to double errors
515
 
 
516
 
  Revision 1.6  2002/07/29 21:28:17  florian
517
 
    * several fixes to get further with linux/ppc system unit compilation
518
 
 
519
 
  Revision 1.5  2002/07/28 21:39:29  florian
520
 
    * made abs a compiler proc if it is generic
521
 
 
522
 
  Revision 1.4  2002/07/28 20:43:49  florian
523
 
    * several fixes for linux/powerpc
524
 
    * several fixes to MT
 
352
  Revision 1.39  2005/02/14 17:13:31  peter
 
353
    * truncate log
525
354
 
526
355
}