[multiple changes]

2009-11-30  Vincent Celier  <celier@adacore.com>

	* gnatlink.adb (Process_Args): Call Executable_Name on argument of -o
	with Only_If_No_Suffix set to True.
	* osint.adb (Executable_Name): Do not add executable suffix if there is
	already a suffix and Only_If_No_Suffix is True.
	* osint.ads (Executable_Name): New Boolean parameter Only_If_No_Suffix,
	defaulted to False.

2009-11-30  Javier Miranda  <miranda@adacore.com>

	* exp_atag.adb (Build_TSD): Change argument name because the actual is
	now the address of a tag (instead of the tag). Update implementation
	accordingly.
	(Build_CW_Membership): New implementation. Converted into a procedure
	because it has an additional out mode parameter. Its implementation has
	been rewritten to improve the generated code but also to facilitate
	referencing the relocated object node in the caller.
	* exp_atag.ads (Build_CW_Membership): Update profile and documentation.
	* sinfo.ads (N_SCIL_Membership_Test) New_Node.
	(SCIL_Tag_Value): New field of N_SCIL_Membership_Test nodes.
	(Is_Syntactic_Field): Add entry of new node.
	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
	* sinfo.adb (SCIL_Related_Node, SCIL_Entity): Update assertions to
	handle N_SCIL_Membership_Test nodes.
	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
	* sem.adb (Analyze): Add null management for new node.
	* sem_scil.adb (Find_SCIL_Node): Add null management for new node.
	(Check_SCIL_Node): Add checks of N_SCIL_Membership_Test nodes.
	* exp_ch4.adb (Tagged_Membership): Change profile from function to
	procedure. Add generation of SCIL node associated with class-wide
	membership test.
	(Expand_N_In): Complete decoration of SCIL nodes.
	* exp_intr.adb (Expand_Dispatching_Constructor_Call): Tune call to
	Build_CW_Membership because its profile has been changed.
	* exp_util.adb (Insert_Actions): Add null management for new node.
	* sprint.adb (Sprint_Node_Actual): Handle new node.
	* gcc-interface/trans.c Add no processing for N_SCIL_Membership_Test
	nodes.
	* gcc-interface/Make-lang.in: Update dependencies.

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* opt.ads: New flags Init_Or_Norm_Scalars_Config,
	Initialize_Scalars_Config, to capture the presence of the corresponding
	pragmas in a configuration file.
	* opt.adb (Register_, Save_, Set_, Restore_Opt_Configuration_Switches):
	handle new flags so that they are restored for each compilation unit.
	* frontend.adb: At the end of compilation, scan the context of the main
	unit to recover occurrences of pragma Initialize_Scalars, to annotate
	the ALI file accordingly.

From-SVN: r154792

gcc/ada/ChangeLog

 2009-11-30  Vincent Celier  <celier@adacore.com>
 
+	* gnatlink.adb (Process_Args): Call Executable_Name on argument of -o
+	with Only_If_No_Suffix set to True.
+	* osint.adb (Executable_Name): Do not add executable suffix if there is
+	already a suffix and Only_If_No_Suffix is True.
+	* osint.ads (Executable_Name): New Boolean parameter Only_If_No_Suffix,
+	defaulted to False.
+
+2009-11-30  Javier Miranda  <miranda@adacore.com>
+
+	* exp_atag.adb (Build_TSD): Change argument name because the actual is
+	now the address of a tag (instead of the tag). Update implementation
+	accordingly.
+	(Build_CW_Membership): New implementation. Converted into a procedure
+	because it has an additional out mode parameter. Its implementation has
+	been rewritten to improve the generated code but also to facilitate
+	referencing the relocated object node in the caller.
+	* exp_atag.ads (Build_CW_Membership): Update profile and documentation.
+	* sinfo.ads (N_SCIL_Membership_Test) New_Node.
+	(SCIL_Tag_Value): New field of N_SCIL_Membership_Test nodes.
+	(Is_Syntactic_Field): Add entry of new node.
+	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
+	* sinfo.adb (SCIL_Related_Node, SCIL_Entity): Update assertions to
+	handle N_SCIL_Membership_Test nodes.
+	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
+	* sem.adb (Analyze): Add null management for new node.
+	* sem_scil.adb (Find_SCIL_Node): Add null management for new node.
+	(Check_SCIL_Node): Add checks of N_SCIL_Membership_Test nodes.
+	* exp_ch4.adb (Tagged_Membership): Change profile from function to
+	procedure. Add generation of SCIL node associated with class-wide
+	membership test.
+	(Expand_N_In): Complete decoration of SCIL nodes.
+	* exp_intr.adb (Expand_Dispatching_Constructor_Call): Tune call to
+	Build_CW_Membership because its profile has been changed.
+	* exp_util.adb (Insert_Actions): Add null management for new node.
+	* sprint.adb (Sprint_Node_Actual): Handle new node.
+	* gcc-interface/trans.c Add no processing for N_SCIL_Membership_Test
+	nodes.
+	* gcc-interface/Make-lang.in: Update dependencies.
+
+2009-11-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* opt.ads: New flags Init_Or_Norm_Scalars_Config,
+	Initialize_Scalars_Config, to capture the presence of the corresponding
+	pragmas in a configuration file.
+	* opt.adb (Register_, Save_, Set_, Restore_Opt_Configuration_Switches):
+	handle new flags so that they are restored for each compilation unit.
+	* frontend.adb: At the end of compilation, scan the context of the main
+	unit to recover occurrences of pragma Initialize_Scalars, to annotate
+	the ALI file accordingly.
+
+2009-11-30  Vincent Celier  <celier@adacore.com>
+
 	* prj-tree.ads: Minor comment updates
 	* prj-tree.adb: Minor reformatting
 

