1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME 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-2009, 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 3, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is a dummy body for use on non-Alpha systems so that the library
33 -- can compile. This dummy version uses ordinary conversions and other
34 -- arithmetic operations. It is used only for testing purposes in the
35 -- case where the -gnatdm switch is used to force testing of VMS features
36 -- on non-VMS systems.
40 package body System.Vax_Float_Operations is
41 pragma Warnings (Off);
42 -- Warnings about infinite recursion when the -gnatdm switch is used
48 function Abs_F (X : F) return F is
57 function Abs_G (X : G) return G is
66 function Add_F (X, Y : F) return F is
75 function Add_G (X, Y : G) return G is
84 function D_To_G (X : D) return G is
93 procedure Debug_Output_D (Arg : D) is
95 System.IO.Put (D'Image (Arg));
102 procedure Debug_Output_F (Arg : F) is
104 System.IO.Put (F'Image (Arg));
111 procedure Debug_Output_G (Arg : G) is
113 System.IO.Put (G'Image (Arg));
120 Debug_String_Buffer : String (1 .. 32);
121 -- Buffer used by all Debug_String_x routines for returning result
123 function Debug_String_D (Arg : D) return System.Address is
124 Image_String : constant String := D'Image (Arg) & ASCII.NUL;
125 Image_Size : constant Integer := Image_String'Length;
128 Debug_String_Buffer (1 .. Image_Size) := Image_String;
129 return Debug_String_Buffer (1)'Address;
136 function Debug_String_F (Arg : F) return System.Address is
137 Image_String : constant String := F'Image (Arg) & ASCII.NUL;
138 Image_Size : constant Integer := Image_String'Length;
141 Debug_String_Buffer (1 .. Image_Size) := Image_String;
142 return Debug_String_Buffer (1)'Address;
149 function Debug_String_G (Arg : G) return System.Address is
150 Image_String : constant String := G'Image (Arg) & ASCII.NUL;
151 Image_Size : constant Integer := Image_String'Length;
154 Debug_String_Buffer (1 .. Image_Size) := Image_String;
155 return Debug_String_Buffer (1)'Address;
162 function Div_F (X, Y : F) return F is
171 function Div_G (X, Y : G) return G is
180 function Eq_F (X, Y : F) return Boolean is
189 function Eq_G (X, Y : G) return Boolean is
198 function F_To_G (X : F) return G is
207 function F_To_Q (X : F) return Q is
216 function F_To_S (X : F) return S is
225 function G_To_D (X : G) return D is
234 function G_To_F (X : G) return F is
243 function G_To_Q (X : G) return Q is
252 function G_To_T (X : G) return T is
261 function Le_F (X, Y : F) return Boolean is
270 function Le_G (X, Y : G) return Boolean is
279 function Lt_F (X, Y : F) return Boolean is
288 function Lt_G (X, Y : G) return Boolean is
297 function Mul_F (X, Y : F) return F is
306 function Mul_G (X, Y : G) return G is
315 function Ne_F (X, Y : F) return Boolean is
324 function Ne_G (X, Y : G) return Boolean is
333 function Neg_F (X : F) return F is
342 function Neg_G (X : G) return G is
351 procedure pd (Arg : D) is
353 System.IO.Put_Line (D'Image (Arg));
360 procedure pf (Arg : F) is
362 System.IO.Put_Line (F'Image (Arg));
369 procedure pg (Arg : G) is
371 System.IO.Put_Line (G'Image (Arg));
378 function Q_To_F (X : Q) return F is
387 function Q_To_G (X : Q) return G is
396 function S_To_F (X : S) return F is
405 function Return_D (X : D) return D is
414 function Return_F (X : F) return F is
423 function Return_G (X : G) return G is
432 function Sub_F (X, Y : F) return F is
441 function Sub_G (X, Y : G) return G is
450 function T_To_D (X : T) return D is
452 return G_To_D (T_To_G (X));
459 function T_To_G (X : T) return G is
468 -- For now, convert to IEEE and do Valid test on result. This is not quite
469 -- accurate, but is good enough in practice.
471 function Valid_D (Arg : D) return Boolean is
472 Val : constant T := G_To_T (D_To_G (Arg));
481 -- For now, convert to IEEE and do Valid test on result. This is not quite
482 -- accurate, but is good enough in practice.
484 function Valid_F (Arg : F) return Boolean is
485 Val : constant S := F_To_S (Arg);
494 -- For now, convert to IEEE and do Valid test on result. This is not quite
495 -- accurate, but is good enough in practice.
497 function Valid_G (Arg : G) return Boolean is
498 Val : constant T := G_To_T (Arg);
503 end System.Vax_Float_Operations;