2004-06-07 Robert Dewar <dewar@gnat.com>

	* a-direct.ads, einfo.ads: Minor comment updates

	* s-taprop-lynxos.adb, s-taprop-tru64.adb, s-taprop-irix.adb,
	s-taprop-irix-athread.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb,
	s-taprop-dummy.adb, s-taprop-os2.adb, s-taprop-solaris.adb,
	s-taprop-vms.adb, s-taprop-mingw.adb, s-taprop-vxworks.adb,
	s-taprop-posix.adb, s-taprop.ads, exp_dbug.adb: Minor reformatting.

	* s-interr-sigaction.adb: Remove unreferenced variable
	(Attached_Interrupts).  Minor reformatting.
	Avoid use of variable I (replace by J).

	* par-ch10.adb: Fix text of one error message

	* checks.adb, checks.ads, cstand.adb, vms_data.ads, errout.ads,
	exp_aggr.adb, exp_ch3.adb, exp_ch3.ads, exp_ch5.adb, exp_ch6.adb,
	exp_ch9.adb, exp_code.adb, gnat1drv.adb, lib-load.adb, lib-writ.adb,
	opt.adb, par.adb, opt.ads, par-ch11.adb, par-ch3.adb, par-ch4.adb,
	par-ch5.adb, par-ch6.adb, par-ch8.adb, par-ch9.adb, par-prag.adb,
	par-util.adb, scng.adb, sem_aggr.adb, sem_attr.adb, sem_cat.adb,
        sem_ch10.adb, sem_ch10.adb, sem_ch11.adb, sem_ch12.adb, sem_ch2.adb,
	sem_ch3.adb, sem_ch3.ads, sem_ch4.adb, sem_ch5.adb, sem_ch6.adb,
	sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_eval.adb, sem_prag.adb,
	sem_res.adb, sem_type.adb, sem_util.adb, sinfo.ads, snames.adb,
	snames.ads, snames.h, sprint.adb, switch-c.adb: Modifications for Ada
	2005 support.

2004-06-07  Doug Rupp  <rupp@gnat.com>

	* mlib-tgt-vms.adb: Rename mlib-tgt-vms.adb mlib-tgt-vms-alpha.adb

	* s-vaflop-vms.adb: Rename s-vaflop-vms.adb to s-vaflop-vms-alpha.adb

	* mlib-tgt-vms-ia64.adb: New file.

	* Makefile.in: Rename mlib-tgt-vms.adb to mlib-tgt-vms-alpha.adb
	Add mlib-tgt-vms-ia64.adb
	Rename s-vaflop-vms.adb to s-vaflop-vms-alpha.adb.
	Move to alpha specific ifeq section.
	Add VMS specific versions of symbols.adb
	Renaming of 5q vms files.

	* 5qsystem.ads renamed to system-vms_64.ads.

2004-06-07  Vincent Celier  <celier@gnat.com>

	* a-calend.ads: Add a GNAT Note comment after function Time_Of to
	explain that when a time of day corresponding to the non existing hour
	on the day switching to DST is specified, Split may return a different
	value for Seconds.

	* gnatcmd.adb: Add processing of GNAT METRIC (for gnatmetric), similar
	to GNAT PRETTY.

	* g-os_lib.adb (OpenVMS): New Boolean value imported from System.
	(Normalize_Pathname): Only resolve VMS logical names when on VMS.

	* mlib-prj.adb (Build_Library): New flag Gtrasymobj_Needed, initialize
	to False.
	If Gtrasymobj_Needed is True, add the full path of g-trasym.obj to
	the linking options.
	(Build_Library.Check_Libs): On VMS, if there is a dependency on
	g-trasym.ads, set Gtrasymobj_Needed to True.

	* prj-attr.adb: Add new package Metrics for gnatmetric

	* prj-nmsc.adb (Record_Other_Sources): Put source file names in
	canonical case to take into account files with upper case characters on
	Windows.
	(Ada_Check): Load the reference symbol file name in the name buffer to
	check it, not the symbol file name.

	* snames.ads, snames.adb: Add standard name Metrics (name of project
	file package for gnatmetric).

	* vms_conv.ads: Add Metric to Comment_Type

	* vms_conv.adb (Initialize): Add component dor Metric in Command_List

	* vms_data.ads: Add qualifiers for GNAT METRIC

	* makegpr.adb (Link_Executables): Take into account the switches
	specified in package Linker of the main project.

2004-06-07  Thomas Quinot  <quinot@act-europe.fr>

	* bindgen.adb (Set_Unit_Number): Units is an instance of Table, and so
	the index of the last element is Units.Last, not Units.Table'Last
	(which is usually not a valid index within the actually allocated
	storage for the table).

	* exp_ch4.adb (Insert_Dereference_Action): Change predicate that
	determines whether to generate a call to a checked storage pool
	Dereference action.
	Generate such a call only for a dereference that either comes from
	source, or is the result of rewriting a dereference that comes from
	source.

2004-06-07  Romain Berrendonner  <berrendo@act-europe.fr>

	* bindgen.adb (Gen_Output_File): Add support for GAP builds.

2004-06-07  Eric Botcazou  <ebotcazou@act-europe.fr>

	(gnat_to_gnu_entity) <E_Array_Subtype>: For multi-dimensional arrays at
	file level, elaborate the stride for inner dimensions in alignment
	units, not bytes.

	* exp_ch5.adb: Correct wrong reference to Component_May_Be_Bit_Aligned
	in a comment.

2004-06-07  Javier Miranda  <miranda@gnat.com>

	* exp_ch6.adb: Correct wrong modification in previous patch