gcc/ada/exp_atag.adb

@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Exp_Util; use Exp_Util;
@@ -53,12 +54,14 @@ package body Exp_Atag is
    --    To_Dispatch_Table_Ptr
    --      (To_Address (Tag_Node) - Tag_Node.Prims_Ptr'Position);
 
-   function Build_TSD (Loc : Source_Ptr; Tag_Node : Node_Id) return Node_Id;
+   function Build_TSD
+     (Loc           : Source_Ptr;
+      Tag_Node_Addr : Node_Id) return Node_Id;
    --  Build code that retrieves the address of the record containing the Type
    --  Specific Data generated by GNAT.
    --
    --  Generate: To_Type_Specific_Data_Ptr
-   --              (To_Addr_Ptr (To_Address (Tag) - Typeinfo_Offset).all);
+   --              (To_Addr_Ptr (Tag_Node_Addr - Typeinfo_Offset).all);
 
    ------------------------------------------------
    -- Build_Common_Dispatching_Select_Statements --
@@ -140,39 +143,90 @@ package body Exp_Atag is
    -- Build_CW_Membership --
    -------------------------
 
-   function Build_CW_Membership
+   procedure Build_CW_Membership
      (Loc          : Source_Ptr;
-      Obj_Tag_Node : Node_Id;
-      Typ_Tag_Node : Node_Id) return Node_Id
+      Obj_Tag_Node : in out Node_Id;
+      Typ_Tag_Node : Node_Id;
+      Related_Nod  : Node_Id;
+      New_Node     : out Node_Id)
    is
-      function Build_Pos return Node_Id;
-      --  Generate TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
+      Tag_Addr : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                         New_Internal_Name ('D'));
+      Obj_TSD  : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                         New_Internal_Name ('D'));
+      Typ_TSD  : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                         New_Internal_Name ('D'));
+      Index    : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                         New_Internal_Name ('D'));
 
-      function Build_Pos return Node_Id is
    begin
-         return
+      --  Generate:
+
+      --    Tag_Addr : constant Tag := Address!(Obj_Tag);
+      --    Obj_TSD  : constant Type_Specific_Data_Ptr
+      --                          := Build_TSD (Tag_Addr);
+      --    Typ_TSD  : constant Type_Specific_Data_Ptr
+      --                          := Build_TSD (Address!(Typ_Tag));
+      --    Index    : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth
+      --    Index > 0 and then Obj_TSD.Tags_Table (Index) = Typ'Tag
+
+      Insert_Action (Related_Nod,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Tag_Addr,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To (RTE (RE_Address), Loc),
+          Expression          => Unchecked_Convert_To
+                                   (RTE (RE_Address), Obj_Tag_Node)));
+
+      --  Unchecked_Convert_To relocates Obj_Tag_Node and therefore we must
+      --  update it.
+
+      Obj_Tag_Node := Expression (Expression (Parent (Tag_Addr)));
+
+      Insert_Action (Related_Nod,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Obj_TSD,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To
+                                   (RTE (RE_Type_Specific_Data_Ptr), Loc),
+          Expression => Build_TSD (Loc, New_Reference_To (Tag_Addr, Loc))));
+
+      Insert_Action (Related_Nod,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Typ_TSD,
+          Constant_Present    => True,
+          Object_Definition   => New_Reference_To
+                                   (RTE (RE_Type_Specific_Data_Ptr), Loc),
+          Expression => Build_TSD (Loc,
+                          Unchecked_Convert_To (RTE (RE_Address),
+                            Typ_Tag_Node))));
+
+      Insert_Action (Related_Nod,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Index,
+          Constant_Present    => True,
+          Object_Definition   => New_Occurrence_Of (Standard_Integer, Loc),
+          Expression =>
             Make_Op_Subtract (Loc,
               Left_Opnd =>
                 Make_Selected_Component (Loc,
-                  Prefix => Build_TSD (Loc, Duplicate_Subexpr (Obj_Tag_Node)),
+                  Prefix        => New_Reference_To (Obj_TSD, Loc),
                   Selector_Name =>
-                    New_Reference_To (RTE_Record_Component (RE_Idepth), Loc)),
+                     New_Reference_To
+                       (RTE_Record_Component (RE_Idepth), Loc)),
 
                Right_Opnd =>
                  Make_Selected_Component (Loc,
-                  Prefix => Build_TSD (Loc, Duplicate_Subexpr (Typ_Tag_Node)),
+                   Prefix        => New_Reference_To (Typ_TSD, Loc),
                    Selector_Name =>
-                    New_Reference_To (RTE_Record_Component (RE_Idepth), Loc)));
-      end Build_Pos;
-
-   --  Start of processing for Build_CW_Membership
+                     New_Reference_To
+                       (RTE_Record_Component (RE_Idepth), Loc)))));
 
