mathu.inc 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2003 by Florian Klaempfl
  4. member of the Free Pascal development team
  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. {$ASMMODE ATT}
  12. {$define FPC_MATH_HAS_ARCTAN2}
  13. function arctan2(y,x : float) : float;assembler;
  14. asm
  15. fldt y
  16. fldt x
  17. fpatan
  18. fwait
  19. end;
  20. procedure SetSSECSR(w : dword);
  21. var
  22. _w : dword;
  23. begin
  24. _w:=w;
  25. asm
  26. ldmxcsr _w
  27. end;
  28. end;
  29. function GetSSECSR : dword;
  30. var
  31. _w : dword;
  32. begin
  33. asm
  34. stmxcsr _w
  35. end;
  36. result:=_w;
  37. end;
  38. function GetRoundMode: TFPURoundingMode;
  39. begin
  40. Result := TFPURoundingMode((Get8087CW shr 10) and 3);
  41. end;
  42. function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
  43. var
  44. CtlWord: Word;
  45. begin
  46. CtlWord := Get8087CW;
  47. Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
  48. Result := TFPURoundingMode((CtlWord shr 10) and 3);
  49. end;
  50. function GetPrecisionMode: TFPUPrecisionMode;
  51. begin
  52. Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
  53. end;
  54. function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
  55. var
  56. CtlWord: Word;
  57. begin
  58. CtlWord := Get8087CW;
  59. Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
  60. Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
  61. end;
  62. function GetExceptionMask: TFPUExceptionMask;
  63. begin
  64. Result := TFPUExceptionMask(Longint(Get8087CW and $3F));
  65. end;
  66. function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
  67. var
  68. CtlWord: Word;
  69. begin
  70. CtlWord := Get8087CW;
  71. Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
  72. Result := TFPUExceptionMask(Longint(CtlWord and $3F));
  73. end;
  74. procedure ClearExceptions(RaisePending: Boolean);assembler;
  75. asm
  76. cmpb $0,RaisePending
  77. je .Lclear
  78. fwait
  79. .Lclear:
  80. fnclex
  81. end;