2005-11-14 Robert Dewar <dewar@adacore.com>

	    Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb: Implement Machine_Rounding attribute
	(Analyze_Access_Attribute): The access attribute may appear within an
	aggregate that has been expanded into a loop.
	(Check_Task_Prefix): Add semantic check for attribute 'Callable and
	'Terminated whenever the prefix is of a task interface class-wide type.
	(Analyze_Attribute): Add semantic check for attribute 'Identity whenever
	the prefix is of a task interface class-wide type.

	* s-vaflop-vms-alpha.adb: Valid_D, Valid_F, Valid_G: Make Val constant
	to avoid warnings.

	* s-fatgen.ads, s-fatgen.adb (Machine_Rounding): New function
	Remove pragma Inline for [Unaligned_]Valid.
	Add comments that Valid routines do not work for Vax_Float

	* exp_attr.adb: Implement Machine_Rounding attribute

	* snames.h: Add entry for Machine_Rounding attribute



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

6 files changed, 513 insertions, 229 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b9d7ee1f1df..11bc258d86e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -85,16 +85,17 @@ package body Exp_Attr is
 
    procedure Expand_Fpt_Attribute
      (N    : Node_Id;
-      Rtp  : Entity_Id;
+      Pkg  : RE_Id;
       Nam  : Name_Id;
       Args : List_Id);
    --  This procedure expands a call to a floating-point attribute function.
    --  N is the attribute reference node, and Args is a list of arguments to
-   --  be passed to the function call. Rtp is the root type of the floating
-   --  point type involved (used to select the proper generic instantiation
-   --  of the package containing the attribute routines). The Nam argument
-   --  is the attribute processing routine to be called. This is normally
-   --  the same as the attribute name, except in the Unaligned_Valid case.
+   --  be passed to the function call. Pkg identifies the package containing
+   --  the appropriate instantiation of System.Fat_Gen. Float arguments in Args
+   --  have already been converted to the floating-point type for which Pkg was
+   --  instantiated. The Nam argument is the relevant attribute processing
+   --  routine to be called. This is the same as the attribute name, except in
+   --  the Unaligned_Valid case.
 
    procedure Expand_Fpt_Attribute_R (N : Node_Id);
    --  This procedure expands a call to a floating-point attribute function
@@ -123,6 +124,15 @@ package body Exp_Attr is
    --  A reference to a type within its own scope is resolved to a reference
    --  to the current instance of the type in its initialization procedure.
 
+   procedure Find_Fat_Info
+     (T        : Entity_Id;
+      Fat_Type : out Entity_Id;
+      Fat_Pkg  : out RE_Id);
+   --  Given a floating-point type T, identifies the package containing the
+   --  attributes for this type (returned in Fat_Pkg), and the corresponding
+   --  type for which this package was instantiated from Fat_Gen. Error if T
+   --  is not a floating-point type.
+
    function Find_Stream_Subprogram
      (Typ : Entity_Id;
       Nam : TSS_Name_Type) return Entity_Id;
@@ -176,7 +186,7 @@ package body Exp_Attr is
       if Check then
          Insert_Action (N, Decl);
       else
-         Insert_Action (N, Decl, All_Checks);
+         Insert_Action (N, Decl, Suppress => All_Checks);
       end if;
 
       if Installed then
@@ -260,18 +270,17 @@ package body Exp_Attr is
 
    procedure Expand_Fpt_Attribute
      (N    : Node_Id;
-      Rtp  : Entity_Id;
+      Pkg  : RE_Id;
       Nam  : Name_Id;
       Args : List_Id)
    is
       Loc : constant Source_Ptr := Sloc (N);
       Typ : constant Entity_Id  := Etype (N);
-      Pkg : RE_Id;
       Fnm : Node_Id;
 
    begin
-      --  The function name is the selected component Fat_xxx.yyy where xxx
-      --  is the floating-point root type, and yyy is the argument Nam.
+      --  The function name is the selected component Attr_xxx.yyy where
+      --  Attr_xxx is the package name, and yyy is the argument Nam.
 
       --  Note: it would be more usual to have separate RE entries for each
       --  of the entities in the Fat packages, but first they have identical
@@ -279,16 +288,6 @@ package body Exp_Attr is
       --  meet the normal RE rule of separate names for all runtime entities),
       --  and second there would be an awful lot of them!
 