-   begin
-      return
+      New_Node :=
         Make_And_Then (Loc,
           Left_Opnd =>
             Make_Op_Ge (Loc,
-              Left_Opnd  => Build_Pos,
+              Left_Opnd  => New_Occurrence_Of (Index, Loc),
               Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
 
           Right_Opnd =>
@@ -181,12 +235,12 @@ package body Exp_Atag is
                 Make_Indexed_Component (Loc,
                   Prefix =>
                     Make_Selected_Component (Loc,
-                      Prefix => Build_TSD (Loc, Obj_Tag_Node),
+                      Prefix        => New_Reference_To (Obj_TSD, Loc),
                       Selector_Name =>
                         New_Reference_To
                           (RTE_Record_Component (RE_Tags_Table), Loc)),
                   Expressions =>
-                    New_List (Build_Pos)),
+                    New_List (New_Occurrence_Of (Index, Loc))),
 
               Right_Opnd => Typ_Tag_Node));
    end Build_CW_Membership;
@@ -197,7 +251,8 @@ package body Exp_Atag is
 
    function Build_DT
      (Loc      : Source_Ptr;
-      Tag_Node : Node_Id) return Node_Id is
+      Tag_Node : Node_Id) return Node_Id
+   is
    begin
       return
         Make_Function_Call (Loc,
@@ -217,7 +272,9 @@ package body Exp_Atag is
    begin
       return
         Make_Selected_Component (Loc,
-          Prefix => Build_TSD (Loc, Tag_Node),
+          Prefix =>
+            Build_TSD (Loc,
+              Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
           Selector_Name =>
             New_Reference_To
               (RTE_Record_Component (RE_Access_Level), Loc));
@@ -390,7 +447,9 @@ package body Exp_Atag is
    begin
       return
         Make_Selected_Component (Loc,
-          Prefix => Build_TSD (Loc, Tag_Node),
+          Prefix =>
+            Build_TSD (Loc,
+              Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
           Selector_Name =>
             New_Reference_To
               (RTE_Record_Component (RE_Transportable), Loc));
@@ -529,7 +588,9 @@ package body Exp_Atag is
         Make_Assignment_Statement (Loc,
           Name =>
             Make_Selected_Component (Loc,
-              Prefix => Build_TSD (Loc, Tag_Node),
+              Prefix =>
+                Build_TSD (Loc,
+                  Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
               Selector_Name =>
                 New_Reference_To
                   (RTE_Record_Component (RE_Size_Func), Loc)),
@@ -572,7 +633,9 @@ package body Exp_Atag is
    -- Build_TSD --
    ---------------
 
-   function Build_TSD (Loc : Source_Ptr; Tag_Node : Node_Id) return Node_Id is
+   function Build_TSD
+     (Loc           : Source_Ptr;
+      Tag_Node_Addr : Node_Id) return Node_Id is
    begin
       return
         Unchecked_Convert_To (RTE (RE_Type_Specific_Data_Ptr),
@@ -590,7 +653,7 @@ package body Exp_Atag is
                         Chars => Name_Op_Subtract)),
 
                 Parameter_Associations => New_List (
-                  Unchecked_Convert_To (RTE (RE_Address), Tag_Node),
+                  Tag_Node_Addr,
                   New_Reference_To
                     (RTE (RE_DT_Typeinfo_Ptr_Size), Loc))))));
    end Build_TSD;

gcc/ada/exp_atag.ads

@@ -41,18 +41,23 @@ package Exp_Atag is
    --  Ada 2005 (AI-345): Generate statements that are common between timed,
    --  asynchronous, and conditional select expansion.
 
-   function Build_CW_Membership
+   procedure Build_CW_Membership
      (Loc          : Source_Ptr;
-      Obj_Tag_Node : Node_Id;
-      Typ_Tag_Node : Node_Id) return Node_Id;
+      Obj_Tag_Node : in out Node_Id;
+      Typ_Tag_Node : Node_Id;
+      Related_Nod  : Node_Id;
+      New_Node     : out Node_Id);
    --  Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
    --  has a table of ancestors and its inheritance level (Idepth). Obj is in
    --  Typ'Class if Typ'Tag is found in the table of ancestors referenced by
    --  Obj'Tag. Knowing the level of inheritance of both types, this can be
    --  computed in constant time by the formula:
    --
