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
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2000 by Jonas Maebe and other members of the
Free Pascal development team
Implementation of mathematical Routines (only for real)
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.
**********************************************************************}
{****************************************************************************
EXTENDED data type routines
****************************************************************************}
{$define FPC_SYSTEM_HAS_PI}
function fpc_pi_real : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$define FPC_SYSTEM_HAS_ABS}
function fpc_abs_real(d : valreal) : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$define FPC_SYSTEM_HAS_SQR}
function fpc_sqr_real(d : valreal) : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$define FPC_SYSTEM_HAS_TRUNC}
function fpc_trunc_real(d : valreal) : int64;compilerproc; assembler; nostackframe;
{ input: d in fr1 }
{ output: result in r3 }
asm
fctidz f1, f1
stfd f1, -8(r1)
ld r3, -8(r1)
end;
{$ifndef FPC_SYSTEM_HAS_ROUND}
{$define FPC_SYSTEM_HAS_ROUND}
function fpc_round_real(d : valreal) : int64; compilerproc;assembler; nostackframe;
{ exactly the same as trunc, except that one fctiwz has become fctiw }
{ input: d in fr1 }
{ output: result in r3 }
asm
fctid f1, f1
stfd f1, -8(r1)
ld r3, -8(r1)
end;
{$endif not FPC_SYSTEM_HAS_ROUND}
{****************************************************************************
Int to real helpers
****************************************************************************}
{$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
function fpc_int64_to_double(i: int64): double; compilerproc;assembler;
{ input: i in r3 }
{ output: double(i) in f0 }
{from "PowerPC Microprocessor Family: Programming Environments Manual for 64 and 32-Bit Microprocessors", v2.0, pg. 698 }
var temp : int64;
asm
std r3,temp // store dword
lfd f0,temp // load float
fcfid f0,f0 // convert to fpu int
end;
{$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
function fpc_qword_to_double(q: qword): double; compilerproc;assembler;
const
longint_to_real_helper: qword = $80000000;
{from "PowerPC Microprocessor Family: Programming Environments Manual for
64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version* }
{ input: q in r3 }
{ output: double(q) in f0 }
var
temp1, temp2: qword;
asm
{$ifndef darwin}
// load 2^32 into f4
lis r4, longint_to_real_helper@highesta
ori r4, r4, longint_to_real_helper@highera
sldi r4, r4, 32
oris r4, r4, longint_to_real_helper@ha
lfd f4, longint_to_real_helper@l(r4)
{$else not darwin}
{$ifdef FPC_PIC}
mflr r0
bcl 20,31,.Lpiclab
.Lpiclab:
mflr r5
mtlr r0
addis r4,r5,(longint_to_real_helper-.Lpiclab)@ha
lfd f2,(longint_to_real_helper-.Lpiclab)@l(r4)
{$else FPC_PIC}
lis r4, longint_to_real_helper@ha
lfd f4, longint_to_real_helper@l(r4)
{$endif FPC_PIC}
{$endif not darwin}
rldicl r4,r3,32,32 // isolate high half
rldicl r0,r3,0,32 // isolate low half
std r4,temp1 // store dword both
std r0,temp2
lfd f2,temp1 // load float both
lfd f0,temp2 // load float both
fcfid f2,f2 // convert each half to
fcfid f0,f0 // fpu int (no rnd)
fmadd f0,f4,f2,f0 // (2**32)*high+low (only add can rnd)
end;
|