-      if Rtp = Standard_Short_Float then
-         Pkg := RE_Fat_Short_Float;
-      elsif Rtp = Standard_Float then
-         Pkg := RE_Fat_Float;
-      elsif Rtp = Standard_Long_Float then
-         Pkg := RE_Fat_Long_Float;
-      else
-         Pkg := RE_Fat_Long_Long_Float;
-      end if;
-
       Fnm :=
         Make_Selected_Component (Loc,
           Prefix        => New_Reference_To (RTE (Pkg), Loc),
@@ -302,7 +301,7 @@ package body Exp_Attr is
       Rewrite (N,
         Unchecked_Convert_To (Base_Type (Etype (N)),
           Make_Function_Call (Loc,
-            Name => Fnm,
+            Name                   => Fnm,
             Parameter_Associations => Args)));
 
       Analyze_And_Resolve (N, Typ);
@@ -318,12 +317,13 @@ package body Exp_Attr is
 
    procedure Expand_Fpt_Attribute_R (N : Node_Id) is
       E1  : constant Node_Id    := First (Expressions (N));
-      Rtp : constant Entity_Id  := Root_Type (Etype (E1));
-
+      Ftp : Entity_Id;
+      Pkg : RE_Id;
    begin
+      Find_Fat_Info (Etype (E1), Ftp, Pkg);
       Expand_Fpt_Attribute
-        (N, Rtp, Attribute_Name (N),
-         New_List (Unchecked_Convert_To (Rtp, Relocate_Node (E1))));
+        (N, Pkg, Attribute_Name (N),
+         New_List (Unchecked_Convert_To (Ftp, Relocate_Node (E1))));
    end Expand_Fpt_Attribute_R;
 
    -----------------------------
@@ -337,14 +337,15 @@ package body Exp_Attr is
 
    procedure Expand_Fpt_Attribute_RI (N : Node_Id) is
       E1  : constant Node_Id   := First (Expressions (N));
-      Rtp : constant Entity_Id := Root_Type (Etype (E1));
+      Ftp : Entity_Id;
+      Pkg : RE_Id;
       E2  : constant Node_Id   := Next (E1);
-
    begin
+      Find_Fat_Info (Etype (E1), Ftp, Pkg);
       Expand_Fpt_Attribute
-        (N, Rtp, Attribute_Name (N),
+        (N, Pkg, Attribute_Name (N),
          New_List (
-           Unchecked_Convert_To (Rtp, Relocate_Node (E1)),
+           Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
            Unchecked_Convert_To (Standard_Integer, Relocate_Node (E2))));
    end Expand_Fpt_Attribute_RI;
 
@@ -358,15 +359,16 @@ package body Exp_Attr is
 
    procedure Expand_Fpt_Attribute_RR (N : Node_Id) is
       E1  : constant Node_Id   := First (Expressions (N));
-      Rtp : constant Entity_Id := Root_Type (Etype (E1));
+      Ftp : Entity_Id;
+      Pkg : RE_Id;
       E2  : constant Node_Id   := Next (E1);
-
    begin
+      Find_Fat_Info (Etype (E1), Ftp, Pkg);
       Expand_Fpt_Attribute
-        (N, Rtp, Attribute_Name (N),
+        (N, Pkg, Attribute_Name (N),
          New_List (
-           Unchecked_Convert_To (Rtp, Relocate_Node (E1)),
-           Unchecked_Convert_To (Rtp, Relocate_Node (E2))));
+           Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
+           Unchecked_Convert_To (Ftp, Relocate_Node (E2))));
    end Expand_Fpt_Attribute_RR;
 
    ----------------------------------
@@ -1011,8 +1013,31 @@ package body Exp_Attr is
 
       when Attribute_Callable => Callable :
       begin
-         Rewrite (N,
-           Build_Call_With_Task (Pref, RTE (RE_Callable)));
+         --  We have an object of a task interface class-wide type as a prefix
+         --  to Callable. Generate:
+
+         --    callable (Pref._disp_get_task_id);
+
+         if Ada_Version >= Ada_05
+           and then Ekind (Etype (Pref)) = E_Class_Wide_Type
+           and then Is_Interface      (Etype (Pref))
+           and then Is_Task_Interface (Etype (Pref))
+         then
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name =>
+                  New_Reference_To (RTE (RE_Callable), Loc),
+                Parameter_Associations => New_List (
+                  Make_Selected_Component (Loc,
+                    Prefix =>
+                      New_Copy_Tree (Pref),
+                    Selector_Name =>
+                      Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
+         else
+            Rewrite (N,
+              Build_Call_With_Task (Pref, RTE (RE_Callable)));
+         end if;
+
          Analyze_And_Resolve (N, Standard_Boolean);
       end Callable;
 
@@ -1630,8 +1655,8 @@ package body Exp_Attr is
 
       --  expands into
 
-      --    Result_Type (System.Fore (Long_Long_Float (Type'First)),
-      --                              Long_Long_Float (Type'Last))
+      --    Result_Type (System.Fore (Universal_Real (Type'First)),
+      --                              Universal_Real (Type'Last))
 
       --  Note that we know that the type is a non-static subtype, or Fore
       --  would have itself been computed dynamically in Eval_Attribute.
@@ -1647,12 +1672,12 @@ package body Exp_Attr is
                Name => New_Reference_To (RTE (RE_Fore), Loc),
 
                Parameter_Associations => New_List (
-                 Convert_To (Standard_Long_Long_Float,
+                 Convert_To (Universal_Real,
                    Make_Attribute_Reference (Loc,
                      Prefix => New_Reference_To (Ptyp, Loc),
                      Attribute_Name => Name_First)),
 
-                 Convert_To (Standard_Long_Long_Float,
+                 Convert_To (Universal_Real,
                    Make_Attribute_Reference (Loc,
                      Prefix => New_Reference_To (Ptyp, Loc),
                      Attribute_Name => Name_Last))))));
@@ -2283,6 +2308,17 @@ package body Exp_Attr is
       when Attribute_Machine =>
          Expand_Fpt_Attribute_R (N);
 
+      ----------------------
+      -- Machine_Rounding --
+      ----------------------
+
+      --  Transforms 'Machine_Rounding into a call to the floating-point
+      --  attribute function Machine_Rounding in Fat_xxx (where xxx is the root
+      --  type).
+
+      when Attribute_Machine_Rounding =>
+         Expand_Fpt_Attribute_R (N);
+
       ------------------
       -- Machine_Size --
       ------------------
@@ -2425,7 +2461,7 @@ package body Exp_Attr is
 
          end if;
 
-         Analyze_And_Resolve (N, Btyp, All_Checks);
+         Analyze_And_Resolve (N, Btyp, Suppress => All_Checks);
       end Mod_Case;
 
       -----------
@@ -3211,7 +3247,7 @@ package body Exp_Attr is
             Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
             return;
 
-         --  For x'Size applied to an object of a class-wide type, transform
+         --  For X'Size applied to an object of a class-wide type, transform
          --  X'Size into a call to the primitive operation _Size applied to X.
 
          elsif Is_Class_Wide_Type (Ptyp) then
@@ -3268,8 +3304,8 @@ package body Exp_Attr is
          else
             Apply_Universal_Integer_Attribute_Checks (N);
 
-            --  If we have Size applied to a formal parameter, that is a
-            --  packed array subtype, then apply size to the actual subtype.
+            --  If Size is applied to a formal parameter that is of a packed
+            --  array subtype, then apply Size to the actual subtype.
 
             if Is_Entity_Name (Pref)
               and then Is_Formal (Entity (Pref))
@@ -3284,6 +3320,20 @@ package body Exp_Attr is
                Analyze_And_Resolve (N, Typ);
             end if;
 
+            --  If Size is applied to a dereference of an access to
+            --  unconstrained packed array, GIGI needs to see its
+            --  unconstrained nominal type, but also a hint to the actual
+            --  constrained type.
+
+            if Nkind (Pref) = N_Explicit_Dereference
+              and then Is_Array_Type (Etype (Pref))
+              and then not Is_Constrained (Etype (Pref))
+              and then Is_Packed (Etype (Pref))
+            then
+               Set_Actual_Designated_Subtype (Pref,
+                 Get_Actual_Subtype (Pref));
+            end if;
+
             return;
          end if;
 
@@ -3590,7 +3640,28 @@ package body Exp_Attr is
 
       when Attribute_Terminated => Terminated :
       begin
-         if Restricted_Profile then
+         --  The prefix of Terminated is of a task interface class-wide type.
+         --  Generate:
+
+         --    terminated (Pref._disp_get_task_id);
+
+         if Ada_Version >= Ada_05
+           and then Ekind (Etype (Pref)) = E_Class_Wide_Type
+           and then Is_Interface      (Etype (Pref))
+           and then Is_Task_Interface (Etype (Pref))
+         then
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name =>
+                  New_Reference_To (RTE (RE_Terminated), Loc),
+                Parameter_Associations => New_List (
+                  Make_Selected_Component (Loc,
+                    Prefix =>
+                      New_Copy_Tree (Pref),
+                    Selector_Name =>
+                      Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
+
+         elsif Restricted_Profile then
             Rewrite (N,
               Build_Call_With_Task (Pref, RTE (RE_Restricted_Terminated)));
 
@@ -3641,7 +3712,26 @@ package body Exp_Attr is
       ----------------------
 
       when Attribute_Unchecked_Access =>
-         Expand_Access_To_Type (N);
+
+         --  Ada 2005 (AI-251): If the designated type is an interface, then
+         --  rewrite the referenced object as a conversion to force the
+         --  displacement of the pointer to the secondary dispatch table.
+
+         if Is_Interface (Directly_Designated_Type (Btyp)) then
+            declare
+               Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
+               Conversion : Node_Id;
+            begin
+               Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
+               Rewrite (N, Conversion);
+               Analyze_And_Resolve (N, Typ);
+            end;
+
+         --  Otherwise this is like normal Access without a check
+
+         else
+            Expand_Access_To_Type (N);
+         end if;
 
       -----------------
       -- UET_Address --
@@ -3687,7 +3777,26 @@ package body Exp_Attr is
       -------------------------
 
       when Attribute_Unrestricted_Access =>
-         Expand_Access_To_Type (N);
+
+         --  Ada 2005 (AI-251): If the designated type is an interface, then
+         --  rewrite the referenced object as a conversion to force the
+         --  displacement of the pointer to the secondary dispatch table.
+
+         if Is_Interface (Directly_Designated_Type (Btyp)) then
+            declare
+               Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
+               Conversion : Node_Id;
+            begin
+               Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
+               Rewrite (N, Conversion);
+               Analyze_And_Resolve (N, Typ);
+            end;
+
+         --  Otherwise this is like Access without a check
+
+         else
+            Expand_Access_To_Type (N);
+         end if;
 
       ---------------
       -- VADS_Size --
@@ -3824,43 +3933,50 @@ package body Exp_Attr is
 
          if Is_Floating_Point_Type (Ptyp) then
             declare
-               Rtp : constant Entity_Id := Root_Type (Etype (Pref));
+               Pkg : RE_Id;
+               Ftp : Entity_Id;
 
             begin
                --  For vax fpt types, call appropriate routine in special vax
                --  floating point unit. We do not have to worry about loads in
                --  this case, since these types have no signalling NaN's.
 
-               if Vax_Float (Rtp) then
+               if Vax_Float (Btyp) then
                   Expand_Vax_Valid (N);
 
-               --  If the floating-point object might be unaligned, we need
-               --  to call the special routine Unaligned_Valid, which makes
-               --  the needed copy, being careful not to load the value into
-               --  any floating-point register. The argument in this case is
-               --  obj'Address (see Unchecked_Valid routine in s-fatgen.ads).
+               --  Non VAX float case
 
-               elsif Is_Possibly_Unaligned_Object (Pref) then
-                  Set_Attribute_Name (N, Name_Unaligned_Valid);
-                  Expand_Fpt_Attribute
-                    (N, Rtp, Name_Unaligned_Valid,
-                     New_List (
-                       Make_Attribute_Reference (Loc,
-                         Prefix         => Relocate_Node (Pref),
-                         Attribute_Name => Name_Address)));
+               else
+                  Find_Fat_Info (Etype (Pref), Ftp, Pkg);
+
+                  --  If the floating-point object might be unaligned, we need
+                  --  to call the special routine Unaligned_Valid, which makes
+                  --  the needed copy, being careful not to load the value into
+                  --  any floating-point register. The argument in this case is
+                  --  obj'Address (see Unchecked_Valid routine in Fat_Gen).
+
+                  if Is_Possibly_Unaligned_Object (Pref) then
+                     Set_Attribute_Name (N, Name_Unaligned_Valid);
+                     Expand_Fpt_Attribute
+                       (N, Pkg, Name_Unaligned_Valid,
+                        New_List (
+                          Make_Attribute_Reference (Loc,
+                            Prefix => Relocate_Node (Pref),
+                            Attribute_Name => Name_Address)));
 
-               --  In the normal case where we are sure the object is aligned,
-               --  we generate a call to Valid, and the argument in this case
-               --  is obj'Unrestricted_Access (after converting obj to the
-               --  right floating-point type).
+                  --  In the normal case where we are sure the object is
+                  --  aligned, we generate a call to Valid, and the argument in
+                  --  this case is obj'Unrestricted_Access (after converting
+                  --  obj to the right floating-point type).
 
-               else
-                  Expand_Fpt_Attribute
-                    (N, Rtp, Name_Valid,
-                     New_List (
-                       Make_Attribute_Reference (Loc,
-                         Prefix         => Unchecked_Convert_To (Rtp, Pref),
-                         Attribute_Name => Name_Unrestricted_Access)));
+                  else
+                     Expand_Fpt_Attribute
+                       (N, Pkg, Name_Valid,
+                        New_List (
+                          Make_Attribute_Reference (Loc,
+                            Prefix => Unchecked_Convert_To (Ftp, Pref),
+                            Attribute_Name => Name_Unrestricted_Access)));
+                  end if;
                end if;
 
                --  One more task, we still need a range check. Required
@@ -4488,6 +4604,78 @@ package body Exp_Attr is
           Reason => CE_Overflow_Check_Failed));
    end Expand_Pred_Succ;
 
+   -------------------
+   -- Find_Fat_Info --
+   -------------------
+
+   procedure Find_Fat_Info
+     (T        : Entity_Id;
+      Fat_Type : out Entity_Id;
+      Fat_Pkg  : out RE_Id)
+   is
+      Btyp : constant Entity_Id := Base_Type (T);
+      Rtyp : constant Entity_Id := Root_Type (T);
+      Digs : constant Nat       := UI_To_Int (Digits_Value (Btyp));
+
+   begin
+      --  If the base type is VAX float, then get appropriate VAX float type
+
+      if Vax_Float (Btyp) then
+         case Digs is
+            when 6 =>
+               Fat_Type := RTE (RE_Fat_VAX_F);
+               Fat_Pkg  := RE_Attr_VAX_F_Float;
+
+            when 9 =>
+               Fat_Type := RTE (RE_Fat_VAX_D);
+               Fat_Pkg  := RE_Attr_VAX_D_Float;
+
+            when 15 =>
+               Fat_Type := RTE (RE_Fat_VAX_G);
+               Fat_Pkg  := RE_Attr_VAX_G_Float;
+
+            when others =>
+               raise Program_Error;
+         end case;
+
+      --  If root type is VAX float, this is the case where the library has
+      --  been recompiled in VAX float mode, and we have an IEEE float type.
+      --  This is when we use the special IEEE Fat packages.
+
+      elsif Vax_Float (Rtyp) then
+         case Digs is
+            when 6 =>
+               Fat_Type := RTE (RE_Fat_IEEE_Short);
+               Fat_Pkg  := RE_Attr_IEEE_Short;
+
+            when 15 =>
+               Fat_Type := RTE (RE_Fat_IEEE_Long);
+               Fat_Pkg  := RE_Attr_IEEE_Long;
+
+            when others =>
+               raise Program_Error;
+         end case;
+
+      --  If neither the base type nor the root type is VAX_Float then VAX
+      --  float is out of the picture, and we can just use the root type.
+
+      else
+         Fat_Type := Rtyp;
+
+         if Fat_Type = Standard_Short_Float then
+            Fat_Pkg := RE_Attr_Short_Float;
+         elsif Fat_Type = Standard_Float then
+            Fat_Pkg := RE_Attr_Float;
+         elsif Fat_Type = Standard_Long_Float then
+            Fat_Pkg := RE_Attr_Long_Float;
+         elsif Fat_Type = Standard_Long_Long_Float then
+            Fat_Pkg := RE_Attr_Long_Long_Float;
+         else
+            raise Program_Error;
+         end if;
+      end if;
+   end Find_Fat_Info;
+
    ----------------------------
    -- Find_Stream_Subprogram --
    ----------------------------
diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb
index 2bdb9363bc3..9d4b5042d69 100644
--- a/gcc/ada/s-fatgen.adb
+++ b/gcc/ada/s-fatgen.adb
@@ -99,10 +99,8 @@ package body System.Fat_Gen is
    begin
       if Towards = X then
          return X;
-
       elsif Towards > X then
          return Succ (X);
-
       else
          return Pred (X);
       end if;
@@ -114,14 +112,11 @@ package body System.Fat_Gen is
 
    function Ceiling (X : T) return T is
       XT : constant T := Truncation (X);
-
    begin
       if X <= 0.0 then
          return XT;
-
       elsif X = XT then
          return X;
-
       else
          return XT + 1.0;
       end if;
@@ -175,7 +170,7 @@ package body System.Fat_Gen is
          --  T'Machine_Emin - T'Machine_Mantissa, which would preserve
          --  monotonicity of the exponent function ???
 
-      --  Check for infinities, transfinites, whatnot.
+      --  Check for infinities, transfinites, whatnot
 
       elsif X > T'Safe_Last then
          Frac := Invrad;
@@ -193,7 +188,7 @@ package body System.Fat_Gen is
             Ax : T  := abs X;
             Ex : UI := 0;
 
-         --  Ax * Rad ** Ex is invariant.
+         --  Ax * Rad ** Ex is invariant
 
          begin
             if Ax >= 1.0 then
@@ -256,7 +251,6 @@ package body System.Fat_Gen is
    function Exponent (X : T) return UI is
       X_Frac : T;
       X_Exp  : UI;
-
    begin
       Decompose (X, X_Frac, X_Exp);
       return X_Exp;
@@ -268,14 +262,11 @@ package body System.Fat_Gen is
 
    function Floor (X : T) return T is
       XT : constant T := Truncation (X);
-
    begin
       if X >= 0.0 then
          return XT;
-
       elsif XT = X then
          return X;
-
       else
          return XT - 1.0;
       end if;
@@ -288,7 +279,6 @@ package body System.Fat_Gen is
    function Fraction (X : T) return T is
       X_Frac : T;
       X_Exp  : UI;
-
    begin
       Decompose (X, X_Frac, X_Exp);
       return X_Frac;
@@ -366,6 +356,38 @@ package body System.Fat_Gen is
       return Temp;
    end Machine;
 
+   ----------------------
+   -- Machine_Rounding --
+   ----------------------
+
+   --  For now, the implementation is identical to that of Rounding, which is
+   --  a permissible behavior, but is not the most efficient possible approach.
+
+   function Machine_Rounding (X : T) return T is
+      Result : T;
+      Tail   : T;
+
+   begin
+      Result := Truncation (abs X);
+      Tail   := abs X - Result;
+
+      if Tail >= 0.5  then
+         Result := Result + 1.0;
+      end if;
+
+      if X > 0.0 then
+         return Result;
+
+      elsif X < 0.0 then
+         return -Result;
+
+      --  For zero case, make sure sign of zero is preserved
+
+      else
+         return X;
+      end if;
+   end Machine_Rounding;
+
    -----------
    -- Model --
    -----------
@@ -542,7 +564,7 @@ package body System.Fat_Gen is
          return X;
       end if;
 
-      --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n).
+      --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n)
 
       declare
          Y  : T  := X;
@@ -587,6 +609,7 @@ package body System.Fat_Gen is
                end if;
 
                --  0 <= Ex < Log_Power (N)
+
             end loop;
 
             --  Ex = 0
@@ -652,7 +675,7 @@ package body System.Fat_Gen is
 
    --  The basic approach is to compute
 
-   --    T'Machine (RM1 + N) - RM1.
+   --    T'Machine (RM1 + N) - RM1
 
    --  where N >= 0.0 and RM1 = radix ** (mantissa - 1)
 
@@ -693,7 +716,6 @@ package body System.Fat_Gen is
             return X;
          end if;
       end if;
-
    end Truncation;
 
    -----------------------
@@ -727,13 +749,16 @@ package body System.Fat_Gen is
       else
          return X;
       end if;
-
    end Unbiased_Rounding;
 
    -----------
    -- Valid --
    -----------
 
+   --  Note: this routine does not work for VAX float. We compensate for this
+   --  in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
+   --  than the corresponding instantiation of this function.
+
    function Valid (X : access T) return Boolean is
 
       IEEE_Emin : constant Integer := T'Machine_Emin - 1;
@@ -744,17 +769,17 @@ package body System.Fat_Gen is
       subtype IEEE_Exponent_Range is
         Integer range IEEE_Emin - 1 .. IEEE_Emax + 1;
 
-      --  The implementation of this floating point attribute uses
-      --  a representation type Float_Rep that allows direct access to
-      --  the exponent and mantissa parts of a floating point number.
+      --  The implementation of this floating point attribute uses a
+      --  representation type Float_Rep that allows direct access to the
+      --  exponent and mantissa parts of a floating point number.
 
       --  The Float_Rep type is an array of Float_Word elements. This
-      --  representation is chosen to make it possible to size the
-      --  type based on a generic parameter. Since the array size is
-      --  known at compile-time, efficient code can still be generated.
-      --  The size of Float_Word elements should be large enough to allow
-      --  accessing the exponent in one read, but small enough so that all
-      --  floating point object sizes are a multiple of the Float_Word'Size.
+      --  representation is chosen to make it possible to size the type based
+      --  on a generic parameter. Since the array size is known at compile
+      --  time, efficient code can still be generated. The size of Float_Word
+      --  elements should be large enough to allow accessing the exponent in
+      --  one read, but small enough so that all floating point object sizes
+      --  are a multiple of the Float_Word'Size.
 
       --  The following conditions must be met for all possible
       --  instantiations of the attributes package:
@@ -764,9 +789,9 @@ package body System.Fat_Gen is
       --    - The exponent and sign are completely contained in a single
       --      component of Float_Rep, named Most_Significant_Word (MSW).
 
-      --    - The sign occupies the most significant bit of the MSW
-      --      and the exponent is in the following bits.
-      --      Unused bits (if any) are in the least significant part.
+      --    - The sign occupies the most significant bit of the MSW and the
+      --      exponent is in the following bits. Unused bits (if any) are in
+      --      the least significant part.
 
       type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
       type Rep_Index is range 0 .. 7;
@@ -775,12 +800,12 @@ package body System.Fat_Gen is
          (T'Size + Float_Word'Size - 1) / Float_Word'Size;
       Rep_Last  : constant Rep_Index := Rep_Index'Min
         (Rep_Index (Rep_Words - 1), (T'Mantissa + 16) / Float_Word'Size);
-      --  Determine the number of Float_Words needed for representing
-      --  the entire floating-poinit value. Do not take into account
-      --  excessive padding, as occurs on IA-64 where 80 bits floats get
-      --  padded to 128 bits. In general, the exponent field cannot
-      --  be larger than 15 bits, even for 128-bit floating-poin t types,
-      --  so the final format size won't be larger than T'Mantissa + 16.
+      --  Determine the number of Float_Words needed for representing the
+      --  entire floating-point value. Do not take into account excessive
+      --  padding, as occurs on IA-64 where 80 bits floats get padded to 128
+      --  bits. In general, the exponent field cannot be larger than 15 bits,
+      --  even for 128-bit floating-poin t types, so the final format size
+      --  won't be larger than T'Mantissa + 16.
 
       type Float_Rep is
          array (Rep_Index range 0 .. Rep_Index (Rep_Words - 1)) of Float_Word;
@@ -794,26 +819,26 @@ package body System.Fat_Gen is
 
       Most_Significant_Word : constant Rep_Index :=
                                 Rep_Last * Standard'Default_Bit_Order;
-      --  Finding the location of the Exponent_Word is a bit tricky.
-      --  In general we assume Word_Order = Bit_Order.
-      --  This expression needs to be refined for VMS.
+      --  Finding the location of the Exponent_Word is a bit tricky. In general
+      --  we assume Word_Order = Bit_Order. This expression needs to be refined
+      --  for VMS.
 
       Exponent_Factor : constant Float_Word :=
                           2**(Float_Word'Size - 1) /
                             Float_Word (IEEE_Emax - IEEE_Emin + 3) *
                               Boolean'Pos (Most_Significant_Word /= 2) +
                                 Boolean'Pos (Most_Significant_Word = 2);
-      --  Factor that the extracted exponent needs to be divided by
-      --  to be in range 0 .. IEEE_Emax - IEEE_Emin + 2.
-      --  Special kludge: Exponent_Factor is 1 for x86/IA64 double extended
-      --  as GCC adds unused bits to the type.
+      --  Factor that the extracted exponent needs to be divided by to be in
+      --  range 0 .. IEEE_Emax - IEEE_Emin + 2. Special kludge: Exponent_Factor
+      --  is 1 for x86/IA64 double extended as GCC adds unused bits to the
+      --  type.
 
       Exponent_Mask : constant Float_Word :=
                         Float_Word (IEEE_Emax - IEEE_Emin + 2) *
                           Exponent_Factor;
-      --  Value needed to mask out the exponent field.
-      --  This assumes that the range IEEE_Emin - 1 .. IEEE_Emax + 1
-      --  contains 2**N values, for some N in Natural.
+      --  Value needed to mask out the exponent field. This assumes that the
+      --  range IEEE_Emin - 1 .. IEEE_Emax + contains 2**N values, for some N
+      --  in Natural.
 
       function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
 
@@ -834,8 +859,8 @@ package body System.Fat_Gen is
              Integer ((R (Most_Significant_Word) and Exponent_Mask) /
                                                         Exponent_Factor)
                - IEEE_Bias;
-      --  Mask/Shift T to only get bits from the exponent
-      --  Then convert biased value to integer value.
+      --  Mask/Shift T to only get bits from the exponent. Then convert biased
+      --  value to integer value.
 
       SR : Float_Rep;
       --  Float_Rep representation of significant of X.all
@@ -843,8 +868,8 @@ package body System.Fat_Gen is
    begin
       if T'Denorm then
 
-         --  All denormalized numbers are valid, so only invalid numbers
-         --  are overflows and NaN's, both with exponent = Emax + 1.
+         --  All denormalized numbers are valid, so only invalid numbers are
+         --  overflows and NaN's, both with exponent = Emax + 1.
 
          return E /= IEEE_Emax + 1;
 
diff --git a/gcc/ada/s-fatgen.ads b/gcc/ada/s-fatgen.ads
index c1bc8204058..83b6f064461 100644
--- a/gcc/ada/s-fatgen.ads
+++ b/gcc/ada/s-fatgen.ads
@@ -71,6 +71,8 @@ package System.Fat_Gen is
 
    function Machine           (X : T)                       return T;
 
+   function Machine_Rounding  (X : T)                       return T;
+
    function Model             (X : T)                       return T;
 
    function Pred              (X : T)                       return T;
@@ -95,6 +97,8 @@ package System.Fat_Gen is
    --  register, and the whole point of 'Valid is to prevent exceptions.
    --  Note that the object of type T must have the natural alignment
    --  for type T. See Unaligned_Valid for further discussion.
+   --
+   --  Note: this routine does not work for Vax_Float ???
 
    function Unaligned_Valid (A : System.Address) return Boolean;
    --  This version of Valid is used if the floating-point value to
@@ -112,11 +116,16 @@ package System.Fat_Gen is
    --  not require strict alignment (e.g. the ia32/x86), since on a
    --  target not requiring strict alignment, it is fine to pass a
    --  non-aligned value to the standard Valid routine.
+   --
+   --  Note: this routine does not work for Vax_Float ???
 
 private
    pragma Inline (Machine);
    pragma Inline (Model);
-   pragma Inline_Always (Valid);
-   pragma Inline_Always (Unaligned_Valid);
+
+   --  Note: previously the validity checking subprograms (Unaligned_Valid and
+   --  Valid) were also inlined, but this was changed since there were some
+   --  problems with this inlining in optimized mode, and in any case it seems
+   --  better to avoid this inlining (space and robustness considerations).
 
 end System.Fat_Gen;
diff --git a/gcc/ada/s-vaflop-vms-alpha.adb b/gcc/ada/s-vaflop-vms-alpha.adb
index 45a39bba08b..5ab772d4477 100644
--- a/gcc/ada/s-vaflop-vms-alpha.adb
+++ b/gcc/ada/s-vaflop-vms-alpha.adb
@@ -626,7 +626,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_D (Arg : D) return Boolean is
-      Val : T := G_To_T (D_To_G (Arg));
+      Val : constant T := G_To_T (D_To_G (Arg));
    begin
       return Val'Valid;
    end Valid_D;
@@ -639,7 +639,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_F (Arg : F) return Boolean is
-      Val : S := F_To_S (Arg);
+      Val : constant S := F_To_S (Arg);
    begin
       return Val'Valid;
    end Valid_F;
@@ -652,7 +652,7 @@ package body System.Vax_Float_Operations is
    --  accurate, but is good enough in practice.
 
    function Valid_G (Arg : G) return Boolean is
-      Val : T := G_To_T (Arg);
+      Val : constant T := G_To_T (Arg);
    begin
       return Val'Valid;
    end Valid_G;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1306779d12a..e0c05fd62ae 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -492,9 +492,16 @@ package body Sem_Attr is
          --  accesses are allowed (references to the current type instance).
 
          if Is_Entity_Name (P) then
-            Scop := Current_Scope;
             Typ := Entity (P);
 
+            --  The reference may appear in an aggregate that has been expanded
+            --  into a loop. Locate scope of type definition, if any.
+
+            Scop := Current_Scope;
+            while Ekind (Scop) = E_Loop loop
+               Scop := Scope (Scop);
+            end loop;
+
             if Is_Type (Typ) then
 
                --  OK if we are within the scope of a limited type
@@ -516,6 +523,7 @@ package body Sem_Attr is
                      loop
                         Q := Parent (Q);
                      end loop;
+
                      if Present (Q) then
                         Set_Has_Per_Object_Constraint (
                           Defining_Identifier (Q), True);
@@ -585,11 +593,9 @@ package body Sem_Attr is
             declare
                Index : Interp_Index;
                It    : Interp;
-
             begin
                Set_Etype (N, Any_Type);
                Get_First_Interp (P, Index, It);
-
                while Present (It.Typ) loop
                   Acc_Type := Build_Access_Object_Type (It.Typ);
                   Add_One_Interp (N, Acc_Type, Acc_Type);
@@ -1373,13 +1379,27 @@ package body Sem_Attr is
       begin
          Analyze (P);
 
+         --  Ada 2005 (AI-345): Attribute 'Terminated can be applied to
+         --  task interface class-wide types.
+
          if Is_Task_Type (Etype (P))
            or else (Is_Access_Type (Etype (P))
-              and then Is_Task_Type (Designated_Type (Etype (P))))
+                      and then Is_Task_Type (Designated_Type (Etype (P))))
+           or else (Ada_Version >= Ada_05
+                      and then Ekind (Etype (P)) = E_Class_Wide_Type
+                      and then Is_Interface (Etype (P))
+                      and then Is_Task_Interface (Etype (P)))
          then
             Resolve (P);
+
          else
-            Error_Attr ("prefix of % attribute must be a task", P);
+            if Ada_Version >= Ada_05 then
+               Error_Attr ("prefix of % attribute must be a task or a task "
+                           & "interface class-wide object", P);
+
+            else
+               Error_Attr ("prefix of % attribute must be a task", P);
+            end if;
          end if;
       end Check_Task_Prefix;
 
@@ -2793,16 +2813,28 @@ package body Sem_Attr is
          if Etype (P) =  Standard_Exception_Type then
             Set_Etype (N, RTE (RE_Exception_Id));
 
+         --  Ada 2005 (AI-345): Attribute 'Identity may be applied to
+         --  task interface class-wide types.
+
          elsif Is_Task_Type (Etype (P))
            or else (Is_Access_Type (Etype (P))
-              and then Is_Task_Type (Designated_Type (Etype (P))))
+                      and then Is_Task_Type (Designated_Type (Etype (P))))
+           or else (Ada_Version >= Ada_05
+                      and then Ekind (Etype (P)) = E_Class_Wide_Type
+                      and then Is_Interface (Etype (P))
+                      and then Is_Task_Interface (Etype (P)))
          then
             Resolve (P);
             Set_Etype (N, RTE (RO_AT_Task_Id));
 
          else
-            Error_Attr ("prefix of % attribute must be a task or an "
-              & "exception", P);
+            if Ada_Version >= Ada_05 then
+               Error_Attr ("prefix of % attribute must be an exception, a "
+                         & "task or a task interface class-wide object", P);
+            else
+               Error_Attr ("prefix of % attribute must be a task or an "
+                         & "exception", P);
+            end if;
          end if;
 
       -----------
@@ -2962,6 +2994,15 @@ package body Sem_Attr is
          Check_E0;
          Set_Etype (N, Universal_Integer);
 
+      ----------------------
+      -- Machine_Rounding --
+      ----------------------
+
+      when Attribute_Machine_Rounding =>
+         Check_Floating_Point_Type_1;
+         Set_Etype (N, P_Base_Type);
+         Resolve (E1, P_Base_Type);
+
       --------------------
       -- Machine_Rounds --
       --------------------
@@ -5481,6 +5522,20 @@ package body Sem_Attr is
             Fold_Uint (N, Uint_2, True);
          end if;
 
+      ----------------------
+      -- Machine_Rounding --
+      ----------------------
+
+      --  Note: for the folding case, it is fine to treat Machine_Rounding
+      --  exactly the same way as Rounding, since this is one of the allowed
+      --  behaviors, and performance is not an issue here. It might be a bit
+      --  better to give the same result as it would give at run-time, even
+      --  though the non-determinism is certainly permitted.
+
+      when Attribute_Machine_Rounding =>
+         Fold_Ureal (N,
+           Eval_Fat.Rounding (P_Root_Type, Expr_Value_R (E1)), Static);
+
       --------------------
       -- Machine_Rounds --
       --------------------
@@ -6243,7 +6298,6 @@ package body Sem_Attr is
          end if;
 
          Rewrite (N, New_Occurrence_Of (RTE (Id), Loc));
-
       end Type_Class;
 
       -----------------------
@@ -7685,12 +7739,19 @@ package body Sem_Attr is
          return True;
       end if;
 
-      if Nam = TSS_Stream_Input then
-         return Ada_Version >= Ada_05
-           and then Stream_Attribute_Available (Etyp, TSS_Stream_Read);
-      elsif Nam = TSS_Stream_Output then
-         return Ada_Version >= Ada_05
-           and then Stream_Attribute_Available (Etyp, TSS_Stream_Write);
+      --  In Ada 2005, Input can invoke Read, and Output can invoke Write
+
+      if Nam = TSS_Stream_Input
+        and then Ada_Version >= Ada_05
+        and then Stream_Attribute_Available (Etyp, TSS_Stream_Read)
+      then
+         return True;
+
+      elsif Nam = TSS_Stream_Output
+        and then Ada_Version >= Ada_05
+        and then Stream_Attribute_Available (Etyp, TSS_Stream_Write)
+      then
+         return True;
       end if;
 
       --  Case of Read and Write: check for attribute definition clause that
diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h
index 0ff742e816d..7b0c2ee5d0a 100644
--- a/gcc/ada/snames.h
+++ b/gcc/ada/snames.h
@@ -95,91 +95,92 @@ extern unsigned char Get_Attribute_Id (int);
 #define  Attr_Machine_Mantissa              47
 #define  Attr_Machine_Overflows             48
 #define  Attr_Machine_Radix                 49
-#define  Attr_Machine_Rounds                50
-#define  Attr_Machine_Size                  51
-#define  Attr_Mantissa                      52
-#define  Attr_Max_Size_In_Storage_Elements  53
-#define  Attr_Maximum_Alignment             54
-#define  Attr_Mechanism_Code                55
-#define  Attr_Mod                           56
-#define  Attr_Model_Emin                    57
-#define  Attr_Model_Epsilon                 58
-#define  Attr_Model_Mantissa                59
-#define  Attr_Model_Small                   60
-#define  Attr_Modulus                       61
-#define  Attr_Null_Parameter                62
-#define  Attr_Object_Size                   63
-#define  Attr_Partition_ID                  64
-#define  Attr_Passed_By_Reference           65
-#define  Attr_Pool_Address                  66
-#define  Attr_Pos                           67
-#define  Attr_Position                      68
-#define  Attr_Range                         69
-#define  Attr_Range_Length                  70
-#define  Attr_Round                         71
-#define  Attr_Safe_Emax                     72
-#define  Attr_Safe_First                    73
-#define  Attr_Safe_Large                    74
-#define  Attr_Safe_Last                     75
-#define  Attr_Safe_Small                    76
-#define  Attr_Scale                         77
-#define  Attr_Scaling                       78
-#define  Attr_Signed_Zeros                  79
-#define  Attr_Size                          80
-#define  Attr_Small                         81
-#define  Attr_Storage_Size                  82
-#define  Attr_Storage_Unit                  83
-#define  Attr_Stream_Size                   84
-#define  Attr_Tag                           85
-#define  Attr_Target_Name                   86
-#define  Attr_Terminated                    87
-#define  Attr_To_Address                    88
-#define  Attr_Type_Class                    89
-#define  Attr_UET_Address                   90
-#define  Attr_Unbiased_Rounding             91
-#define  Attr_Unchecked_Access              92
-#define  Attr_Unconstrained_Array           93
-#define  Attr_Universal_Literal_String      94
-#define  Attr_Unrestricted_Access           95
-#define  Attr_VADS_Size                     96
-#define  Attr_Val                           97
-#define  Attr_Valid                         98
-#define  Attr_Value_Size                    99
-#define  Attr_Version                       100
-#define  Attr_Wchar_T_Size                  101
-#define  Attr_Wide_Wide_Width               102
-#define  Attr_Wide_Width                    103
-#define  Attr_Width                         104
-#define  Attr_Word_Size                     105
-#define  Attr_Adjacent                      106
-#define  Attr_Ceiling                       107
-#define  Attr_Copy_Sign                     108
-#define  Attr_Floor                         109
-#define  Attr_Fraction                      110
-#define  Attr_Image                         111
-#define  Attr_Input                         112
-#define  Attr_Machine                       113
-#define  Attr_Max                           114
-#define  Attr_Min                           115
-#define  Attr_Model                         116
-#define  Attr_Pred                          117
-#define  Attr_Remainder                     118
-#define  Attr_Rounding                      119
-#define  Attr_Succ                          120
-#define  Attr_Truncation                    121
-#define  Attr_Value                         122
-#define  Attr_Wide_Image                    123
-#define  Attr_Wide_Wide_Image               124
-#define  Attr_Wide_Value                    125
-#define  Attr_Wide_Wide_Value               126
-#define  Attr_Output                        127
-#define  Attr_Read                          128
-#define  Attr_Write                         129
-#define  Attr_Elab_Body                     130
-#define  Attr_Elab_Spec                     131
-#define  Attr_Storage_Pool                  132
-#define  Attr_Base                          133
-#define  Attr_Class                         134
+#define  Attr_Machine_Rounding              50
+#define  Attr_Machine_Rounds                51
+#define  Attr_Machine_Size                  52
+#define  Attr_Mantissa                      53
+#define  Attr_Max_Size_In_Storage_Elements  54
+#define  Attr_Maximum_Alignment             55
+#define  Attr_Mechanism_Code                56
+#define  Attr_Mod                           57
+#define  Attr_Model_Emin                    58
+#define  Attr_Model_Epsilon                 59
+#define  Attr_Model_Mantissa                60
+#define  Attr_Model_Small                   61
+#define  Attr_Modulus                       62
+#define  Attr_Null_Parameter                63
+#define  Attr_Object_Size                   64
+#define  Attr_Partition_ID                  65
+#define  Attr_Passed_By_Reference           66
+#define  Attr_Pool_Address                  67
+#define  Attr_Pos                           68
+#define  Attr_Position                      69
+#define  Attr_Range                         70
+#define  Attr_Range_Length                  71
+#define  Attr_Round                         72
+#define  Attr_Safe_Emax                     73
+#define  Attr_Safe_First                    74
+#define  Attr_Safe_Large                    75
+#define  Attr_Safe_Last                     76
+#define  Attr_Safe_Small                    77
+#define  Attr_Scale                         78
+#define  Attr_Scaling                       79
+#define  Attr_Signed_Zeros                  80
+#define  Attr_Size                          81
+#define  Attr_Small                         82
+#define  Attr_Storage_Size                  83
+#define  Attr_Storage_Unit                  84
+#define  Attr_Stream_Size                   85
+#define  Attr_Tag                           86
+#define  Attr_Target_Name                   87
+#define  Attr_Terminated                    88
+#define  Attr_To_Address                    89
+#define  Attr_Type_Class                    90
+#define  Attr_UET_Address                   91
+#define  Attr_Unbiased_Rounding             92
+#define  Attr_Unchecked_Access              93
+#define  Attr_Unconstrained_Array           94
+#define  Attr_Universal_Literal_String      95
+#define  Attr_Unrestricted_Access           96
+#define  Attr_VADS_Size                     97
+#define  Attr_Val                           98
+#define  Attr_Valid                         99
+#define  Attr_Value_Size                    100
+#define  Attr_Version                       101
+#define  Attr_Wchar_T_Size                  102
+#define  Attr_Wide_Wide_Width               103
+#define  Attr_Wide_Width                    104
+#define  Attr_Width                         105
+#define  Attr_Word_Size                     106
+#define  Attr_Adjacent                      107
+#define  Attr_Ceiling                       108
+#define  Attr_Copy_Sign                     109
+#define  Attr_Floor                         110
+#define  Attr_Fraction                      111
+#define  Attr_Image                         112
+#define  Attr_Input                         113
+#define  Attr_Machine                       114
+#define  Attr_Max                           115
+#define  Attr_Min                           116
+#define  Attr_Model                         117
+#define  Attr_Pred                          118
+#define  Attr_Remainder                     119
+#define  Attr_Rounding                      120
+#define  Attr_Succ                          121
+#define  Attr_Truncation                    122
+#define  Attr_Value                         123
+#define  Attr_Wide_Image                    124
+#define  Attr_Wide_Wide_Image               125
+#define  Attr_Wide_Value                    126
+#define  Attr_Wide_Wide_Value               127
+#define  Attr_Output                        128
+#define  Attr_Read                          129
+#define  Attr_Write                         130
+#define  Attr_Elab_Body                     131
+#define  Attr_Elab_Spec                     132
+#define  Attr_Storage_Pool                  133
+#define  Attr_Base                          134
+#define  Attr_Class                         135
 
 /* Define the numeric values for the conventions.  */