-   --   TSD (Obj'tag).Tags_Table (TSD (Obj'tag).Idepth - TSD (Typ'tag).Idepth)
-   --     = Typ'tag
+   --   Index := TSD (Obj'Tag).Idepth - TSD (Typ'Tag).Idepth;
+   --   Index > 0 and then TSD (Obj'Tag).Tags_Table (Index) = Typ'Tag
+   --
+   --  Related_Nod is the node where the implicit declaration of variable Index
+   --  is inserted. Obj_Tag_Node is relocated.
 
    function Build_Get_Access_Level
      (Loc      : Source_Ptr;

gcc/ada/exp_ch4.adb

@@ -205,7 +205,10 @@ package body Exp_Ch4 is
    --  its expression. If N is neither comparison nor a type conversion, the
    --  call has no effect.
 
-   function Tagged_Membership (N : Node_Id) return Node_Id;
+   procedure Tagged_Membership
+     (N         : Node_Id;
+      SCIL_Node : out Node_Id;
+      Result    : out Node_Id);
    --  Construct the expression corresponding to the tagged membership test.
    --  Deals with a second operand being (or not) a class-wide type.
 
@@ -4505,8 +4508,10 @@ package body Exp_Ch4 is
          declare
             Typ       : Entity_Id        := Etype (Rop);
             Is_Acc    : constant Boolean := Is_Access_Type (Typ);
-            Obj    : Node_Id          := Lop;
             Cond      : Node_Id          := Empty;
+            New_N     : Node_Id;
+            Obj       : Node_Id          := Lop;
+            SCIL_Node : Node_Id;
 
          begin
             Remove_Side_Effects (Obj);
@@ -4521,8 +4526,19 @@ package body Exp_Ch4 is
                --  normal tagged membership expansion is not what we want).
 
                if Tagged_Type_Expansion then
-                  Rewrite (N, Tagged_Membership (N));
+                  Tagged_Membership (N, SCIL_Node, New_N);
+                  Rewrite (N, New_N);
                   Analyze_And_Resolve (N, Rtyp);
+
+                  --  Update decoration of relocated node referenced by the
+                  --  SCIL node.
+
+                  if Generate_SCIL
+                    and then Present (SCIL_Node)
+                  then
+                     Set_SCIL_Related_Node (SCIL_Node, N);
+                     Insert_Action (N, SCIL_Node);
+                  end if;
                end if;
 
                return;
@@ -9857,16 +9873,23 @@ package body Exp_Ch4 is
    --  table of abstract interface types plus the ancestor table contained in
    --  the dispatch table pointed by Left_Expr.Tag for Typ'Tag
 
-   function Tagged_Membership (N : Node_Id) return Node_Id is
+   procedure Tagged_Membership
+     (N         : Node_Id;
+      SCIL_Node : out Node_Id;
+      Result    : out Node_Id)
+   is
       Left  : constant Node_Id    := Left_Opnd  (N);
       Right : constant Node_Id    := Right_Opnd (N);
       Loc   : constant Source_Ptr := Sloc (N);
 
       Left_Type  : Entity_Id;
+      New_Node   : Node_Id;
       Right_Type : Entity_Id;
       Obj_Tag    : Node_Id;
 
    begin
+      SCIL_Node := Empty;
+
       --  Handle entities from the limited view
 
       Left_Type  := Available_View (Etype (Left));
@@ -9914,7 +9937,8 @@ package body Exp_Ch4 is
                                            (Typ   => Left_Type,
                                             Iface => Etype (Right_Type))))
          then
-            return New_Reference_To (Standard_True, Loc);
+            Result := New_Reference_To (Standard_True, Loc);
+            return;
          end if;
 
          --  Ada 2005 (AI-251): Class-wide applied to interfaces
@@ -9931,10 +9955,11 @@ package body Exp_Ch4 is
             if not RTE_Available (RE_IW_Membership) then
                Error_Msg_CRT
                  ("dynamic membership test on interface types", N);
-               return Empty;
+               Result := Empty;
+               return;
             end if;
 
-            return
+            Result :=
               Make_Function_Call (Loc,
                  Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc),
                  Parameter_Associations => New_List (
@@ -9949,14 +9974,27 @@ package body Exp_Ch4 is
          --  Ada 95: Normal case
 
          else
-            return
             Build_CW_Membership (Loc,
               Obj_Tag_Node => Obj_Tag,
               Typ_Tag_Node =>
                  New_Reference_To (
                    Node (First_Elmt
                           (Access_Disp_Table (Root_Type (Right_Type)))),
-                     Loc));
+                   Loc),
+              Related_Nod => N,
+              New_Node    => New_Node);
+
+            --  Generate the SCIL node for this class-wide membership test.
+            --  Done here because the previous call to Build_CW_Membership
+            --  relocates Obj_Tag.
+
+            if Generate_SCIL then
+               SCIL_Node := Make_SCIL_Membership_Test (Sloc (N));
+               Set_SCIL_Entity (SCIL_Node, Etype (Right_Type));
+               Set_SCIL_Tag_Value (SCIL_Node, Obj_Tag);
+            end if;
+
+            Result := New_Node;
          end if;
 
       --  Right_Type is not a class-wide type
@@ -9965,10 +10003,10 @@ package body Exp_Ch4 is
          --  No need to check the tag of the object if Right_Typ is abstract
 
          if Is_Abstract_Type (Right_Type) then
-            return New_Reference_To (Standard_False, Loc);
+            Result := New_Reference_To (Standard_False, Loc);
 
          else
