1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S --
9 -- Copyright (C) 1997-2008, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This package contains runtime routines for handling the non-IEEE
35 -- floating-point formats used on the Vax and the Alpha.
37 package System
.Vax_Float_Operations
is
39 pragma Warnings
(Off
);
40 -- Suppress warnings if not on Alpha/VAX
43 pragma Float_Representation
(VAX_Float
, D
);
44 -- D Float type on Vax
47 pragma Float_Representation
(VAX_Float
, G
);
48 -- G Float type on Vax
51 pragma Float_Representation
(VAX_Float
, F
);
52 -- F Float type on Vax
55 pragma Float_Representation
(IEEE_Float
, S
);
59 pragma Float_Representation
(IEEE_Float
, T
);
64 type Q
is range -2 ** 63 .. +(2 ** 63 - 1);
65 -- 64-bit signed integer
67 --------------------------
68 -- Conversion Functions --
69 --------------------------
71 function D_To_G
(X
: D
) return G
;
72 function G_To_D
(X
: G
) return D
;
73 -- Conversions between D float and G float
75 function G_To_F
(X
: G
) return F
;
76 function F_To_G
(X
: F
) return G
;
77 -- Conversions between F float and G float
79 function F_To_S
(X
: F
) return S
;
80 function S_To_F
(X
: S
) return F
;
81 -- Conversions between F float and IEEE short
83 function G_To_T
(X
: G
) return T
;
84 function T_To_G
(X
: T
) return G
;
85 -- Conversions between G float and IEEE long
87 function F_To_Q
(X
: F
) return Q
;
88 function Q_To_F
(X
: Q
) return F
;
89 -- Conversions between F float and 64-bit integer
91 function G_To_Q
(X
: G
) return Q
;
92 function Q_To_G
(X
: Q
) return G
;
93 -- Conversions between G float and 64-bit integer
95 function T_To_D
(X
: T
) return D
;
96 -- Conversion from IEEE long to D_Float (used for literals)
98 --------------------------
99 -- Arithmetic Functions --
100 --------------------------
102 function Abs_F
(X
: F
) return F
;
103 function Abs_G
(X
: G
) return G
;
104 -- Absolute value of F/G float
106 function Add_F
(X
, Y
: F
) return F
;
107 function Add_G
(X
, Y
: G
) return G
;
108 -- Addition of F/G float
110 function Div_F
(X
, Y
: F
) return F
;
111 function Div_G
(X
, Y
: G
) return G
;
112 -- Division of F/G float
114 function Mul_F
(X
, Y
: F
) return F
;
115 function Mul_G
(X
, Y
: G
) return G
;
116 -- Multiplication of F/G float
118 function Neg_F
(X
: F
) return F
;
119 function Neg_G
(X
: G
) return G
;
120 -- Negation of F/G float
122 function Sub_F
(X
, Y
: F
) return F
;
123 function Sub_G
(X
, Y
: G
) return G
;
124 -- Subtraction of F/G float
126 --------------------------
127 -- Comparison Functions --
128 --------------------------
130 function Eq_F
(X
, Y
: F
) return Boolean;
131 function Eq_G
(X
, Y
: G
) return Boolean;
132 -- Compares for X = Y
134 function Le_F
(X
, Y
: F
) return Boolean;
135 function Le_G
(X
, Y
: G
) return Boolean;
136 -- Compares for X <= Y
138 function Lt_F
(X
, Y
: F
) return Boolean;
139 function Lt_G
(X
, Y
: G
) return Boolean;
140 -- Compares for X < Y
142 function Ne_F
(X
, Y
: F
) return Boolean;
143 function Ne_G
(X
, Y
: G
) return Boolean;
144 -- Compares for X /= Y
146 ----------------------
147 -- Return Functions --
148 ----------------------
150 function Return_D
(X
: D
) return D
;
151 function Return_F
(X
: F
) return F
;
152 function Return_G
(X
: G
) return G
;
153 -- Deal with returned value for an imported function where the function
154 -- result is of VAX Float type. Usually nothing needs to be done, and these
155 -- functions return their argument unchanged. But for the case of VMS Alpha
156 -- the return value is already in $f0, so we need to trick the compiler
157 -- into thinking that we are moving X to $f0. See bodies for this case
158 -- for the Asm sequence generated to achieve this.
160 ----------------------------------
161 -- Routines for Valid Attribute --
162 ----------------------------------
164 function Valid_D
(Arg
: D
) return Boolean;
165 function Valid_F
(Arg
: F
) return Boolean;
166 function Valid_G
(Arg
: G
) return Boolean;
167 -- Test whether Arg has a valid representation
169 ----------------------
170 -- Debug Procedures --
171 ----------------------
173 procedure Debug_Output_D
(Arg
: D
);
174 procedure Debug_Output_F
(Arg
: F
);
175 procedure Debug_Output_G
(Arg
: G
);
176 pragma Export
(Ada
, Debug_Output_D
);
177 pragma Export
(Ada
, Debug_Output_F
);
178 pragma Export
(Ada
, Debug_Output_G
);
179 -- These routines output their argument in decimal string form, with
180 -- no terminating line return. They are provided for implicit use by
181 -- the pre gnat-3.12w GDB, and are retained for backwards compatibility.
183 function Debug_String_D
(Arg
: D
) return System
.Address
;
184 function Debug_String_F
(Arg
: F
) return System
.Address
;
185 function Debug_String_G
(Arg
: G
) return System
.Address
;
186 pragma Export
(Ada
, Debug_String_D
);
187 pragma Export
(Ada
, Debug_String_F
);
188 pragma Export
(Ada
, Debug_String_G
);
189 -- These routines return a decimal C string image of their argument.
190 -- They are provided for implicit use by the debugger, in response to
191 -- the special encoding used for Vax floating-point types (see Exp_Dbug
192 -- for details). They supersede the above Debug_Output_D/F/G routines
193 -- which didn't work properly with GDBTK.
195 procedure pd
(Arg
: D
);
196 procedure pf
(Arg
: F
);
197 procedure pg
(Arg
: G
);
198 pragma Export
(Ada
, pd
);
199 pragma Export
(Ada
, pf
);
200 pragma Export
(Ada
, pg
);
201 -- These are like the Debug_Output_D/F/G procedures except that they
202 -- output a line return after the output. They were originally present
203 -- for direct use in GDB before GDB recognized Vax floating-point
204 -- types, and are retained for backwards compatibility.
207 pragma Inline_Always
(D_To_G
);
208 pragma Inline_Always
(F_To_G
);
209 pragma Inline_Always
(F_To_Q
);
210 pragma Inline_Always
(F_To_S
);
211 pragma Inline_Always
(G_To_D
);
212 pragma Inline_Always
(G_To_F
);
213 pragma Inline_Always
(G_To_Q
);
214 pragma Inline_Always
(G_To_T
);
215 pragma Inline_Always
(Q_To_F
);
216 pragma Inline_Always
(Q_To_G
);
217 pragma Inline_Always
(S_To_F
);
218 pragma Inline_Always
(T_To_G
);
220 pragma Inline_Always
(Abs_F
);
221 pragma Inline_Always
(Abs_G
);
222 pragma Inline_Always
(Add_F
);
223 pragma Inline_Always
(Add_G
);
224 pragma Inline_Always
(Div_G
);
225 pragma Inline_Always
(Div_F
);
226 pragma Inline_Always
(Mul_F
);
227 pragma Inline_Always
(Mul_G
);
228 pragma Inline_Always
(Neg_G
);
229 pragma Inline_Always
(Neg_F
);
230 pragma Inline_Always
(Return_D
);
231 pragma Inline_Always
(Return_F
);
232 pragma Inline_Always
(Return_G
);
233 pragma Inline_Always
(Sub_F
);
234 pragma Inline_Always
(Sub_G
);
236 pragma Inline_Always
(Eq_F
);
237 pragma Inline_Always
(Eq_G
);
238 pragma Inline_Always
(Le_F
);
239 pragma Inline_Always
(Le_G
);
240 pragma Inline_Always
(Lt_F
);
241 pragma Inline_Always
(Lt_G
);
242 pragma Inline_Always
(Ne_F
);
243 pragma Inline_Always
(Ne_G
);
245 pragma Inline_Always
(Valid_D
);
246 pragma Inline_Always
(Valid_F
);
247 pragma Inline_Always
(Valid_G
);
249 end System
.Vax_Float_Operations
;