math.inc 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  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_PI}
  16. function fpc_pi_real : 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_ABS}
  23. function fpc_abs_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_SQR}
  30. function fpc_sqr_real(d : valreal) : valreal;compilerproc;
  31. begin
  32. { Function is handled internal in the compiler }
  33. runerror(207);
  34. result:=0;
  35. end;
  36. {$define FPC_SYSTEM_HAS_TRUNC}
  37. function fpc_trunc_real(d : valreal) : int64;compilerproc; assembler; nostackframe;
  38. { input: d in fr1 }
  39. { output: result in r3 }
  40. asm
  41. fctidz f1, f1
  42. stfd f1, -8(r1)
  43. ld r3, -8(r1)
  44. end;
  45. {$ifndef FPC_SYSTEM_HAS_ROUND}
  46. {$define FPC_SYSTEM_HAS_ROUND}
  47. function fpc_round_real(d : valreal) : int64; compilerproc;assembler; nostackframe;
  48. { exactly the same as trunc, except that one fctiwz has become fctiw }
  49. { input: d in fr1 }
  50. { output: result in r3 }
  51. asm
  52. fctid f1, f1
  53. stfd f1, -8(r1)
  54. ld r3, -8(r1)
  55. end;
  56. {$endif not FPC_SYSTEM_HAS_ROUND}
  57. {****************************************************************************
  58. Int to real helpers
  59. ****************************************************************************}
  60. {$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
  61. function fpc_int64_to_double(i: int64): double; compilerproc;assembler;
  62. { input: i in r3 }
  63. { output: double(i) in f0 }
  64. {from "PowerPC Microprocessor Family: Programming Environments Manual for 64 and 32-Bit Microprocessors", v2.0, pg. 698 }
  65. var temp : int64;
  66. asm
  67. std r3,temp // store dword
  68. lfd f0,temp // load float
  69. fcfid f0,f0 // convert to fpu int
  70. end;
  71. {$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
  72. function fpc_qword_to_double(q: qword): double; compilerproc;assembler;
  73. const
  74. longint_to_real_helper: qword = $80000000;
  75. {from "PowerPC Microprocessor Family: Programming Environments Manual for
  76. 64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version* }
  77. { input: q in r3 }
  78. { output: double(q) in f0 }
  79. var
  80. temp1, temp2: qword;
  81. asm
  82. {$ifndef darwin}
  83. // load 2^32 into f4
  84. lis r4, longint_to_real_helper@highesta
  85. ori r4, r4, longint_to_real_helper@highera
  86. sldi r4, r4, 32
  87. oris r4, r4, longint_to_real_helper@ha
  88. lfd f4, longint_to_real_helper@l(r4)
  89. {$else not darwin}
  90. {$ifdef FPC_PIC}
  91. mflr r0
  92. bcl 20,31,.Lpiclab
  93. .Lpiclab:
  94. mflr r5
  95. mtlr r0
  96. addis r4,r5,(longint_to_real_helper-.Lpiclab)@ha
  97. lfd f2,(longint_to_real_helper-.Lpiclab)@l(r4)
  98. {$else FPC_PIC}
  99. lis r4, longint_to_real_helper@ha
  100. lfd f4, longint_to_real_helper@l(r4)
  101. {$endif FPC_PIC}
  102. {$endif not darwin}
  103. rldicl r4,r3,32,32 // isolate high half
  104. rldicl r0,r3,0,32 // isolate low half
  105. std r4,temp1 // store dword both
  106. std r0,temp2
  107. lfd f2,temp1 // load float both
  108. lfd f0,temp2 // load float both
  109. fcfid f2,f2 // convert each half to
  110. fcfid f0,f0 // fpu int (no rnd)
  111. fmadd f0,f4,f2,f0 // (2**32)*high+low (only add can rnd)
  112. end;