2004-06-07  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* g-trasym.ads: Corrected comment to properly reflect level of support
	on VMS.

2004-06-07  Hristian Kirtchev  <kirtchev@gnat.com>

	* lib-xref.adb (Generate_Reference): Add nested function Is_On_LHS. It
	includes case of a variable referenced on the left hand side of an
	assignment, therefore remove redundant code. Variables and prefixes of
	indexed or selected components are now marked as referenced on left
	hand side. Warnings are now properly emitted when variables or prefixes
	are assigned but not read.

	* sem_warn.adb (Output_Unreferenced_Messages): Add additional checks to
	left hand side referenced variables. Private access types do not
	produce the warning "variable ... is assigned but never read".
	Add also additional checks to left hand side referenced variables.
	Aliased, renamed objects and access types do not produce the warning
	"variable ... is assigned but never read" since other entities may read
	the memory location.

2004-06-07  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in: In the powerpc/vxworks-specific section, restore
	EXTRA_GNATRTL_NONTASKING_OBJS and EXTRA_GNATRTL_TASKING_OBJS (removed
	by mistake).

2004-06-07  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch4.adb (Remove_Abstract_Operations): Refine the removal of
	predefined operators.
	Removes spurious type errors from g-trasym-vms.adb.

	* sem_res.adb (Rewrite_Renamed_Operator): If intrinsic operator is
	distinct from the operator appearing in the source, call appropriate
	routine to insert conversions when needed, and complete resolution of
	node.
	(Resolve_Intrinsic_Operator): Fix cut-and-paste bug on transfer of
	interpretations for rewritten right operand.
	(Set_Mixed_Mode_Operand): Handle properly a universal real operand when
	the other operand is overloaded and the context is a type conversion.

2004-06-07  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* ada-tree.def (BLOCK_STMT): Now has two operands.
	(BREAK_STMT): New.

	* ada-tree.h: (BLOCK_STMT_BLOCK): New macro.

	* gigi.h: (gnat_poplevel): Now returns a tree.

	* trans.c (end_block_stmt): Add arg; all callers changed.
	(tree_transform, case N_Case_Statement): Make a BLOCK_STMT for a WHEN.
	(start_block_stmt): Clear BLOCK_STMT_BLOCK.
	(add_stmt): Set TREE_TYPE.
	(gnat_expand_stmt, case BLOCK_STMT): Handle BLOCK_STMT_BLOCK.
	(gnat_expand_stmt, case BREAK_STMT): New case.

	* utils.c (gnat_poplevel): Return a BLOCK, if we made one.

2004-06-07  Jose Ruiz  <ruiz@act-europe.fr>

	* s-stchop.adsm s-stchop.adb, s-stchop-vxworks.adb: Remove the
	procedure Set_Stack_Size that is not needed.

2004-06-07  Sergey Rybin  <rybin@act-europe.fr>

	* gnat_ugn.texi: Clarify the case when non-standard naming scheme is
	used for gnatpp input file and for the files upon which it depends

2004-06-07  Ben Brosgol  <brosgol@gnat.com>

	* gnat_ugn.texi: Wordsmithing of "GNAT and Libraries" chapter

2004-06-07  Arnaud Charlet  <charlet@act-europe.fr>

	* gnatvsn.ads: Bump version numbers appropriately.
	Add new build type.

2004-06-07  Pascal Obry  <obry@gnat.com>

	* gnat_ugn.texi: Improve comments about imported names and link names
	on Windows. Add a note about the requirement to use -k gnatdll's option
	when working with a DLL which has stripped stdcall symbols (no @nn
	suffix).


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@82691 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 621 insertions, 0 deletions

diff --git a/gcc/ada/s-vaflop-vms-alpha.adb b/gcc/ada/s-vaflop-vms-alpha.adb
new file mode 100644
index 00000000000..8b1bf031fa4
--- /dev/null
+++ b/gcc/ada/s-vaflop-vms-alpha.adb
@@ -0,0 +1,621 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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-2000 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 2,  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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.IO;           use System.IO;
+with System.Machine_Code; use System.Machine_Code;
+
+package body System.Vax_Float_Operations is
+
+   --  Ensure this gets compiled with -O to avoid extra (and possibly
+   --  improper) memory stores.
+
+   pragma Optimize (Time);
+
+   --  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.
+
+   ------------
+   -- 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
+      Put (D'Image (Arg));
+   end Debug_Output_D;
+
+   --------------------
+   -- Debug_Output_F --
+   --------------------
+
+   procedure Debug_Output_F (Arg : F) is
+   begin
+      Put (F'Image (Arg));
+   end Debug_Output_F;
+
+   --------------------
+   -- Debug_Output_G --
+   --------------------
+
+   procedure Debug_Output_G (Arg : G) is
+   begin
+      Put (G'Image (Arg));
+   end Debug_Output_G;
+
+   --------------------
+   -- Debug_String_D --
+   --------------------
+
+   Debug_String_Buffer : String (1 .. 32);
+   --  Buffer used by all Debug_String_x routines for returning result
+
+   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;
+
+   -----------
+   -- 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 ("cpysn %1,%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 ("cpysn %1,%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
+      Put_Line (D'Image (Arg));
+   end pd;
+
+   --------
+   -- pf --
+   --------
+
+   procedure pf (Arg : F) is
+   begin
+      Put_Line (F'Image (Arg));
+   end pf;
+
+   --------
+   -- pg --
+   --------
+
+   procedure pg (Arg : G) is
+   begin
+      Put_Line (G'Image (Arg));
+   end pg;
+
+   -----------
+   -- 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;
+
+end System.Vax_Float_Operations;