cgenmath.inc 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2001 by Several contributors
  5. Generic mathemtical routines in libc
  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. { for 80x86, we can easily write the optimal inline code }
  13. {$ifndef cpui386}
  14. {$ifndef FPC_SYSTEM_HAS_INT}
  15. {$define FPC_SYSTEM_HAS_INT}
  16. {$ifdef SUPPORT_DOUBLE}
  17. function c_trunc(d: double): double; cdecl; external 'c' name 'trunc';
  18. {$ifdef INTERNCONSTINTF}
  19. function fpc_int_real(d: double): double;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  20. {$else}
  21. function int(d: double): double; {$ifdef MATHINLINE}inline;{$endif}[internconst:fpc_in_const_int];
  22. {$endif}
  23. begin
  24. result := c_trunc(d);
  25. end;
  26. {$else SUPPORT_DOUBLE}
  27. function c_truncf(d: real): double; cdecl; external 'c' name 'truncf';
  28. {$ifdef INTERNCONSTINTF}
  29. function fpc_int_real(d: real): real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  30. {$else}
  31. function int(d: real) : real;[internconst:fpc_in_const_int];
  32. {$endif}
  33. begin
  34. { this will be correct since real = single in the case of }
  35. { the motorola version of the compiler... }
  36. int:=c_truncf(d);
  37. end;
  38. {$endif SUPPORT_DOUBLE}
  39. {$endif}
  40. {$ifndef SYSTEM_HAS_FREXP}
  41. {$define SYSTEM_HAS_FREXP}
  42. function c_frexp(x: double; var e: longint): double; cdecl; external 'c' name 'frexp';
  43. function frexp(x:Real; var e:Integer ):Real; {$ifdef MATHINLINE}inline;{$endif}
  44. var
  45. l: longint;
  46. begin
  47. frexp := c_frexp(x,l);
  48. e := l;
  49. end;
  50. {$endif not SYSTEM_HAS_FREXP}
  51. {$ifndef SYSTEM_HAS_LDEXP}
  52. {$define SYSTEM_HAS_LDEXP}
  53. function c_ldexp(x: double; n: longint): double; cdecl; external 'c' name 'ldexp';
  54. function ldexp( x: Real; N: Integer):Real;{$ifdef MATHINLINE}inline;{$endif}
  55. begin
  56. ldexp := c_ldexp(x,n);
  57. end;
  58. {$endif not SYSTEM_HAS_LDEXP}
  59. {$ifndef FPC_SYSTEM_HAS_SQRT}
  60. {$define FPC_SYSTEM_HAS_SQRT}
  61. function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt';
  62. {$ifdef INTERNCONSTINTF}
  63. function fpc_sqrt_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  64. {$else}
  65. function sqrt(d:Real):Real;[internproc:fpc_in_const_sqrt];[public, alias: 'FPC_SQRT_REAL']; {$ifdef MATHINLINE}inline;{$endif}
  66. {$ifdef hascompilerproc}
  67. function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
  68. {$endif hascompilerproc}
  69. {$endif}
  70. begin
  71. result := c_sqrt(d);
  72. end;
  73. {$endif}
  74. {$ifndef FPC_SYSTEM_HAS_EXP}
  75. {$define FPC_SYSTEM_HAS_EXP}
  76. function c_exp(d: double): double; cdecl; external 'c' name 'exp';
  77. {$ifdef INTERNCONSTINTF}
  78. function fpc_Exp_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  79. {$else}
  80. function Exp(d:Real):Real;[internconst:fpc_in_const_exp]; {$ifdef MATHINLINE}inline;{$endif}
  81. {$endif}
  82. begin
  83. result := c_exp(d);
  84. end;
  85. {$endif}
  86. (*
  87. Not supported on Mac OS X 10.1
  88. {$ifndef FPC_SYSTEM_HAS_ROUND}
  89. {$define FPC_SYSTEM_HAS_ROUND}
  90. function c_llround(d: double): int64; cdecl; external 'c' name 'llround';
  91. {$ifdef hascompilerproc}
  92. function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif} external name 'FPC_ROUND';
  93. function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
  94. begin
  95. fpc_round := c_llround(d);
  96. end;
  97. {$else}
  98. function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
  99. begin
  100. round := c_llround(d);
  101. end;
  102. {$endif hascompilerproc}
  103. {$endif}
  104. *)
  105. {$ifndef FPC_SYSTEM_HAS_LN}
  106. {$define FPC_SYSTEM_HAS_LN}
  107. function c_log(d: double): double; cdecl; external 'c' name 'log';
  108. {$ifdef INTERNCONSTINTF}
  109. function fpc_Ln_real(d:Real):Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  110. {$else}
  111. function Ln(d:Real):Real;[internconst:fpc_in_const_ln];{$ifdef MATHINLINE}inline;{$endif}
  112. {$endif}
  113. begin
  114. result := c_log(d);
  115. end;
  116. {$endif}
  117. {$ifndef FPC_SYSTEM_HAS_SIN}
  118. {$define FPC_SYSTEM_HAS_SIN}
  119. function c_sin(d: double): double; cdecl; external 'c' name 'sin';
  120. {$ifdef INTERNCONSTINTF}
  121. function fpc_Sin_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  122. {$else}
  123. function Sin(d:Real):Real;[internconst:fpc_in_const_sin]; {$ifdef MATHINLINE}inline;{$endif}
  124. {$endif}
  125. begin
  126. result := c_sin(d);
  127. end;
  128. {$endif}
  129. {$ifndef FPC_SYSTEM_HAS_COS}
  130. {$define FPC_SYSTEM_HAS_COS}
  131. function c_cos(d: double): double; cdecl; external 'c' name 'cos';
  132. {$ifdef INTERNCONSTINTF}
  133. function fpc_Cos_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  134. {$else}
  135. function Cos(d:Real):Real;[internconst:fpc_in_const_cos];{$ifdef MATHINLINE}inline;{$endif}
  136. {$endif}
  137. begin
  138. result := c_cos(d);
  139. end;
  140. {$endif}
  141. {$ifndef FPC_SYSTEM_HAS_ARCTAN}
  142. {$define FPC_SYSTEM_HAS_ARCTAN}
  143. function c_atan(d: double): double; cdecl; external 'c' name 'atan';
  144. {$ifdef INTERNCONSTINTF}
  145. function fpc_ArcTan_real(d:Real):Real;compiler; {$ifdef MATHINLINE}inline;{$endif}
  146. {$else}
  147. function ArcTan(d:Real):Real;[internconst:fpc_in_const_arctan];{$ifdef MATHINLINE}inline;{$endif}
  148. {$endif}
  149. begin
  150. result := c_atan(d);
  151. end;
  152. {$endif}
  153. {$endif not i386}
  154. {
  155. $Log$
  156. Revision 1.4 2004-11-21 15:35:23 peter
  157. * float routines all use internproc and compilerproc helpers
  158. Revision 1.3 2004/11/20 15:49:21 jonas
  159. * some compilation fixes for powerpc after all the internconst and
  160. internproc changes, still crashes with internalerror(88) for ppc1
  161. on real2str.inc(193,39)
  162. Revision 1.2 2004/10/12 07:08:33 jonas
  163. - disabled llround, not present under Mac OS X 10.1
  164. Revision 1.1 2004/10/09 21:00:46 jonas
  165. + cgenmath with libc math functions. Faster than the routines in genmath
  166. and also have full double support (exp() only has support for values in
  167. the single range in genmath, for example). Used in FPC_USE_LIBC is
  168. defined
  169. * several fixes to allow compilation with -dHASINLINE, but internalerrors
  170. because of missing support for inlining assembler code
  171. }