-            return
+            Result :=
               Make_Op_Eq (Loc,
                 Left_Opnd  => Obj_Tag,
                 Right_Opnd =>

gcc/ada/exp_intr.adb

@@ -234,19 +234,28 @@ package body Exp_Intr is
       --  the tag in the table of ancestor tags.
 
       elsif not Is_Interface (Result_Typ) then
-         Insert_Action (N,
-           Make_Implicit_If_Statement (N,
-             Condition =>
-               Make_Op_Not (Loc,
+         declare
+            Obj_Tag_Node : Node_Id := Duplicate_Subexpr (Tag_Arg);
+            CW_Test_Node : Node_Id;
+
+         begin
             Build_CW_Membership (Loc,
-                   Obj_Tag_Node => Duplicate_Subexpr (Tag_Arg),
+              Obj_Tag_Node => Obj_Tag_Node,
               Typ_Tag_Node =>
                 New_Reference_To (
                    Node (First_Elmt (Access_Disp_Table (
-                                            Root_Type (Result_Typ)))), Loc))),
+                                       Root_Type (Result_Typ)))), Loc),
+              Related_Nod => N,
+              New_Node    => CW_Test_Node);
+
+            Insert_Action (N,
+              Make_Implicit_If_Statement (N,
+                Condition =>
+                  Make_Op_Not (Loc, CW_Test_Node),
                 Then_Statements =>
                   New_List (Make_Raise_Statement (Loc,
                               New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
+         end;
 
       --  Call IW_Membership test if the Result_Type is an abstract interface
       --  to look for the tag in the table of interface tags.

gcc/ada/exp_util.adb

@@ -2761,6 +2761,7 @@ package body Exp_Util is
                N_SCIL_Dispatch_Table_Object_Init        |
                N_SCIL_Dispatch_Table_Tag_Init           |
                N_SCIL_Dispatching_Call                  |
+               N_SCIL_Membership_Test                   |
                N_SCIL_Tag_Init                          |
                N_Selected_Component                     |
                N_Signed_Integer_Type_Definition         |

gcc/ada/frontend.adb

@@ -47,6 +47,7 @@ with Prepcomp;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
+with Snames;   use Snames;
 with Sprint;
 with Scn;      use Scn;
 with Sem;      use Sem;
@@ -381,6 +382,28 @@ begin
 
    Sprint.Source_Dump;
 
+   --  Check again for configuration pragmas that appear in the context of
+   --  the main unit. These pragmas only affect the main unit, and the
+   --  corresponding flag is reset after each call to Semantics, but they
+   --  may affect the generated ali for the unit, and therefore the flag
+   --  must be set properly after compilation. Currently we only check for
+   --  Initialize_Scalars, but others should be checked: as well???
+
+   declare
+      Item  : Node_Id;
+
+   begin
+      Item := First (Context_Items (Cunit (Main_Unit)));
+      while Present (Item) loop
+         if Nkind (Item) = N_Pragma
+           and then Pragma_Name (Item) = Name_Initialize_Scalars
+         then
+            Initialize_Scalars := True;
+         end if;
+         Next (Item);
+      end loop;
+   end;
+
    --  If a mapping file has been specified by a -gnatem switch, update
    --  it if there has been some sources that were not in the mappings.
 

gcc/ada/gcc-interface/Make-lang.in

@@ -1663,28 +1663,24 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 
 ada/exp_atag.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
-   ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
-   ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
-   ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads ada/exp_atag.ads \
-   ada/exp_atag.adb ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_dist.ads \
-   ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
-   ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
-   ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads \
+   ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
+   ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
+   ada/erroutc.ads ada/exp_atag.ads ada/exp_atag.adb ada/exp_dist.ads \
+   ada/exp_tss.ads ada/exp_util.ads ada/fname.ads ada/fname-uf.ads \
+   ada/gnat.ads ada/g-htable.ads ada/hostparm.ads ada/lib.ads \
    ada/lib-load.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
    ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/sem.ads \
-   ada/sem_aux.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_dist.ads \
-   ada/sem_eval.ads ada/sem_res.ads ada/sem_scil.ads ada/sem_type.ads \
-   ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
-   ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
-   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
-   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
-   ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+   ada/sem_aux.ads ada/sem_ch7.ads ada/sem_dist.ads ada/sem_util.ads \
+   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+   ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+   ada/s-rident.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
+   ada/unchdeal.ads ada/urealp.ads 
 
 ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \

gcc/ada/gcc-interface/trans.c

@@ -5321,6 +5321,7 @@ gnat_to_gnu (Node_Id gnat_node)
     case N_SCIL_Dispatch_Table_Object_Init:
     case N_SCIL_Dispatch_Table_Tag_Init:
     case N_SCIL_Dispatching_Call:
+    case N_SCIL_Membership_Test:
     case N_SCIL_Tag_Init:
       /* SCIL nodes require no processing for GCC.  */
       gnu_result = alloc_stmt_list ();

gcc/ada/gnatlink.adb

@@ -445,7 +445,10 @@ procedure Gnatlink is
                            Exit_With_Error ("Missing argument for -o");
                         end if;
 
-                        Output_File_Name := new String'(Argument (Next_Arg));
+                        Output_File_Name :=
+                          new String'(Executable_Name
+                            (Argument (Next_Arg),
+                             Only_If_No_Suffix => True));
 
                      when 'R' =>
                         Opt.Run_Path_Option := False;

gcc/ada/opt.adb

@@ -56,6 +56,8 @@ package body Opt is
       External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
       External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
       Fast_Math_Config                      := Fast_Math;
+      Init_Or_Norm_Scalars_Config           := Init_Or_Norm_Scalars;
+      Initialize_Scalars_Config             := Initialize_Scalars;
       Optimize_Alignment_Config             := Optimize_Alignment;
       Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
       Polling_Required_Config               := Polling_Required;
@@ -86,6 +88,8 @@ package body Opt is
       External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
       External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
       Fast_Math                      := Save.Fast_Math;
+      Init_Or_Norm_Scalars           := Save.Init_Or_Norm_Scalars;
+      Initialize_Scalars             := Save.Initialize_Scalars;
       Optimize_Alignment             := Save.Optimize_Alignment;
       Optimize_Alignment_Local       := Save.Optimize_Alignment_Local;
       Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
@@ -111,6 +115,8 @@ package body Opt is
       Save.External_Name_Exp_Casing       := External_Name_Exp_Casing;
       Save.External_Name_Imp_Casing       := External_Name_Imp_Casing;
       Save.Fast_Math                      := Fast_Math;
+      Save.Init_Or_Norm_Scalars           := Init_Or_Norm_Scalars;
+      Save.Initialize_Scalars             := Initialize_Scalars;
       Save.Optimize_Alignment             := Optimize_Alignment;
       Save.Optimize_Alignment_Local       := Optimize_Alignment_Local;
       Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
@@ -175,6 +181,8 @@ package body Opt is
          External_Name_Exp_Casing    := External_Name_Exp_Casing_Config;
          External_Name_Imp_Casing    := External_Name_Imp_Casing_Config;
          Fast_Math                   := Fast_Math_Config;
+         Init_Or_Norm_Scalars        := Init_Or_Norm_Scalars_Config;
+         Initialize_Scalars          := Initialize_Scalars_Config;
          Optimize_Alignment          := Optimize_Alignment_Config;
          Optimize_Alignment_Local    := False;
          Persistent_BSS_Mode         := Persistent_BSS_Mode_Config;

gcc/ada/opt.ads

@@ -1551,6 +1551,18 @@ package Opt is
    --  used to set the initial value of Fast_Math at the start of each new
    --  compilation unit.
 
+   Init_Or_Norm_Scalars_Config : Boolean;
+   --  GNAT
+   --  This is the value of the configuration switch that is set by one
+   --  of the pragmas Initialize_Scalars or Normalize_Scalars.
+
+   Initialize_Scalars_Config : Boolean;
+   --  GNAT
+   --  This is the value of the configuration switch that is set by the
+   --  pragma Initialize_Scalars when it appears in the gnat.adc file.
+   --  This switch is not set when the pragma appears ahead of a given
+   --  unit, so it does not affect the compilation of other units.
+
    Optimize_Alignment_Config : Character;
    --  GNAT
    --  This is the value of the configuration switch that controls the
@@ -1699,6 +1711,8 @@ private
       External_Name_Exp_Casing       : External_Casing_Type;
       External_Name_Imp_Casing       : External_Casing_Type;
       Fast_Math                      : Boolean;
+      Init_Or_Norm_Scalars           : Boolean;
+      Initialize_Scalars             : Boolean;
       Optimize_Alignment             : Character;
       Optimize_Alignment_Local       : Boolean;
       Persistent_BSS_Mode            : Boolean;

gcc/ada/osint.adb

@@ -793,8 +793,12 @@ package body Osint is
    -- Executable_Name --
    ---------------------
 
-   function Executable_Name (Name : File_Name_Type) return File_Name_Type is
+   function Executable_Name
+     (Name              : File_Name_Type;
+      Only_If_No_Suffix : Boolean := False) return File_Name_Type
+   is
       Exec_Suffix : String_Access;
+      Add_Suffix  : Boolean;
 
    begin
       if Name = No_File then
@@ -808,9 +812,21 @@ package body Osint is
          Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
       end if;
 
+      if Exec_Suffix'Length /= 0 then
+         Add_Suffix := not Only_If_No_Suffix;
+
+         if not Add_Suffix then
+            for J in 1 .. Name_Len loop
+               if Name_Buffer (J) = '.' then
+                  Add_Suffix := True;
+                  exit;
+               end if;
+            end loop;
+         end if;
+
+         if Add_Suffix then
             Get_Name_String (Name);
 
-      if Exec_Suffix'Length /= 0 then
             declare
                Buffer : String := Name_Buffer (1 .. Name_Len);
 
@@ -820,14 +836,16 @@ package body Osint is
 
                Canonical_Case_File_Name (Buffer);
 
-            --  If Executable does not end with the executable suffix, add it
+               --  If Executable does not end with the executable suffix, add
+               --  it.
 
                if Buffer'Length <= Exec_Suffix'Length
                  or else
                    Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
                    /= Exec_Suffix.all
                then
-               Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+                  Name_Buffer
+                    (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
                     Exec_Suffix.all;
                   Name_Len := Name_Len + Exec_Suffix'Length;
                   Free (Exec_Suffix);
@@ -835,13 +853,18 @@ package body Osint is
                end if;
             end;
          end if;
+      end if;
 
       Free (Exec_Suffix);
       return Name;
    end Executable_Name;
 
-   function Executable_Name (Name : String) return String is
+   function Executable_Name
+     (Name              : String;
+      Only_If_No_Suffix : Boolean := False) return String
+   is
       Exec_Suffix    : String_Access;
+      Add_Suffix     : Boolean;
       Canonical_Name : String := Name;
 
    begin
@@ -858,9 +881,19 @@ package body Osint is
       begin
          Free (Exec_Suffix);
          Canonical_Case_File_Name (Canonical_Name);
+         Add_Suffix := not Only_If_No_Suffix;
 
-         if Suffix'Length /= 0
-           and then
+         if not Add_Suffix then
+            for J in 1 .. Name_Len loop
+               if Name_Buffer (J) = '.' then
+                  Add_Suffix := True;
+                  exit;
+               end if;
+            end loop;
+         end if;
+
+         if Suffix'Length = 0 and then
+           Add_Suffix and then
            (Canonical_Name'Length <= Suffix'Length
             or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
                                     .. Canonical_Name'Last) /= Suffix)

gcc/ada/osint.ads

@@ -147,13 +147,17 @@ package Osint is
    --  Strips the suffix (the last '.' and whatever comes after it) from Name.
    --  Returns the stripped name.
 
-   function Executable_Name (Name : File_Name_Type) return File_Name_Type;
+   function Executable_Name
+     (Name              : File_Name_Type;
+      Only_If_No_Suffix : Boolean := False) return File_Name_Type;
    --  Given a file name it adds the appropriate suffix at the end so that
    --  it becomes the name of the executable on the system at end. For
    --  instance under DOS it adds the ".exe" suffix, whereas under UNIX no
    --  suffix is added.
 
-   function Executable_Name (Name : String) return String;
+   function Executable_Name
+     (Name              : String;
+      Only_If_No_Suffix : Boolean := False) return String;
    --  Same as above, with String parameters
 
    function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type;

gcc/ada/sem.adb

@@ -612,6 +612,7 @@ package body Sem is
            N_SCIL_Dispatch_Table_Object_Init        |
            N_SCIL_Dispatch_Table_Tag_Init           |
            N_SCIL_Dispatching_Call                  |
+           N_SCIL_Membership_Test                   |
            N_SCIL_Tag_Init                          =>
             null;
 

gcc/ada/sem_scil.adb

@@ -101,15 +101,58 @@ package body Sem_SCIL is
    -- Check_SCIL_Node --
    ---------------------
 
-   --  Is this a good name for the function, given it only deals with
-   --  N_SCIL_Dispatching_Call case ???
-
    function Check_SCIL_Node (N : Node_Id) return Traverse_Result is
       Ctrl_Tag : Node_Id;
       Ctrl_Typ : Entity_Id;
 
    begin
-      if Nkind (N) = N_SCIL_Dispatching_Call then
+      if Nkind (N) = N_SCIL_Membership_Test then
+
+         --  Check contents of the boolean expression associated with the
+         --  membership test.
+
+         pragma Assert (Nkind (SCIL_Related_Node (N)) = N_Identifier
+           and then Etype (SCIL_Related_Node (N)) = Standard_Boolean);
+
+         --  Check the entity identifier of the associated tagged type (that
+         --  is, in testing for membership in T'Class, the entity id of the
+         --  specific type T).
+
+         --  Note: When the SCIL node is generated the private and full-view
+         --    of the tagged types may have been swapped and hence the node
+         --    referenced by attribute SCIL_Entity may be the private view.
+         --    Therefore, in order to uniformily locate the full-view we use
+         --    attribute Underlying_Type.
+
+         pragma Assert (Is_Tagged_Type (Underlying_Type (SCIL_Entity (N))));
+
+         --  Interface types are unsupported
+
+         pragma Assert (not Is_Interface (Underlying_Type (SCIL_Entity (N))));
+
+         --  Check the decoration of the expression that denotes the tag value
+         --  being tested
+
+         Ctrl_Tag := SCIL_Tag_Value (N);
+
+         case Nkind (Ctrl_Tag) is
+
+            --  For class-wide membership tests the SCIL tag value is the tag
+            --  of the tested object (i.e. Obj.Tag).
+
+            when N_Selected_Component =>
+               pragma Assert (Etype (Ctrl_Tag) = RTE (RE_Tag));
+               null;
+
+            when others =>
+               pragma Assert (False);
+               null;
+
+         end case;
+
+         return Skip;
+
+      elsif Nkind (N) = N_SCIL_Dispatching_Call then
          Ctrl_Tag := SCIL_Controlling_Tag (N);
 
          --  SCIL_Related_Node of SCIL dispatching call nodes MUST reference
@@ -452,6 +495,7 @@ package body Sem_SCIL is
                N_SCIL_Dispatch_Table_Object_Init        |
                N_SCIL_Dispatch_Table_Tag_Init           |
                N_SCIL_Dispatching_Call                  |
+               N_SCIL_Membership_Test                   |
                N_SCIL_Tag_Init
             =>
                pragma Assert (False);

gcc/ada/sinfo.adb

@@ -2556,6 +2556,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Object_Init
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init
         or else NT (N).Nkind = N_SCIL_Dispatching_Call
+        or else NT (N).Nkind = N_SCIL_Membership_Test
         or else NT (N).Nkind = N_SCIL_Tag_Init);
       return Node4 (N);
    end SCIL_Entity;
@@ -2567,10 +2568,19 @@ package body Sinfo is
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Object_Init
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init
         or else NT (N).Nkind = N_SCIL_Dispatching_Call
+        or else NT (N).Nkind = N_SCIL_Membership_Test
         or else NT (N).Nkind = N_SCIL_Tag_Init);
       return Node1 (N);
    end SCIL_Related_Node;
 
+   function SCIL_Tag_Value
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_SCIL_Membership_Test);
+      return Node5 (N);
+   end SCIL_Tag_Value;
+
    function SCIL_Target_Prim
       (N : Node_Id) return Node_Id is
    begin
@@ -5416,6 +5426,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Object_Init
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init
         or else NT (N).Nkind = N_SCIL_Dispatching_Call
+        or else NT (N).Nkind = N_SCIL_Membership_Test
         or else NT (N).Nkind = N_SCIL_Tag_Init);
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_SCIL_Entity;
@@ -5427,10 +5438,19 @@ package body Sinfo is
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Object_Init
         or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init
         or else NT (N).Nkind = N_SCIL_Dispatching_Call
+        or else NT (N).Nkind = N_SCIL_Membership_Test
         or else NT (N).Nkind = N_SCIL_Tag_Init);
       Set_Node1 (N, Val); -- semantic field, no parent set
    end Set_SCIL_Related_Node;
 
