summaryrefslogtreecommitdiff
path: root/rtl/inc/genmath.inc
diff options
context:
space:
mode:
Diffstat (limited to 'rtl/inc/genmath.inc')
-rw-r--r--rtl/inc/genmath.inc321
1 files changed, 311 insertions, 10 deletions
diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc
index 6eac64fd77..88c86bf195 100644
--- a/rtl/inc/genmath.inc
+++ b/rtl/inc/genmath.inc
@@ -90,7 +90,9 @@ const
lossth = 1.073741824e9;
MAXLOG = 8.8029691931113054295988E1; { log(2**127) }
MINLOG = -8.872283911167299960540E1; { log(2**-128) }
-
+ H2_54: double = 18014398509481984.0; {2^54}
+ huge: double = 1e300;
+ one: double = 1.0;
zero: double = 0;
{$if not defined(FPC_SYSTEM_HAS_SIN) or not defined(FPC_SYSTEM_HAS_COS)}
@@ -397,9 +399,6 @@ type
{* ldexp() multiplies x by 2**n. *}
var
i: integer;
- const
- H2_54: double = 18014398509481984.0; {2^54}
- huge: double = 1e300;
begin
i := (float64high(x) and $7ff00000) shr 20;
{if +-INF, NaN, 0 or if e=0 return d}
@@ -1128,9 +1127,7 @@ type
}
function fpc_exp_real(d: ValReal):ValReal;compilerproc;
const
- one: double = 1.0;
halF : array[0..1] of double = (0.5,-0.5);
- huge: double = 1.0e+300;
twom1000: double = 9.33263618503218878990e-302; { 2**-1000=0x01700000,0}
o_threshold: double = 7.09782712893383973096e+02; { 0x40862E42, 0xFEFA39EF }
u_threshold: double = -7.45133219101941108420e+02; { 0xc0874910, 0xD52D3051 }
@@ -1466,7 +1463,7 @@ type
k := 0;
if (hx < $00100000) then { x < 2**-1022 }
begin
- if (((hx and $7fffffff) or lx)=0) then
+ if (((hx and $7fffffff) or longint(lx))=0) then
exit(-two54/zero); { log(+-0)=-inf }
if (hx<0) then
exit((d-d)/zero); { log(-#) = NaN }
@@ -1702,9 +1699,6 @@ type
1.62858201153657823623e-02 { 0x3F90AD3A, 0xE322DA11 }
);
- one: double = 1.0;
- huge: double = 1.0e300;
-
var
w,s1,s2,z: double;
ix,hx,id: longint;
@@ -1927,3 +1921,310 @@ function FPower10(val: Extended; Power: Longint): Extended;
end;
end;
{$endif SUPPORT_EXTENDED}
+
+{$ifdef SUPPORT_EXTENDED}
+function TExtended80Rec.Mantissa : QWord;
+ begin
+ Result:=Frac and $7fffffffffffffff;
+ end;
+
+
+function TExtended80Rec.Fraction : Extended;
+ begin
+ Result:=system.frac(Value);
+ end;
+
+
+function TExtended80Rec.Exponent : Longint;
+ begin
+ Result:=Exp-16383;
+ end;
+
+
+function TExtended80Rec.GetExp : QWord;
+ begin
+ Result:=_Exp and $7fff;
+ end;
+
+
+procedure TExtended80Rec.SetExp(e : QWord);
+ begin
+ _Exp:=(_Exp and $8000) or (e and $7fff);
+ end;
+
+
+function TExtended80Rec.GetSign : Boolean;
+ begin
+ Result:=(_Exp and $8000)<>0;
+ end;
+
+
+procedure TExtended80Rec.SetSign(s : Boolean);
+ begin
+ _Exp:=(_Exp and $7ffff) or (ord(s) shl 15);
+ end;
+
+{
+ Based on information taken from http://en.wikipedia.org/wiki/Extended_precision#x86_Extended_Precision_Format
+}
+function TExtended80Rec.SpecialType : TFloatSpecial;
+ const
+ Denormal : array[boolean] of TFloatSpecial = (fsDenormal,fsNDenormal);
+ begin
+ case Exp of
+ 0:
+ begin
+ if Mantissa=0 then
+ begin
+ if Sign then
+ Result:=fsNZero
+ else
+ Result:=fsZero
+ end
+ else
+ Result:=Denormal[Sign];
+ end;
+ $7fff:
+ case (Frac shr 62) and 3 of
+ 0,1:
+ Result:=fsInvalidOp;
+ 2:
+ begin
+ if (Frac and $3fffffffffffffff)=0 then
+ begin
+ if Sign then
+ Result:=fsNInf
+ else
+ Result:=fsInf;
+ end
+ else
+ Result:=fsNaN;
+ end;
+ 3:
+ Result:=fsNaN;
+ end
+ else
+ begin
+ if (Frac and $8000000000000000)=0 then
+ Result:=fsInvalidOp
+ else
+ begin
+ if Sign then
+ Result:=fsNegative
+ else
+ Result:=fsPositive;
+ end;
+ end;
+ end;
+ end;
+
+{
+procedure TExtended80Rec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint);
+ begin
+ end;
+}
+{$endif SUPPORT_EXTENDED}
+
+
+{$ifdef SUPPORT_DOUBLE}
+function TDoubleRec.Mantissa : QWord;
+ begin
+ Result:=Data and $fffffffffffff;
+ end;
+
+
+function TDoubleRec.Fraction : ValReal;
+ begin
+ Result:=system.frac(Value);
+ end;
+
+
+function TDoubleRec.Exponent : Longint;
+ begin
+ Result:=Exp-1023;
+ end;
+
+
+function TDoubleRec.GetExp : QWord;
+ begin
+ Result:=(Data and $7ff0000000000000) shr 52;
+ end;
+
+
+procedure TDoubleRec.SetExp(e : QWord);
+ begin
+ Data:=(Data and $800fffffffffffff) or ((e and $7ff) shl 52);
+ end;
+
+
+function TDoubleRec.GetSign : Boolean;
+ begin
+ Result:=(Data and $8000000000000000)<>0;
+ end;
+
+
+procedure TDoubleRec.SetSign(s : Boolean);
+ begin
+ Data:=(Data and $7fffffffffffffff) or (QWord(ord(s)) shl 63);
+ end;
+
+
+function TDoubleRec.GetFrac : QWord;
+ begin
+ Result:=$10000000000000 or Mantissa;
+ end;
+
+
+procedure TDoubleRec.SetFrac(e : QWord);
+ begin
+ Data:=(Data and $7ff0000000000000) or (e and $fffffffffffff);
+ end;
+
+{
+ Based on information taken from http://en.wikipedia.org/wiki/Double_precision#x86_Extended_Precision_Format
+}
+function TDoubleRec.SpecialType : TFloatSpecial;
+ const
+ Denormal : array[boolean] of TFloatSpecial = (fsDenormal,fsNDenormal);
+ begin
+ case Exp of
+ 0:
+ begin
+ if Mantissa=0 then
+ begin
+ if Sign then
+ Result:=fsNZero
+ else
+ Result:=fsZero
+ end
+ else
+ Result:=Denormal[Sign];
+ end;
+ $7ff:
+ if Mantissa=0 then
+ begin
+ if Sign then
+ Result:=fsNInf
+ else
+ Result:=fsInf;
+ end
+ else
+ Result:=fsNaN;
+ else
+ begin
+ if Sign then
+ Result:=fsNegative
+ else
+ Result:=fsPositive;
+ end;
+ end;
+ end;
+
+{
+procedure TDoubleRec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint);
+ begin
+ end;
+}
+{$endif SUPPORT_DOUBLE}
+
+
+{$ifdef SUPPORT_SINGLE}
+function TSingleRec.Mantissa : QWord;
+ begin
+ Result:=Data and $7fffff;
+ end;
+
+
+function TSingleRec.Fraction : ValReal;
+ begin
+ Result:=system.frac(Value);
+ end;
+
+
+function TSingleRec.Exponent : Longint;
+ begin
+ Result:=Exp-127;
+ end;
+
+
+function TSingleRec.GetExp : QWord;
+ begin
+ Result:=(Data and $7f800000) shr 23;
+ end;
+
+
+procedure TSingleRec.SetExp(e : QWord);
+ begin
+ Data:=(Data and $807fffff) or ((e and $ff) shl 23);
+ end;
+
+
+function TSingleRec.GetSign : Boolean;
+ begin
+ Result:=(Data and $80000000)<>0;
+ end;
+
+
+procedure TSingleRec.SetSign(s : Boolean);
+ begin
+ Data:=(Data and $7fffffff) or (DWord(ord(s)) shl 31);
+ end;
+
+
+function TSingleRec.GetFrac : QWord;
+ begin
+ Result:=$8000000 or Mantissa;
+ end;
+
+
+procedure TSingleRec.SetFrac(e : QWord);
+ begin
+ Data:=(Data and $ff800000) or (e and $7fffff);
+ end;
+
+{
+ Based on information taken from http://en.wikipedia.org/wiki/Single_precision#x86_Extended_Precision_Format
+}
+function TSingleRec.SpecialType : TFloatSpecial;
+ const
+ Denormal : array[boolean] of TFloatSpecial = (fsDenormal,fsNDenormal);
+ begin
+ case Exp of
+ 0:
+ begin
+ if Mantissa=0 then
+ begin
+ if Sign then
+ Result:=fsNZero
+ else
+ Result:=fsZero
+ end
+ else
+ Result:=Denormal[Sign];
+ end;
+ $ff:
+ if Mantissa=0 then
+ begin
+ if Sign then
+ Result:=fsNInf
+ else
+ Result:=fsInf;
+ end
+ else
+ Result:=fsNaN;
+ else
+ begin
+ if Sign then
+ Result:=fsNegative
+ else
+ Result:=fsPositive;
+ end;
+ end;
+ end;
+
+{
+procedure TSingleRec.BuildUp(const _Sign : Boolean; const _Mantissa : QWord; const Exponent : Longint);
+ begin
+ end;
+}
+{$endif SUPPORT_SINGLE}
View Lorry Controller Status