URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-vaflop-vms-alpha.adb] - Blame information for rev 724

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--           S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1997-2011, Free Software Foundation, Inc.         --
--                       (Version for Alpha OpenVMS)                        --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with System.IO;
with System.Machine_Code; use System.Machine_Code;
 
package body System.Vax_Float_Operations is
 
   --  Declare the functions that do the conversions between floating-point
   --  formats.  Call the operands IEEE float so they get passed in
   --  FP registers.
 
   function Cvt_G_T (X : T) return T;
   function Cvt_T_G (X : T) return T;
   function Cvt_T_F (X : T) return S;
 
   pragma Import (C, Cvt_G_T, "OTS$CVT_FLOAT_G_T");
   pragma Import (C, Cvt_T_G, "OTS$CVT_FLOAT_T_G");
   pragma Import (C, Cvt_T_F, "OTS$CVT_FLOAT_T_F");
 
   --  In each of the conversion routines that are done with OTS calls,
   --  we define variables of the corresponding IEEE type so that they are
   --  passed and kept in the proper register class.
 
   Debug_String_Buffer : String (1 .. 32);
   --  Buffer used by all Debug_String_x routines for returning result
 
   ------------
   -- D_To_G --
   ------------
 
   function D_To_G (X : D) return G is
      A, B : T;
      C    : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));
      Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
      return C;
   end D_To_G;
 
   ------------
   -- F_To_G --
   ------------
 
   function F_To_G (X : F) return G is
      A : T;
      B : G;
   begin
      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
      return B;
   end F_To_G;
 
   ------------
   -- F_To_S --
   ------------
 
   function F_To_S (X : F) return S is
      A : T;
      B : S;
 
   begin
      --  Because converting to a wider FP format is a no-op, we say
      --  A is 64-bit even though we are loading 32 bits into it.
 
      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
 
      B := S (Cvt_G_T (A));
      return B;
   end F_To_S;
 
   ------------
   -- G_To_D --
   ------------
 
   function G_To_D (X : G) return D is
      A, B : T;
      C    : D;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B));
      return C;
   end G_To_D;
 
   ------------
   -- G_To_F --
   ------------
 
   function G_To_F (X : G) return F is
      A : T;
      B : S;
      C : F;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
      return C;
   end G_To_F;
 
   ------------
   -- G_To_Q --
   ------------
 
   function G_To_Q (X : G) return Q is
      A : T;
      B : Q;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      return B;
   end G_To_Q;
 
   ------------
   -- G_To_T --
   ------------
 
   function G_To_T (X : G) return T is
      A, B : T;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      B := Cvt_G_T (A);
      return B;
   end G_To_T;
 
   ------------
   -- F_To_Q --
   ------------
 
   function F_To_Q (X : F) return Q is
   begin
      return G_To_Q (F_To_G (X));
   end F_To_Q;
 
   ------------
   -- Q_To_F --
   ------------
 
   function Q_To_F (X : Q) return F is
      A : S;
      B : F;
   begin
      Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
      return B;
   end Q_To_F;
 
   ------------
   -- Q_To_G --
   ------------
 
   function Q_To_G (X : Q) return G is
      A : T;
      B : G;
   begin
      Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
      return B;
   end Q_To_G;
 
   ------------
   -- S_To_F --
   ------------
 
   function S_To_F (X : S) return F is
      A : S;
      B : F;
   begin
      A := Cvt_T_F (T (X));
      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
      return B;
   end S_To_F;
 
   ------------
   -- T_To_D --
   ------------
 
   function T_To_D (X : T) return D is
   begin
      return G_To_D (T_To_G (X));
   end T_To_D;
 
   ------------
   -- T_To_G --
   ------------
 
   function T_To_G (X : T) return G is
      A : T;
      B : G;
   begin
      A := Cvt_T_G (X);
      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
      return B;
   end T_To_G;
 
   -----------
   -- Abs_F --
   -----------
 
   function Abs_F (X : F) return F is
      A, B : S;
      C    : F;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
      Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
      return C;
   end Abs_F;
 
   -----------
   -- Abs_G --
   -----------
 
   function Abs_G (X : G) return G is
      A, B : T;
      C    : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
      return C;
   end Abs_G;
 
   -----------
   -- Add_F --
   -----------
 
   function Add_F (X, Y : F) return F is
      X1, Y1, R : S;
      R1        : F;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
      return R1;
   end Add_F;
 
   -----------
   -- Add_G --
   -----------
 
   function Add_G (X, Y : G) return G is
      X1, Y1, R : T;
      R1        : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
      return R1;
   end Add_G;
 
   --------------------
   -- Debug_Output_D --
   --------------------
 
   procedure Debug_Output_D (Arg : D) is
   begin
      System.IO.Put (D'Image (Arg));
   end Debug_Output_D;
 
   --------------------
   -- Debug_Output_F --
   --------------------
 
   procedure Debug_Output_F (Arg : F) is
   begin
      System.IO.Put (F'Image (Arg));
   end Debug_Output_F;
 
   --------------------
   -- Debug_Output_G --
   --------------------
 
   procedure Debug_Output_G (Arg : G) is
   begin
      System.IO.Put (G'Image (Arg));
   end Debug_Output_G;
 
   --------------------
   -- Debug_String_D --
   --------------------
 
   function Debug_String_D (Arg : D) return System.Address is
      Image_String : constant String  := D'Image (Arg) & ASCII.NUL;
      Image_Size   : constant Integer := Image_String'Length;
   begin
      Debug_String_Buffer (1 .. Image_Size) := Image_String;
      return Debug_String_Buffer (1)'Address;
   end Debug_String_D;
 
   --------------------
   -- Debug_String_F --
   --------------------
 
   function Debug_String_F (Arg : F) return System.Address is
      Image_String : constant String  := F'Image (Arg) & ASCII.NUL;
      Image_Size   : constant Integer := Image_String'Length;
   begin
      Debug_String_Buffer (1 .. Image_Size) := Image_String;
      return Debug_String_Buffer (1)'Address;
   end Debug_String_F;
 
   --------------------
   -- Debug_String_G --
   --------------------
 
   function Debug_String_G (Arg : G) return System.Address is
      Image_String : constant String  := G'Image (Arg) & ASCII.NUL;
      Image_Size   : constant Integer := Image_String'Length;
   begin
      Debug_String_Buffer (1 .. Image_Size) := Image_String;
      return Debug_String_Buffer (1)'Address;
   end Debug_String_G;
 
   -----------
   -- Div_F --
   -----------
 
   function Div_F (X, Y : F) return F is
      X1, Y1, R : S;
      R1        : F;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
      return R1;
   end Div_F;
 
   -----------
   -- Div_G --
   -----------
 
   function Div_G (X, Y : G) return G is
      X1, Y1, R : T;
      R1        : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
      return R1;
   end Div_G;
 
   ----------
   -- Eq_F --
   ----------
 
   function Eq_F (X, Y : F) return Boolean is
      X1, Y1, R : S;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Eq_F;
 
   ----------
   -- Eq_G --
   ----------
 
   function Eq_G (X, Y : G) return Boolean is
      X1, Y1, R : T;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Eq_G;
 
   ----------
   -- Le_F --
   ----------
 
   function Le_F (X, Y : F) return Boolean is
      X1, Y1, R : S;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Le_F;
 
   ----------
   -- Le_G --
   ----------
 
   function Le_G (X, Y : G) return Boolean is
      X1, Y1, R : T;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Le_G;
 
   ----------
   -- Lt_F --
   ----------
 
   function Lt_F (X, Y : F) return Boolean is
      X1, Y1, R : S;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Lt_F;
 
   ----------
   -- Lt_G --
   ----------
 
   function Lt_G (X, Y : G) return Boolean is
      X1, Y1, R : T;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      return R /= 0.0;
   end Lt_G;
 
   -----------
   -- Mul_F --
   -----------
 
   function Mul_F (X, Y : F) return F is
      X1, Y1, R : S;
      R1        : F;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
      return R1;
   end Mul_F;
 
   -----------
   -- Mul_G --
   -----------
 
   function Mul_G (X, Y : G) return G is
      X1, Y1, R : T;
      R1        : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
      return R1;
   end Mul_G;
 
   ----------
   -- Ne_F --
   ----------
 
   function Ne_F (X, Y : F) return Boolean is
      X1, Y1, R : S;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      return R = 0.0;
   end Ne_F;
 
   ----------
   -- Ne_G --
   ----------
 
   function Ne_G (X, Y : G) return Boolean is
      X1, Y1, R : T;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      return R = 0.0;
   end Ne_G;
 
   -----------
   -- Neg_F --
   -----------
 
   function Neg_F (X : F) return F is
      A, B : S;
      C    : F;
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
      Asm ("subf $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
      return C;
   end Neg_F;
 
   -----------
   -- Neg_G --
   -----------
 
   function Neg_G (X : G) return G is
      A, B : T;
      C    : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
      Asm ("subg $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
      return C;
   end Neg_G;
 
   --------
   -- pd --
   --------
 
   procedure pd (Arg : D) is
   begin
      System.IO.Put_Line (D'Image (Arg));
   end pd;
 
   --------
   -- pf --
   --------
 
   procedure pf (Arg : F) is
   begin
      System.IO.Put_Line (F'Image (Arg));
   end pf;
 
   --------
   -- pg --
   --------
 
   procedure pg (Arg : G) is
   begin
      System.IO.Put_Line (G'Image (Arg));
   end pg;
 
   --------------
   -- Return_D --
   --------------
 
   function Return_D (X : D) return D is
      R : D;
   begin
      --  The return value is already in $f0 so we need to trick the compiler
      --  into thinking that we're moving X to $f0.
      Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0",
        Volatile => True);
      Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True);
      return R;
   end Return_D;
 
   --------------
   -- Return_F --
   --------------
 
   function Return_F (X : F) return F is
      R : F;
   begin
      --  The return value is already in $f0 so we need to trick the compiler
      --  into thinking that we're moving X to $f0.
      Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X),
        Clobber => "$f0", Volatile => True);
      return R;
   end Return_F;
 
   --------------
   -- Return_G --
   --------------
 
   function Return_G (X : G) return G is
      R : G;
   begin
      --  The return value is already in $f0 so we need to trick the compiler
      --  into thinking that we're moving X to $f0.
      Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X),
        Clobber => "$f0", Volatile => True);
      return R;
   end Return_G;
 
   -----------
   -- Sub_F --
   -----------
 
   function Sub_F (X, Y : F) return F is
      X1, Y1, R : S;
      R1        : F;
 
   begin
      Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
      Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R),
           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
      return R1;
   end Sub_F;
 
   -----------
   -- Sub_G --
   -----------
 
   function Sub_G (X, Y : G) return G is
      X1, Y1, R : T;
      R1        : G;
   begin
      Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
      Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R),
           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
      return R1;
   end Sub_G;
 
   -------------
   -- Valid_D --
   -------------
 
   --  For now, convert to IEEE and do Valid test on result. This is not quite
   --  accurate, but is good enough in practice.
 
   function Valid_D (Arg : D) return Boolean is
      Val : constant T := G_To_T (D_To_G (Arg));
   begin
      return Val'Valid;
   end Valid_D;
 
   -------------
   -- Valid_F --
   -------------
 
   --  For now, convert to IEEE and do Valid test on result. This is not quite
   --  accurate, but is good enough in practice.
 
   function Valid_F (Arg : F) return Boolean is
      Val : constant S := F_To_S (Arg);
   begin
      return Val'Valid;
   end Valid_F;
 
   -------------
   -- Valid_G --
   -------------
 
   --  For now, convert to IEEE and do Valid test on result. This is not quite
   --  accurate, but is good enough in practice.
 
   function Valid_G (Arg : G) return Boolean is
      Val : constant T := G_To_T (Arg);
   begin
      return Val'Valid;
   end Valid_G;
 
