mathu.inc 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185
  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. {$define FPC_MATH_HAS_SINCOS}
  21. procedure sincos(theta : extended;out sinus,cosinus : extended);assembler;
  22. asm
  23. fldt theta
  24. fsincos
  25. fstpt (%edx)
  26. fstpt (%eax)
  27. fwait
  28. end;
  29. procedure sincos(theta : double;out sinus,cosinus : double);assembler;
  30. asm
  31. fldl theta
  32. fsincos
  33. fstpl (%edx)
  34. fstpl (%eax)
  35. fwait
  36. end;
  37. procedure sincos(theta : single;out sinus,cosinus : single);assembler;
  38. asm
  39. flds theta
  40. fsincos
  41. fstps (%edx)
  42. fstps (%eax)
  43. fwait
  44. end;
  45. {$define FPC_MATH_HAS_TAN}
  46. function tan(x : float) : float;assembler;
  47. asm
  48. fldt X
  49. fptan
  50. fstp %st
  51. fwait
  52. end;
  53. {$define FPC_MATH_HAS_COTAN}
  54. function cotan(x : float) : float;assembler;
  55. asm
  56. fldt X
  57. fptan
  58. fdivp %st,%st(1)
  59. fwait
  60. end;
  61. {$define FPC_MATH_HAS_DIVMOD}
  62. procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);assembler;
  63. asm
  64. pushl %edi
  65. movzwl %dx,%edi
  66. cltd
  67. idiv %edi
  68. movw %ax,(%ecx)
  69. movl Remainder,%ecx
  70. movw %dx,(%ecx)
  71. popl %edi
  72. end;
  73. procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: SmallInt);assembler;
  74. asm
  75. pushl %edi
  76. movzwl %dx,%edi
  77. cltd
  78. idiv %edi
  79. movw %ax,(%ecx)
  80. movl Remainder,%ecx
  81. movw %dx,(%ecx)
  82. popl %edi
  83. end;
  84. procedure DivMod(Dividend: DWord; Divisor: DWord; var Result, Remainder: DWord);assembler;
  85. asm
  86. pushl %edi
  87. movl %edx,%edi
  88. xorl %edx,%edx
  89. div %edi
  90. movl %eax,(%ecx)
  91. movl Remainder,%ecx
  92. movl %edx,(%ecx)
  93. popl %edi
  94. end;
  95. procedure DivMod(Dividend: Integer; Divisor: Integer; var Result, Remainder: Integer);assembler;
  96. asm
  97. pushl %edi
  98. movl %edx,%edi
  99. cltd
  100. idiv %edi
  101. movl %eax,(%ecx)
  102. movl Remainder,%ecx
  103. movl %edx,(%ecx)
  104. popl %edi
  105. end;
  106. function GetRoundMode: TFPURoundingMode;
  107. begin
  108. Result := TFPURoundingMode((Get8087CW shr 10) and 3);
  109. end;
  110. function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
  111. var
  112. CtlWord: Word;
  113. begin
  114. CtlWord := Get8087CW;
  115. Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
  116. if has_sse_support then
  117. SetSSECSR((GetSSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
  118. Result := TFPURoundingMode((CtlWord shr 10) and 3);
  119. end;
  120. function GetPrecisionMode: TFPUPrecisionMode;
  121. begin
  122. Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
  123. end;
  124. function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
  125. var
  126. CtlWord: Word;
  127. begin
  128. CtlWord := Get8087CW;
  129. Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
  130. Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
  131. end;
  132. function GetExceptionMask: TFPUExceptionMask;
  133. begin
  134. Result := TFPUExceptionMask(Longint(Get8087CW and $3F));
  135. end;
  136. function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
  137. var
  138. CtlWord: Word;
  139. begin
  140. CtlWord := Get8087CW;
  141. Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
  142. if has_sse_support then
  143. SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));
  144. softfloat_exception_mask:=dword(Mask);
  145. Result := TFPUExceptionMask(Longint(CtlWord and $3F));
  146. end;
  147. procedure ClearExceptions(RaisePending: Boolean);assembler;
  148. asm
  149. cmpb $0,RaisePending
  150. je .Lclear
  151. fwait
  152. .Lclear:
  153. fnclex
  154. end;