blob: 9c32f5b7c7bb1b84fc165d134611252207860830 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Jonas Maebe,
members of the Free Pascal development team.
This file implements Java math routines
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$define FPC_SYSTEM_HAS_ARCTAN}
function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
result:=JLMath.atan(d);
end;
{$define FPC_SYSTEM_HAS_COS}
function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
result:=JLMath.cos(d);
end;
{$define FPC_SYSTEM_HAS_EXP}
function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
result:=JLMath.exp(d);
end;
{$define FPC_SYSTEM_HAS_INT}
function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
if d>=0 then
result:=JLMath.floor(d)
else
result:=JLMath.ceil(d);
end;
{$define FPC_SYSTEM_HAS_LN}
function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
result:=JLMath.log(d);
end;
{$define FPC_SYSTEM_HAS_SIN}
function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
result:=JLMath.sin(d);
end;
{$define FPC_SYSTEM_HAS_SQR}
{ handled in the code generator }
function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin
HandleError(219);
{ avoid warning }
result:=0;
end;
{$define FPC_SYSTEM_HAS_SQRT}
function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
begin
result:=JLMath.sqrt(d);
end;
{$define FPC_SYSTEM_HAS_TRUNC}
{ handled in the code generator }
function fpc_trunc_real(d : ValReal) : int64;compilerproc;
begin
HandleError(219);
{ avoid warning }
result:=0;
end;
{$define FPC_SYSTEM_HAS_REAL2DOUBLE}
function real2double(r : real48) : double;
var
res : jlong;
exponent : word;
begin
{ check for zero }
if r[0]=0 then
begin
real2double:=0.0;
exit;
end;
{ copy mantissa }
res:=(r[1] shl 5) shl 8;
res:=res or (((r[1] shr 3) or (r[2] shl 5)) shl 16);
res:=res or (((r[2] shr 3) or (r[3] shl 5)) shl 24);
res:=res or (((r[3] shr 3) or (r[4] shl 5)) shl 32);
res:=res or (((r[4] shr 3) or (r[5] and $7f) shl 5) shl 40);
res:=res or (((r[5] and $7f) shr 3) shl 48);
{ copy exponent }
{ correct exponent: }
exponent:=(word(r[0])+(1023-129));
res:=res or (((exponent and $f) shl 4) shl 48);
res:=res or ((exponent shr 4) shl 56);
{ set sign }
res:=res or (r[5] and $80) shl 56;
real2double:=JLDouble.longBitsToDouble(res);
end;
{$define FPC_HAS_FLOAT64HIGH}
function float64high(d: double): longint;
begin
result:=JLDouble.doubleToRawLongBits(d) shr 32;
end;
procedure float64sethigh(var d: double; l: longint);
begin
d:=JLDouble.longBitsToDouble((JLDouble.doubleToRawLongBits(d) and $ffffffff) or (jlong(l) shl 32));
end;
{$define FPC_HAS_FLOAT64LOW}
function float64low(d: double): longint;
begin
result:=longint(JLDouble.doubleToRawLongBits(d));
end;
procedure float64setlow(var d: double; l: longint);
begin
d:=JLDouble.longBitsToDouble((JLDouble.doubleToRawLongBits(d) and $ffffffff00000000) or cardinal(l));
end;
|