+   procedure Set_SCIL_Tag_Value
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_SCIL_Membership_Test);
+      Set_Node5 (N, Val); -- semantic field, no parent set
+   end Set_SCIL_Tag_Value;
+
    procedure Set_SCIL_Target_Prim
       (N : Node_Id; Val : Node_Id) is
    begin

gcc/ada/sinfo.ads

@@ -1608,6 +1608,10 @@ package Sinfo is
    --    Present in N_SCIL_Dispatching_Call nodes. Used to reference the
    --    controlling tag of a dispatching call.
 
+   --  SCIL_Tag_Value (Node5-Sem)
+   --    Present in N_SCIL_Membership_Test nodes. Used to reference the tag
+   --    value that is being tested.
+
    --  SCIL_Target_Prim (Node2-Sem)
    --    Present in N_SCIL_Dispatching_Call nodes. Used to reference the tagged
    --    type primitive associated with the SCIL node.
@@ -6886,6 +6890,12 @@ package Sinfo is
       --  SCIL_Entity (Node4-Sem)
       --  SCIL_Controlling_Tag (Node5-Sem)
 
+      --  N_SCIL_Membership_Test
+      --  Sloc references the node of a membership test
+      --  SCIL_Related_Node (Node1-Sem)
+      --  SCIL_Tag_Value (Node5-Sem)
+      --  SCIL_Entity (Node4-Sem)
+
       --  N_SCIL_Tag_Init
       --  Sloc references the node of a tag component initialization
       --  SCIL_Related_Node (Node1-Sem)