end System.Vax_Float_Operations;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-vaflop-vms-alpha.adb] - Blame information for rev 724

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
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 --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1997-2011, Free Software Foundation, Inc. --`
10			`-- (Version for Alpha OpenVMS) --`
11			`-- --`
12			`-- GNAT is free software; you can redistribute it and/or modify it under --`
13			`-- terms of the GNU General Public License as published by the Free Soft- --`
14			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
15			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
16			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
17			`-- or FITNESS FOR A PARTICULAR PURPOSE. --`
18			`-- --`
19			`-- As a special exception under Section 7 of GPL version 3, you are granted --`
20			`-- additional permissions described in the GCC Runtime Library Exception, --`
21			`-- version 3.1, as published by the Free Software Foundation. --`
22			`-- --`
23			`-- You should have received a copy of the GNU General Public License and --`
24			`-- a copy of the GCC Runtime Library Exception along with this program; --`
25			`-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --`
26			`-- <http://www.gnu.org/licenses/>. --`
27			`-- --`
28			`-- GNAT was originally developed by the GNAT team at New York University. --`
29			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
30			`-- --`
31			`------------------------------------------------------------------------------`
32
33			`with System.IO;`
34			`with System.Machine_Code; use System.Machine_Code;`
35
36			`package body System.Vax_Float_Operations is`
37
38			`-- Declare the functions that do the conversions between floating-point`
39			`-- formats. Call the operands IEEE float so they get passed in`
40			`-- FP registers.`
41
42			`function Cvt_G_T (X : T) return T;`
43			`function Cvt_T_G (X : T) return T;`
44			`function Cvt_T_F (X : T) return S;`
45
46			`pragma Import (C, Cvt_G_T, "OTS$CVT_FLOAT_G_T");`
47			`pragma Import (C, Cvt_T_G, "OTS$CVT_FLOAT_T_G");`
48			`pragma Import (C, Cvt_T_F, "OTS$CVT_FLOAT_T_F");`
49
50			`-- In each of the conversion routines that are done with OTS calls,`
51			`-- we define variables of the corresponding IEEE type so that they are`
52			`-- passed and kept in the proper register class.`
53
54			`Debug_String_Buffer : String (1 .. 32);`
55			`-- Buffer used by all Debug_String_x routines for returning result`
56
57			`------------`
58			`-- D_To_G --`
59			`------------`
60
61			`function D_To_G (X : D) return G is`
62			`A, B : T;`
63			`C : G;`
64			`begin`
65			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));`
66			`Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
67			`Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));`
68			`return C;`
69			`end D_To_G;`
70
71			`------------`
72			`-- F_To_G --`
73			`------------`
74
75			`function F_To_G (X : F) return G is`
76			`A : T;`
77			`B : G;`
78			`begin`
79			`Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));`
80			`Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));`
81			`return B;`
82			`end F_To_G;`
83
84			`------------`
85			`-- F_To_S --`
86			`------------`
87
88			`function F_To_S (X : F) return S is`
89			`A : T;`
90			`B : S;`
91
92			`begin`
93			`-- Because converting to a wider FP format is a no-op, we say`
94			`-- A is 64-bit even though we are loading 32 bits into it.`
95
96			`Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));`
97
98			`B := S (Cvt_G_T (A));`
99			`return B;`
100			`end F_To_S;`
101
102			`------------`
103			`-- G_To_D --`
104			`------------`
105
106			`function G_To_D (X : G) return D is`
107			`A, B : T;`
108			`C : D;`
109			`begin`
110			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
111			`Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
112			`Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B));`
113			`return C;`
114			`end G_To_D;`
115
116			`------------`
117			`-- G_To_F --`
118			`------------`
119
120			`function G_To_F (X : G) return F is`
121			`A : T;`
122			`B : S;`
123			`C : F;`
124			`begin`
125			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
126			`Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
127			`Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));`
128			`return C;`
129			`end G_To_F;`
130
131			`------------`
132			`-- G_To_Q --`
133			`------------`
134
135			`function G_To_Q (X : G) return Q is`
136			`A : T;`
137			`B : Q;`
138			`begin`
139			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
140			`Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
141			`return B;`
142			`end G_To_Q;`
143
144			`------------`
145			`-- G_To_T --`
146			`------------`
147
148			`function G_To_T (X : G) return T is`
149			`A, B : T;`
150			`begin`
151			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
152			`B := Cvt_G_T (A);`
153			`return B;`
154			`end G_To_T;`
155
156			`------------`
157			`-- F_To_Q --`
158			`------------`
159
160			`function F_To_Q (X : F) return Q is`
161			`begin`
162			`return G_To_Q (F_To_G (X));`
163			`end F_To_Q;`
164
165			`------------`
166			`-- Q_To_F --`
167			`------------`
168
169			`function Q_To_F (X : Q) return F is`
170			`A : S;`
171			`B : F;`
172			`begin`
173			`Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));`
174			`Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));`
175			`return B;`
176			`end Q_To_F;`
177
178			`------------`
179			`-- Q_To_G --`
180			`------------`
181
182			`function Q_To_G (X : Q) return G is`
183			`A : T;`
184			`B : G;`
185			`begin`
186			`Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));`
187			`Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));`
188			`return B;`
189			`end Q_To_G;`
190
191			`------------`
192			`-- S_To_F --`
193			`------------`
194
195			`function S_To_F (X : S) return F is`
196			`A : S;`
197			`B : F;`
198			`begin`
199			`A := Cvt_T_F (T (X));`
200			`Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));`
201			`return B;`
202			`end S_To_F;`
203
204			`------------`
205			`-- T_To_D --`
206			`------------`
207
208			`function T_To_D (X : T) return D is`
209			`begin`
210			`return G_To_D (T_To_G (X));`
211			`end T_To_D;`
212
213			`------------`
214			`-- T_To_G --`
215			`------------`
216
217			`function T_To_G (X : T) return G is`
218			`A : T;`
219			`B : G;`
220			`begin`
221			`A := Cvt_T_G (X);`
222			`Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));`
223			`return B;`
224			`end T_To_G;`
225
226			`-----------`
227			`-- Abs_F --`
228			`-----------`
229
230			`function Abs_F (X : F) return F is`
231			`A, B : S;`
232			`C : F;`
233			`begin`
234			`Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));`
235			`Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));`
236			`Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));`
237			`return C;`
238			`end Abs_F;`
239
240			`-----------`
241			`-- Abs_G --`
242			`-----------`
243
244			`function Abs_G (X : G) return G is`
245			`A, B : T;`
246			`C : G;`
247			`begin`
248			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
249			`Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
250			`Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));`
251			`return C;`
252			`end Abs_G;`
253
254			`-----------`
255			`-- Add_F --`
256			`-----------`
257
258			`function Add_F (X, Y : F) return F is`
259			`X1, Y1, R : S;`
260			`R1 : F;`
261			`begin`
262			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
263			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
264			`Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R),`
265			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
266			`Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));`
267			`return R1;`
268			`end Add_F;`
269
270			`-----------`
271			`-- Add_G --`
272			`-----------`
273
274			`function Add_G (X, Y : G) return G is`
275			`X1, Y1, R : T;`
276			`R1 : G;`
277			`begin`
278			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
279			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
280			`Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R),`
281			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
282			`Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));`
283			`return R1;`
284			`end Add_G;`
285
286			`--------------------`
287			`-- Debug_Output_D --`
288			`--------------------`
289
290			`procedure Debug_Output_D (Arg : D) is`
291			`begin`
292			`System.IO.Put (D'Image (Arg));`
293			`end Debug_Output_D;`
294
295			`--------------------`
296			`-- Debug_Output_F --`
297			`--------------------`
298
299			`procedure Debug_Output_F (Arg : F) is`
300			`begin`
301			`System.IO.Put (F'Image (Arg));`
302			`end Debug_Output_F;`
303
304			`--------------------`
305			`-- Debug_Output_G --`
306			`--------------------`
307
308			`procedure Debug_Output_G (Arg : G) is`
309			`begin`
310			`System.IO.Put (G'Image (Arg));`
311			`end Debug_Output_G;`
312
313			`--------------------`
314			`-- Debug_String_D --`
315			`--------------------`
316
317			`function Debug_String_D (Arg : D) return System.Address is`
318			`Image_String : constant String := D'Image (Arg) & ASCII.NUL;`
319			`Image_Size : constant Integer := Image_String'Length;`
320			`begin`
321			`Debug_String_Buffer (1 .. Image_Size) := Image_String;`
322			`return Debug_String_Buffer (1)'Address;`
323			`end Debug_String_D;`
324
325			`--------------------`
326			`-- Debug_String_F --`
327			`--------------------`
328
329			`function Debug_String_F (Arg : F) return System.Address is`
330			`Image_String : constant String := F'Image (Arg) & ASCII.NUL;`
331			`Image_Size : constant Integer := Image_String'Length;`
332			`begin`
333			`Debug_String_Buffer (1 .. Image_Size) := Image_String;`
334			`return Debug_String_Buffer (1)'Address;`
335			`end Debug_String_F;`
336
337			`--------------------`
338			`-- Debug_String_G --`
339			`--------------------`
340
341			`function Debug_String_G (Arg : G) return System.Address is`
342			`Image_String : constant String := G'Image (Arg) & ASCII.NUL;`
343			`Image_Size : constant Integer := Image_String'Length;`
344			`begin`
345			`Debug_String_Buffer (1 .. Image_Size) := Image_String;`
346			`return Debug_String_Buffer (1)'Address;`
347			`end Debug_String_G;`
348
349			`-----------`
350			`-- Div_F --`
351			`-----------`
352
353			`function Div_F (X, Y : F) return F is`
354			`X1, Y1, R : S;`
355			`R1 : F;`
356			`begin`
357			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
358			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
359			`Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R),`
360			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
361			`Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));`
362			`return R1;`
363			`end Div_F;`
364
365			`-----------`
366			`-- Div_G --`
367			`-----------`
368
369			`function Div_G (X, Y : G) return G is`
370			`X1, Y1, R : T;`
371			`R1 : G;`
372			`begin`
373			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
374			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
375			`Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R),`
376			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
377			`Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));`
378			`return R1;`
379			`end Div_G;`
380
381			`----------`
382			`-- Eq_F --`
383			`----------`
384
385			`function Eq_F (X, Y : F) return Boolean is`
386			`X1, Y1, R : S;`
387			`begin`
388			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
389			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
390			`Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),`
391			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
392			`return R /= 0.0;`
393			`end Eq_F;`
394
395			`----------`
396			`-- Eq_G --`
397			`----------`
398
399			`function Eq_G (X, Y : G) return Boolean is`
400			`X1, Y1, R : T;`
401			`begin`
402			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
403			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
404			`Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),`
405			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
406			`return R /= 0.0;`
407			`end Eq_G;`
408
409			`----------`
410			`-- Le_F --`
411			`----------`
412
413			`function Le_F (X, Y : F) return Boolean is`
414			`X1, Y1, R : S;`
415			`begin`
416			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
417			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
418			`Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R),`
419			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
420			`return R /= 0.0;`
421			`end Le_F;`
422
423			`----------`
424			`-- Le_G --`
425			`----------`
426
427			`function Le_G (X, Y : G) return Boolean is`
428			`X1, Y1, R : T;`
429			`begin`
430			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
431			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
432			`Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R),`
433			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
434			`return R /= 0.0;`
435			`end Le_G;`
436
437			`----------`
438			`-- Lt_F --`
439			`----------`
440
441			`function Lt_F (X, Y : F) return Boolean is`
442			`X1, Y1, R : S;`
443			`begin`
444			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
445			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
446			`Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R),`
447			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
448			`return R /= 0.0;`
449			`end Lt_F;`
450
451			`----------`
452			`-- Lt_G --`
453			`----------`
454
455			`function Lt_G (X, Y : G) return Boolean is`
456			`X1, Y1, R : T;`
457			`begin`
458			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
459			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
460			`Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R),`
461			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
462			`return R /= 0.0;`
463			`end Lt_G;`
464
465			`-----------`
466			`-- Mul_F --`
467			`-----------`
468
469			`function Mul_F (X, Y : F) return F is`
470			`X1, Y1, R : S;`
471			`R1 : F;`
472			`begin`
473			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
474			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
475			`Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R),`
476			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
477			`Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));`
478			`return R1;`
479			`end Mul_F;`
480
481			`-----------`
482			`-- Mul_G --`
483			`-----------`
484
485			`function Mul_G (X, Y : G) return G is`
486			`X1, Y1, R : T;`
487			`R1 : G;`
488			`begin`
489			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
490			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
491			`Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R),`
492			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
493			`Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));`
494			`return R1;`
495			`end Mul_G;`
496
497			`----------`
498			`-- Ne_F --`
499			`----------`
500
501			`function Ne_F (X, Y : F) return Boolean is`
502			`X1, Y1, R : S;`
503			`begin`
504			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
505			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
506			`Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),`
507			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
508			`return R = 0.0;`
509			`end Ne_F;`
510
511			`----------`
512			`-- Ne_G --`
513			`----------`
514
515			`function Ne_G (X, Y : G) return Boolean is`
516			`X1, Y1, R : T;`
517			`begin`
518			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
519			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
520			`Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),`
521			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
522			`return R = 0.0;`
523			`end Ne_G;`
524
525			`-----------`
526			`-- Neg_F --`
527			`-----------`
528
529			`function Neg_F (X : F) return F is`
530			`A, B : S;`
531			`C : F;`
532			`begin`
533			`Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));`
534			`Asm ("subf $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));`
535			`Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));`
536			`return C;`
537			`end Neg_F;`
538
539			`-----------`
540			`-- Neg_G --`
541			`-----------`
542
543			`function Neg_G (X : G) return G is`
544			`A, B : T;`
545			`C : G;`
546			`begin`
547			`Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));`
548			`Asm ("subg $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));`
549			`Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));`
550			`return C;`
551			`end Neg_G;`
552
553			`--------`
554			`-- pd --`
555			`--------`
556
557			`procedure pd (Arg : D) is`
558			`begin`
559			`System.IO.Put_Line (D'Image (Arg));`
560			`end pd;`
561
562			`--------`
563			`-- pf --`
564			`--------`
565
566			`procedure pf (Arg : F) is`
567			`begin`
568			`System.IO.Put_Line (F'Image (Arg));`
569			`end pf;`
570
571			`--------`
572			`-- pg --`
573			`--------`
574
575			`procedure pg (Arg : G) is`
576			`begin`
577			`System.IO.Put_Line (G'Image (Arg));`
578			`end pg;`
579
580			`--------------`
581			`-- Return_D --`
582			`--------------`
583
584			`function Return_D (X : D) return D is`
585			`R : D;`
586			`begin`
587			`-- The return value is already in $f0 so we need to trick the compiler`
588			`-- into thinking that we're moving X to $f0.`
589			`Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0",`
590			`Volatile => True);`
591			`Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True);`
592			`return R;`
593			`end Return_D;`
594
595			`--------------`
596			`-- Return_F --`
597			`--------------`
598
599			`function Return_F (X : F) return F is`
600			`R : F;`
601			`begin`
602			`-- The return value is already in $f0 so we need to trick the compiler`
603			`-- into thinking that we're moving X to $f0.`
604			`Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X),`
605			`Clobber => "$f0", Volatile => True);`
606			`return R;`
607			`end Return_F;`
608
609			`--------------`
610			`-- Return_G --`
611			`--------------`
612
613			`function Return_G (X : G) return G is`
614			`R : G;`
615			`begin`
616			`-- The return value is already in $f0 so we need to trick the compiler`
617			`-- into thinking that we're moving X to $f0.`
618			`Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X),`
619			`Clobber => "$f0", Volatile => True);`
620			`return R;`
621			`end Return_G;`
622
623			`-----------`
624			`-- Sub_F --`
625			`-----------`
626
627			`function Sub_F (X, Y : F) return F is`
628			`X1, Y1, R : S;`
629			`R1 : F;`
630
631			`begin`
632			`Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));`
633			`Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));`
634			`Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R),`
635			`(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));`
636			`Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));`
637			`return R1;`
638			`end Sub_F;`
639
640			`-----------`
641			`-- Sub_G --`
642			`-----------`
643
644			`function Sub_G (X, Y : G) return G is`
645			`X1, Y1, R : T;`
646			`R1 : G;`
647			`begin`
648			`Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));`
649			`Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));`
650			`Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R),`
651			`(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));`
652			`Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));`
653			`return R1;`
654			`end Sub_G;`
655
656			`-------------`
657			`-- Valid_D --`
658			`-------------`
659
660			`-- For now, convert to IEEE and do Valid test on result. This is not quite`
661			`-- accurate, but is good enough in practice.`
662
663			`function Valid_D (Arg : D) return Boolean is`
664			`Val : constant T := G_To_T (D_To_G (Arg));`
665			`begin`
666			`return Val'Valid;`
667			`end Valid_D;`
668
669			`-------------`
670			`-- Valid_F --`
671			`-------------`
672
673			`-- For now, convert to IEEE and do Valid test on result. This is not quite`
674			`-- accurate, but is good enough in practice.`
675
676			`function Valid_F (Arg : F) return Boolean is`
677			`Val : constant S := F_To_S (Arg);`
678			`begin`
679			`return Val'Valid;`
680			`end Valid_F;`
681
682			`-------------`
683			`-- Valid_G --`
684			`-------------`
685
686			`-- For now, convert to IEEE and do Valid test on result. This is not quite`
687			`-- accurate, but is good enough in practice.`
688
689			`function Valid_G (Arg : G) return Boolean is`
690			`Val : constant T := G_To_T (Arg);`
691			`begin`
692			`return Val'Valid;`
693			`end Valid_G;`
694
695			`end System.Vax_Float_Operations;`