2
0

math.inc 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  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. { we wouls have to generate the .localfunc directive for ELFv2, and moreover it
  65. must appear at the start right after setting up the TOC pointer, but the local
  66. variables will cause the code generator to already insert the stack allocation
  67. before that... -> disable this routine for ELFv2 }
  68. {$if not defined(aix) and (not defined(linux) or (defined(_ELF_CALL) and (_ELF_CALL = 1))) }
  69. {$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
  70. function fpc_qword_to_double(q: qword): double; compilerproc;assembler;
  71. const
  72. longint_to_real_helper: qword = $80000000;
  73. {from "PowerPC Microprocessor Family: Programming Environments Manual for
  74. 64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version* }
  75. { input: q in r3 }
  76. { output: double(q) in f0 }
  77. var
  78. temp1, temp2: qword;
  79. asm
  80. {$ifndef darwin}
  81. // load 2^32 into f4
  82. lis r4, longint_to_real_helper@highesta
  83. ori r4, r4, longint_to_real_helper@highera
  84. sldi r4, r4, 32
  85. oris r4, r4, longint_to_real_helper@ha
  86. lfd f4, longint_to_real_helper@l(r4)
  87. {$else not darwin}
  88. {$ifdef FPC_PIC}
  89. mflr r0
  90. bcl 20,31,.Lpiclab
  91. .Lpiclab:
  92. mflr r5
  93. mtlr r0
  94. addis r4,r5,(longint_to_real_helper-.Lpiclab)@ha
  95. lfd f2,(longint_to_real_helper-.Lpiclab)@l(r4)
  96. {$else FPC_PIC}
  97. lis r4, longint_to_real_helper@ha
  98. lfd f4, longint_to_real_helper@l(r4)
  99. {$endif FPC_PIC}
  100. {$endif not darwin}
  101. rldicl r4,r3,32,32 // isolate high half
  102. rldicl r0,r3,0,32 // isolate low half
  103. std r4,temp1 // store dword both
  104. std r0,temp2
  105. lfd f2,temp1 // load float both
  106. lfd f0,temp2 // load float both
  107. fcfid f2,f2 // convert each half to
  108. fcfid f0,f0 // fpu int (no rnd)
  109. fmadd f0,f4,f2,f0 // (2**32)*high+low (only add can rnd)
  110. end;
  111. {$endif ndef aix}