math.inc 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2000 by Jonas Maebe and other members of the
  4. Free Pascal development team
  5. Implementation of mathematical Routines (only for real)
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {****************************************************************************
  13. EXTENDED data type routines
  14. ****************************************************************************}
  15. {$define FPC_SYSTEM_HAS_ABS}
  16. function fpc_abs_real(d : valreal) : valreal;compilerproc;
  17. begin
  18. { Function is handled internal in the compiler }
  19. runerror(207);
  20. result:=0;
  21. end;
  22. {$define FPC_SYSTEM_HAS_SQR}
  23. function fpc_sqr_real(d : valreal) : valreal;compilerproc;
  24. begin
  25. { Function is handled internal in the compiler }
  26. runerror(207);
  27. result:=0;
  28. end;
  29. {$define FPC_SYSTEM_HAS_TRUNC}
  30. function fpc_trunc_real(d : valreal) : int64;compilerproc; assembler; nostackframe;
  31. { input: d in fr1 }
  32. { output: result in r3 }
  33. asm
  34. fctidz f1, f1
  35. stfd f1, -8(r1)
  36. ld r3, -8(r1)
  37. end;
  38. {$ifndef FPC_SYSTEM_HAS_ROUND}
  39. {$define FPC_SYSTEM_HAS_ROUND}
  40. function fpc_round_real(d : valreal) : int64; compilerproc;assembler; nostackframe;
  41. { exactly the same as trunc, except that one fctiwz has become fctiw }
  42. { input: d in fr1 }
  43. { output: result in r3 }
  44. asm
  45. fctid f1, f1
  46. stfd f1, -8(r1)
  47. ld r3, -8(r1)
  48. end;
  49. {$endif not FPC_SYSTEM_HAS_ROUND}
  50. {****************************************************************************
  51. Int to real helpers
  52. ****************************************************************************}
  53. {$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
  54. function fpc_int64_to_double(i: int64): double; compilerproc;assembler;
  55. { input: i in r3 }
  56. { output: double(i) in f0 }
  57. {from "PowerPC Microprocessor Family: Programming Environments Manual for 64 and 32-Bit Microprocessors", v2.0, pg. 698 }
  58. var temp : int64;
  59. asm
  60. std r3,temp // store dword
  61. lfd f0,temp // load float
  62. fcfid f0,f0 // convert to fpu int
  63. end;
  64. {$ifndef aix}
  65. {$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
  66. function fpc_qword_to_double(q: qword): double; compilerproc;assembler;
  67. const
  68. longint_to_real_helper: qword = $80000000;
  69. {from "PowerPC Microprocessor Family: Programming Environments Manual for
  70. 64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version* }
  71. { input: q in r3 }
  72. { output: double(q) in f0 }
  73. var
  74. temp1, temp2: qword;
  75. asm
  76. {$ifndef darwin}
  77. // load 2^32 into f4
  78. lis r4, longint_to_real_helper@highesta
  79. ori r4, r4, longint_to_real_helper@highera
  80. sldi r4, r4, 32
  81. oris r4, r4, longint_to_real_helper@ha
  82. lfd f4, longint_to_real_helper@l(r4)
  83. {$else not darwin}
  84. {$ifdef FPC_PIC}
  85. mflr r0
  86. bcl 20,31,.Lpiclab
  87. .Lpiclab:
  88. mflr r5
  89. mtlr r0
  90. addis r4,r5,(longint_to_real_helper-.Lpiclab)@ha
  91. lfd f2,(longint_to_real_helper-.Lpiclab)@l(r4)
  92. {$else FPC_PIC}
  93. lis r4, longint_to_real_helper@ha
  94. lfd f4, longint_to_real_helper@l(r4)
  95. {$endif FPC_PIC}
  96. {$endif not darwin}
  97. rldicl r4,r3,32,32 // isolate high half
  98. rldicl r0,r3,0,32 // isolate low half
  99. std r4,temp1 // store dword both
  100. std r0,temp2
  101. lfd f2,temp1 // load float both
  102. lfd f0,temp2 // load float both
  103. fcfid f2,f2 // convert each half to
  104. fcfid f0,f0 // fpu int (no rnd)
  105. fmadd f0,f4,f2,f0 // (2**32)*high+low (only add can rnd)
  106. end;
  107. {$endif ndef aix}