@@ -7333,6 +7343,7 @@ package Sinfo is
       N_SCIL_Dispatch_Table_Object_Init,
       N_SCIL_Dispatch_Table_Tag_Init,
       N_SCIL_Dispatching_Call,
+      N_SCIL_Membership_Test,
       N_SCIL_Tag_Init,
 
       --  Other nodes (not part of any subtype class)
@@ -8390,6 +8401,9 @@ package Sinfo is
    function SCIL_Related_Node
      (N : Node_Id) return Node_Id;    -- Node1
 
+   function SCIL_Tag_Value
+     (N : Node_Id) return Node_Id;    -- Node5
+
    function SCIL_Target_Prim
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -9302,6 +9316,9 @@ package Sinfo is
    procedure Set_SCIL_Related_Node
      (N : Node_Id; Val : Node_Id);            -- Node1
 
+   procedure Set_SCIL_Tag_Value
+     (N : Node_Id; Val : Node_Id);            -- Node5
+
    procedure Set_SCIL_Target_Prim
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -11056,6 +11073,13 @@ package Sinfo is
         4 => False,   --  SCIL_Entity (Node4-Sem)
         5 => False),  --  SCIL_Controlling_Tag (Node5-Sem)
 
+     N_SCIL_Membership_Test =>
+       (1 => False,   --  SCIL_Related_Node (Node1-Sem)
+        2 => False,   --  unused
+        3 => False,   --  unused
+        4 => False,   --  SCIL_Entity (Node4-Sem)
+        5 => False),  --  SCIL_Tag_Value (Node5-Sem)
+
      N_SCIL_Tag_Init =>
        (1 => False,   --  SCIL_Related_Node (Node1-Sem)
         2 => False,   --  unused
@@ -11364,6 +11388,7 @@ package Sinfo is
    pragma Inline (SCIL_Controlling_Tag);
    pragma Inline (SCIL_Entity);
    pragma Inline (SCIL_Related_Node);
+   pragma Inline (SCIL_Tag_Value);
    pragma Inline (SCIL_Target_Prim);
    pragma Inline (Scope);
    pragma Inline (Select_Alternatives);
@@ -11664,6 +11689,7 @@ package Sinfo is
    pragma Inline (Set_SCIL_Controlling_Tag);
    pragma Inline (Set_SCIL_Entity);
    pragma Inline (Set_SCIL_Related_Node);
+   pragma Inline (Set_SCIL_Tag_Value);
    pragma Inline (Set_SCIL_Target_Prim);
    pragma Inline (Set_Scope);
    pragma Inline (Set_Select_Alternatives);

gcc/ada/sprint.adb

@@ -2652,6 +2652,9 @@ package body Sprint is
          when N_SCIL_Dispatching_Call =>
             Write_Indent_Str ("[N_SCIL_Dispatching_Node]");
 
+         when N_SCIL_Membership_Test =>
+            Write_Indent_Str ("[N_SCIL_Membership_Test]");
+
          when N_SCIL_Tag_Init =>
             Write_Indent_Str ("[N_SCIL_Dispatch_Table_Tag_Init]");