cgenmath.inc 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2001 by Several contributors
  4. Generic mathemtical routines in libc
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. { for 80x86, we can easily write the optimal inline code }
  12. { Furthermore, the routines below only go up to double }
  13. { precision and we need extended precision if supported }
  14. {$ifndef FPC_HAS_TYPE_EXTENDED}
  15. {$ifndef SOLARIS}
  16. {$ifndef FPC_SYSTEM_HAS_INT}
  17. {$define FPC_SYSTEM_HAS_INT}
  18. {$ifdef SUPPORT_DOUBLE}
  19. function c_trunc(d: double): double; cdecl; external 'c' name 'trunc';
  20. function fpc_int_real(d: ValReal): ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  21. begin
  22. result := c_trunc(d);
  23. end;
  24. {$else SUPPORT_DOUBLE}
  25. function c_truncf(d: double): double; cdecl; external 'c' name 'truncf';
  26. function fpc_int_real(d: ValReal): ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  27. begin
  28. { this will be correct since real = single in the case of }
  29. { the motorola version of the compiler... }
  30. int:=c_truncf(d);
  31. end;
  32. {$endif SUPPORT_DOUBLE}
  33. {$endif FPC_SYSTEM_HAS_INT}
  34. {$endif SOLARIS}
  35. {$ifndef SYSTEM_HAS_FREXP}
  36. {$define SYSTEM_HAS_FREXP}
  37. function c_frexp(x: double; out e: longint): double; cdecl; external 'c' name 'frexp';
  38. function frexp(x:ValReal; out e:Integer ):ValReal; {$ifdef MATHINLINE}inline;{$endif}
  39. var
  40. l: longint;
  41. begin
  42. frexp := c_frexp(x,l);
  43. e := l;
  44. end;
  45. {$endif not SYSTEM_HAS_FREXP}
  46. {$ifndef SYSTEM_HAS_LDEXP}
  47. {$define SYSTEM_HAS_LDEXP}
  48. function c_ldexp(x: double; n: longint): double; cdecl; external 'c' name 'ldexp';
  49. function ldexp( x: ValReal; N: Integer):ValReal;{$ifdef MATHINLINE}inline;{$endif}
  50. begin
  51. ldexp := c_ldexp(x,n);
  52. end;
  53. {$endif not SYSTEM_HAS_LDEXP}
  54. {$ifndef FPC_SYSTEM_HAS_SQRT}
  55. {$define FPC_SYSTEM_HAS_SQRT}
  56. function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt';
  57. function fpc_sqrt_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  58. begin
  59. result := c_sqrt(d);
  60. end;
  61. {$endif}
  62. {$ifndef FPC_SYSTEM_HAS_EXP}
  63. {$define FPC_SYSTEM_HAS_EXP}
  64. function c_exp(d: double): double; cdecl; external 'c' name 'exp';
  65. function fpc_Exp_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  66. begin
  67. result := c_exp(d);
  68. end;
  69. {$endif}
  70. {$ifndef FPC_SYSTEM_HAS_LN}
  71. {$define FPC_SYSTEM_HAS_LN}
  72. function c_log(d: double): double; cdecl; external 'c' name 'log';
  73. function fpc_Ln_real(d:ValReal):ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
  74. begin
  75. result := c_log(d);
  76. end;
  77. {$endif}
  78. {$ifndef FPC_SYSTEM_HAS_SIN}
  79. {$define FPC_SYSTEM_HAS_SIN}
  80. function c_sin(d: double): double; cdecl; external 'c' name 'sin';
  81. function fpc_Sin_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  82. begin
  83. result := c_sin(d);
  84. end;
  85. {$endif}
  86. {$ifndef FPC_SYSTEM_HAS_COS}
  87. {$define FPC_SYSTEM_HAS_COS}
  88. function c_cos(d: double): double; cdecl; external 'c' name 'cos';
  89. function fpc_Cos_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  90. begin
  91. result := c_cos(d);
  92. end;
  93. {$endif}
  94. {$ifndef FPC_SYSTEM_HAS_ARCTAN}
  95. {$define FPC_SYSTEM_HAS_ARCTAN}
  96. function c_atan(d: double): double; cdecl; external 'c' name 'atan';
  97. function fpc_ArcTan_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
  98. begin
  99. result := c_atan(d);
  100. end;
  101. {$endif}
  102. {$endif not FPC_HAS_TYPE_EXTENDED}