GR32_Math_FPC.pas 3.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. unit GR32_Math_FPC;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is Additional Math Routines for Graphics32
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Mattias Andersson <[email protected]>
  26. * (parts of this unit were moved here from GR32_System.pas and GR32.pas by Alex A. Denisov)
  27. *
  28. * Portions created by the Initial Developer are Copyright (C) 2005-2009
  29. * the Initial Developer. All Rights Reserved.
  30. *
  31. * Contributor(s):
  32. * Michael Hansen <[email protected]>
  33. *
  34. * ***** END LICENSE BLOCK ***** *)
  35. interface
  36. {$include GR32.inc}
  37. // TODO : This block was never enabled as TARGET_X64 isn't defined unless GR32.inc is included
  38. // The block has now been disabled as we can't {$mode objfpc} this late.
  39. {$if False and defined(FPC) and defined(TARGET_X64)}
  40. {$mode objfpc}
  41. (*
  42. FPC has no similar {$EXCESSPRECISION OFF} directive,
  43. but we can easily emulate that by overriding some internal math functions
  44. *)
  45. function PI: Single; [internproc: fpc_in_pi_real];
  46. //function Abs(D: Single): Single; [internproc: fpc_in_abs_real];
  47. //function Sqr(D: Single): Single; [internproc: fpc_in_sqr_real];
  48. function Sqrt(D: Single): Single; [internproc: fpc_in_sqrt_real];
  49. function ArcTan(D: Single): Single; [internproc: fpc_in_arctan_real];
  50. function Ln(D: Single): Single; [internproc: fpc_in_ln_real];
  51. function Sin(D: Single): Single; [internproc: fpc_in_sin_real];
  52. function Cos(D: Single): Single; [internproc: fpc_in_cos_real];
  53. function Exp(D: Single): Single; [internproc: fpc_in_exp_real];
  54. function Round(D: Single): Int64; [internproc: fpc_in_round_real];
  55. function Frac(D: Single): Single; [internproc: fpc_in_frac_real];
  56. function Int(D: Single): Single; [internproc: fpc_in_int_real];
  57. function Trunc(D: Single): Int64; [internproc: fpc_in_trunc_real];
  58. {$ifend}
  59. //------------------------------------------------------------------------------
  60. {$if defined(FPC) and defined(TARGET_X64)}
  61. function Ceil(X: Single): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
  62. function Floor(X: Single): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
  63. {$ifend}
  64. //------------------------------------------------------------------------------
  65. //------------------------------------------------------------------------------
  66. //------------------------------------------------------------------------------
  67. implementation
  68. //------------------------------------------------------------------------------
  69. {$if defined(FPC) and defined(TARGET_X64)}
  70. function Ceil(X: Single): Integer;
  71. begin
  72. Result := Trunc(X);
  73. if (X - Result) > 0 then
  74. Inc(Result);
  75. end;
  76. function Floor(X: Single): Integer;
  77. begin
  78. Result := Trunc(X);
  79. if (X - Result) < 0 then
  80. Dec(Result);
  81. end;
  82. {$ifend}
  83. //------------------------------------------------------------------------------
  84. end.