decl.c (prepend_attributes): New case.

2005-07-04  Eric Botcazou  <ebotcazou@adacore.com>

	* decl.c (prepend_attributes) <Pragma_Linker_Constructor>: New case.
	<Pragma_Linker_Destructor>: Likewise.

	* einfo.ads (Has_Gigi_Rep_Item): Document Pragma_Linker_Constructor and
	Pragma_Linker_Destructor.

	* gigi.h (attr_type): Add ATTR_LINK_CONSTRUCTOR and
	ATTR_LINK_DESTRUCTOR.
	(static_ctors, static_dtors): New variables.

	* misc.c (gnat_expand_body): Output current function as constructor
	and destructor if requested.

	* par-prag.adb: Add processing for pragma Linker_Constructor and
	Linker_Destructor.

	* sem_prag.adb (Find_Unique_Parameterless_Procedure): New function
	extracted from Check_Interrupt_Or_Attach_Handler.
	(Check_Interrupt_Or_Attach_Handler): Invoke it.
	Implement pragma Linker_Constructor and Linker_Destructor with the
	help of Find_Unique_Parameterless_Procedure.
	Replace Name_Alias with Name_Target for pragma Linker_Alias.

	* snames.h, snames.ads, snames.adb:
	Add Name_Linker_Constructor and Name_Linker_Destructor.
	Add Pragma_Linker_Constructor and Pragma_Linker_Destructor.
	* snames.adb: Remove Name_Alias.

	* trans.c: Include cgraph.h.
	(build_global_cdtor): New function.
	(Compilation_Unit_to_gnu): Build global constructor and destructor if
	needed.
	(tree_transform) <N_Identifier>: Substitute renaming of view-conversions
	of objects too.
	(addressable_p) <COMPONENT_REF>: Unconditionally test
	DECL_NONADDRESSABLE_P on STRICT_ALIGNMENT platforms.

	* utils.c (process_attributes) <ATTR_LINK_ALIAS>: Do not assemble the
	variable if it is external.

	(static_ctors, static_dtors): New global variables.
	(process_attributes) <ATTR_LINK_CONSTRUCTOR>: New case.
	<ATTR_LINK_DESTRUCTOR>: Likewise.
	(end_subprog_body): Chain function as constructor and destructor
	if requested.

	* exp_util.adb (Force_Evaluation): Unconditionally invoke
	Remove_Side_Effects with Variable_Ref set to true.
	(Remove_Side_Effects): Handle scalar types first. Use a renaming
	for non-scalar types even if Variable_Ref is true and for class-wide
	expressions.

From-SVN: r101576

gcc/ada/decl.c

@@ -4523,6 +4523,14 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 	    etype = ATTR_LINK_SECTION;
 	    break;
 
+	  case Pragma_Linker_Constructor:
+	    etype = ATTR_LINK_CONSTRUCTOR;
+	    break;
+
+	  case Pragma_Linker_Destructor:
+	    etype = ATTR_LINK_DESTRUCTOR;
+	    break;
+
 	  case Pragma_Weak_External:
 	    etype = ATTR_WEAK_EXTERNAL;
 	    break;

gcc/ada/einfo.ads

@@ -1358,13 +1358,15 @@ package Einfo is
 
 --    Has_Gigi_Rep_Item (Flag82)
 --       This flag is set if the rep item chain (referenced by First_Rep_Item
---       and linked through the Next_Rep_Item chain contains a representation
+--       and linked through the Next_Rep_Item chain) contains a representation
 --       item that needs to be specially processed by Gigi, i.e. one of the
 --       following items:
 --
 --          Machine_Attribute pragma
 --          Linker_Alias pragma
 --          Linker_Section pragma
+--          Linker_Constructor pragma
+--          Linker_Destructor pragma
 --          Weak_External pragma
 --
 --       If this flag is set, then Gigi should scan the rep item chain to
@@ -2244,7 +2246,7 @@ package Einfo is
 --    Is_Private_Composite (Flag107)
 --       Present in composite types that have a private component. Used to
 --       enforce the rule that operations on the composite type that depend
---       on the fulll view of the component, do not become visible until the
+--       on the full view of the component, do not become visible until the
 --       immediate scope of the composite type itself (7.3.1 (5)). Both this
 --       flag and Is_Limited_Composite are needed.
 
@@ -6017,7 +6019,7 @@ package Einfo is
      (E  : Entity_Id;
       Id : Attribute_Id) return Node_Id;
    --  Searches the Rep_Item chain for a given entity E, for an instance
-   --  of an attribute definition clause with the given attibute Id Id. If
+   --  of an attribute definition clause with the given attribute Id. If
    --  found, the value returned is the N_Attribute_Definition_Clause node,
    --  otherwise Empty is returned.
 
@@ -6035,7 +6037,7 @@ package Einfo is
      (E  : Entity_Id;
       Id : Attribute_Id) return Boolean;
    --  Searches the Rep_Item chain for a given entity E, for an instance
-   --  of an attribute definition clause with the given attibute Id Id. If
+   --  of an attribute definition clause with the given attribute Id. If
    --  found, True is returned, otherwise False indicates that no matching
    --  entry was found.
 

gcc/ada/exp_util.adb

@@ -1485,43 +1485,8 @@ package body Exp_Util is
    ----------------------
 
    procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is
-      Component_In_Lhs : Boolean := False;
-      Par              : Node_Id;
-
    begin
-      --  Loop to determine whether there is a component reference in the left
-      --  hand side if Exp appears on the left side of an assignment statement.
-      --  Needed to determine if form of result must be a variable.
-
-      Par := Exp;
-      while Present (Par)
-        and then
-         (Nkind (Par) = N_Selected_Component
-            or else
-          Nkind (Par) = N_Indexed_Component)
-      loop
-         if Nkind (Parent (Par)) = N_Assignment_Statement
-           and then Par = Name (Parent (Par))
-         then
-            Component_In_Lhs := True;
-            exit;
-         else
-            Par := Parent (Par);
-         end if;
-      end loop;
-
-      --  If the expression is a selected component, it is being evaluated as
-      --  part of a discriminant check. If it is part of a left-hand side, this
-      --  is the last use of its value and it is safe to create a renaming for
-      --  it, rather than a temporary. In addition, if it is not an addressable
-      --  field, creating a temporary may be a problem for gigi, or might drop
-      --  the value of the assignment. Therefore, if the expression is on the
-      --  lhs of an assignment, remove side effects without requiring a
-      --  temporary, and create a renaming. (See remove_side_effects for
-      --  details).
-
-      Remove_Side_Effects
-        (Exp, Name_Req, Variable_Ref => not Component_In_Lhs);
+      Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True);
    end Force_Evaluation;
 
    ------------------------
@@ -3828,10 +3793,37 @@ package body Exp_Util is
 
       Scope_Suppress := (others => True);
 
+      --  If it is a scalar type and we need to capture the value, just
+      --  make a copy.  Likewise for a function call.  And if we have a
+      --  volatile variable and Nam_Req is not set (see comments above
+      --  for Side_Effect_Free).
+
+      if Is_Elementary_Type (Exp_Type)
+        and then (Variable_Ref
+                   or else Nkind (Exp) = N_Function_Call
+                   or else (not Name_Req
+                             and then Is_Entity_Name (Exp)
+                             and then Treat_As_Volatile (Entity (Exp))))
+      then
+
+         Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+         Set_Etype (Def_Id, Exp_Type);
+         Res := New_Reference_To (Def_Id, Loc);
+
+         E :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Def_Id,
+             Object_Definition   => New_Reference_To (Exp_Type, Loc),
+             Constant_Present    => True,
+             Expression          => Relocate_Node (Exp));
+
+         Set_Assignment_OK (E);
+         Insert_Action (Exp, E);
+
       --  If the expression has the form v.all then we can just capture
       --  the pointer, and then do an explicit dereference on the result.
 
-      if Nkind (Exp) = N_Explicit_Dereference then
+      elsif Nkind (Exp) = N_Explicit_Dereference then
          Def_Id :=
            Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
          Res :=
@@ -3873,26 +3865,51 @@ package body Exp_Util is
          Scope_Suppress := Svg_Suppress;
          return;
 
+      --  If this is an unchecked conversion that Gigi can't handle, make
+      --  a copy or a use a renaming to capture the value.
+
+      elsif Nkind (Exp) = N_Unchecked_Type_Conversion
+        and then not Safe_Unchecked_Type_Conversion (Exp)
+      then
+         if Controlled_Type (Etype (Exp)) then
+
+            --  Use a renaming to capture the expression, rather than create
+            --  a controlled temporary.
+
+            Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+            Res := New_Reference_To (Def_Id, Loc);
+
+            Insert_Action (Exp,
+              Make_Object_Renaming_Declaration (Loc,
+                Defining_Identifier => Def_Id,
+                Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
+                Name                => Relocate_Node (Exp)));
+
+         else
+            Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+            Set_Etype (Def_Id, Exp_Type);
+            Res := New_Reference_To (Def_Id, Loc);
+
+            E :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Def_Id,
+                Object_Definition   => New_Reference_To (Exp_Type, Loc),
+                Constant_Present    => not Is_Variable (Exp),
+                Expression          => Relocate_Node (Exp));
+
+            Set_Assignment_OK (E);
+            Insert_Action (Exp, E);
+         end if;
+
       --  For expressions that denote objects, we can use a renaming scheme.
       --  We skip using this if we have a volatile variable and we do not
       --  have Nam_Req set true (see comments above for Side_Effect_Free).
-      --  We also skip this scheme for class-wide expressions in order to
-      --  avoid recursive expansion (see Expand_N_Object_Renaming_Declaration)
-      --  If the object is a function call, we need to create a temporary and
-      --  not a renaming.
-
-      --  Note that we could use ordinary object declarations in the case of
-      --  expressions not appearing as lvalues. That is left as a possible
-      --  optimization in the future but we prefer to generate renamings
-      --  right now, since we may indeed be transforming an lvalue.
 
       elsif Is_Object_Reference (Exp)
         and then Nkind (Exp) /= N_Function_Call
-        and then not Variable_Ref
         and then (Name_Req
                    or else not Is_Entity_Name (Exp)
                    or else not Treat_As_Volatile (Entity (Exp)))
-        and then not Is_Class_Wide_Type (Exp_Type)
       then
          Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
 
@@ -3917,12 +3934,6 @@ package body Exp_Util is
                   New_Reference_To (Base_Type (Etype (Prefix (Exp))), Loc),
                 Name                => Relocate_Node (Prefix (Exp))));
 
-            --  The temporary must be elaborated by gigi, and is of course
-            --  not to be replaced in-line by the expression it renames,
-            --  which would defeat the purpose of removing the side-effect.
-
-            Set_Is_Renaming_Of_Object (Def_Id, False);
-
          else
             Res := New_Reference_To (Def_Id, Loc);
 
@@ -3932,62 +3943,13 @@ package body Exp_Util is
                 Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
                 Name                => Relocate_Node (Exp)));
 
-            Set_Is_Renaming_Of_Object (Def_Id, False);
          end if;
 
-      --  If it is a scalar type, just make a copy
-
-      elsif Is_Elementary_Type (Exp_Type) then
-         Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-         Set_Etype (Def_Id, Exp_Type);
-         Res := New_Reference_To (Def_Id, Loc);
-
-         E :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Def_Id,
-             Object_Definition   => New_Reference_To (Exp_Type, Loc),
-             Constant_Present    => True,
-             Expression          => Relocate_Node (Exp));
-
-         Set_Assignment_OK (E);
-         Insert_Action (Exp, E);
-
-      --  Always use a renaming for an unchecked conversion
-      --  If this is an unchecked conversion that Gigi can't handle, make
-      --  a copy or a use a renaming to capture the value.
-
-      elsif Nkind (Exp) = N_Unchecked_Type_Conversion
-        and then not Safe_Unchecked_Type_Conversion (Exp)
-      then
-         if Controlled_Type (Etype (Exp)) then
-
-            --  Use a renaming to capture the expression, rather than create
-            --  a controlled temporary.
-
-            Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-            Res := New_Reference_To (Def_Id, Loc);
-
-            Insert_Action (Exp,
-              Make_Object_Renaming_Declaration (Loc,
-                Defining_Identifier => Def_Id,
-                Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
-                Name                => Relocate_Node (Exp)));
-
-         else
-            Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-            Set_Etype (Def_Id, Exp_Type);
-            Res := New_Reference_To (Def_Id, Loc);
-
-            E :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Def_Id,
-                Object_Definition   => New_Reference_To (Exp_Type, Loc),
-                Constant_Present    => not Is_Variable (Exp),
-                Expression          => Relocate_Node (Exp));
+         --  The temporary must be elaborated by gigi, and is of course
+         --  not to be replaced in-line by the expression it renames,
+         --  which would defeat the purpose of removing the side-effect.
 
-            Set_Assignment_OK (E);
-            Insert_Action (Exp, E);
-         end if;
+         Set_Is_Renaming_Of_Object (Def_Id, False);
 
       --  Otherwise we generate a reference to the value
 

gcc/ada/gigi.h

@@ -301,8 +301,15 @@ extern int force_global;
 
 /* Data structures used to represent attributes.  */
 
-enum attr_type {ATTR_MACHINE_ATTRIBUTE, ATTR_LINK_ALIAS,
-		ATTR_LINK_SECTION, ATTR_WEAK_EXTERNAL};
+enum attr_type
+{
+  ATTR_MACHINE_ATTRIBUTE,
+  ATTR_LINK_ALIAS,
+  ATTR_LINK_SECTION,
+  ATTR_LINK_CONSTRUCTOR,
+  ATTR_LINK_DESTRUCTOR,
+  ATTR_WEAK_EXTERNAL
+};
 
 struct attrib
 {
@@ -359,6 +366,9 @@ enum standard_datatypes
 extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
 extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
 
+extern GTY(()) tree static_ctors;
+extern GTY(()) tree static_dtors;
+
 #define longest_float_type_node gnat_std_decls[(int) ADT_longest_float_type]
 #define void_type_decl_node gnat_std_decls[(int) ADT_void_type_decl]
 #define except_type_node gnat_std_decls[(int) ADT_except_type]

gcc/ada/misc.c

@@ -462,9 +462,9 @@ gnat_init_gcc_eh (void)
   using_eh_for_cleanups ();
 
   eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
-  default_init_unwind_resume_libfunc ();
   lang_eh_type_covers = gnat_eh_type_covers;
   lang_eh_runtime_type = gnat_eh_runtime_type;
+  default_init_unwind_resume_libfunc ();
 
   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
      the generation of the necessary exception runtime tables. The second one
@@ -634,6 +634,14 @@ gnat_expand_body (tree gnu_decl)
     return;
 
   tree_rest_of_compilation (gnu_decl);
+
+  if (DECL_STATIC_CONSTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+    targetm.asm_out.constructor (XEXP (DECL_RTL (gnu_decl), 0),
+                                 DEFAULT_INIT_PRIORITY);
+
+  if (DECL_STATIC_DESTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+    targetm.asm_out.destructor (XEXP (DECL_RTL (gnu_decl), 0),
+                                DEFAULT_INIT_PRIORITY);
 }
 
 /* Adjusts the RLI used to layout a record after all the fields have been

gcc/ada/par-prag.adb

@@ -1054,6 +1054,8 @@ begin
            Pragma_License                      |
            Pragma_Link_With                    |
            Pragma_Linker_Alias                 |
+           Pragma_Linker_Constructor           |
+           Pragma_Linker_Destructor            |
            Pragma_Linker_Options               |
            Pragma_Linker_Section               |
            Pragma_Locking_Policy               |

gcc/ada/snames.adb

@@ -262,6 +262,8 @@ package body Snames is
      "keep_names#" &
      "link_with#" &
      "linker_alias#" &
+     "linker_constructor#" &
+     "linker_destructor#" &
      "linker_options#" &
      "linker_section#" &
      "list#" &
@@ -322,7 +324,6 @@ package body Snames is
      "default#" &
      "dll#" &
      "win32#" &
-     "alias#" &
      "as_is#" &
      "attribute_name#" &
      "body_file_name#" &

gcc/ada/snames.h

@@ -307,55 +307,57 @@ extern unsigned char Get_Pragma_Id (int);
 #define  Pragma_Keep_Names                    93
 #define  Pragma_Link_With                     94
 #define  Pragma_Linker_Alias                  95
-#define  Pragma_Linker_Options                96
-#define  Pragma_Linker_Section                97
-#define  Pragma_List                          98
-#define  Pragma_Machine_Attribute             99
-#define  Pragma_Main                          100
-#define  Pragma_Main_Storage                  101
-#define  Pragma_Memory_Size                   102
-#define  Pragma_No_Return                     103
-#define  Pragma_Obsolescent                   104
-#define  Pragma_Optimize                      105
-#define  Pragma_Optional_Overriding           106
-#define  Pragma_Pack                          107
-#define  Pragma_Page                          108
-#define  Pragma_Passive                       109
-#define  Pragma_Preelaborate                  110
-#define  Pragma_Preelaborate_05               111
-#define  Pragma_Priority                      112
-#define  Pragma_Psect_Object                  113
-#define  Pragma_Pure                          114
-#define  Pragma_Pure_05                       115
-#define  Pragma_Pure_Function                 116
-#define  Pragma_Remote_Call_Interface         117
-#define  Pragma_Remote_Types                  118
-#define  Pragma_Share_Generic                 119
-#define  Pragma_Shared                        120
-#define  Pragma_Shared_Passive                121
-#define  Pragma_Source_Reference              122
-#define  Pragma_Stream_Convert                123
-#define  Pragma_Subtitle                      124
-#define  Pragma_Suppress_All                  125
-#define  Pragma_Suppress_Debug_Info           126
-#define  Pragma_Suppress_Initialization       127
-#define  Pragma_System_Name                   128
-#define  Pragma_Task_Info                     129
-#define  Pragma_Task_Name                     130
-#define  Pragma_Task_Storage                  131
-#define  Pragma_Thread_Body                   132
-#define  Pragma_Time_Slice                    133
-#define  Pragma_Title                         134
-#define  Pragma_Unchecked_Union               135
-#define  Pragma_Unimplemented_Unit            136
-#define  Pragma_Unreferenced                  137
-#define  Pragma_Unreserve_All_Interrupts      138
-#define  Pragma_Volatile                      139
-#define  Pragma_Volatile_Components           140
-#define  Pragma_Weak_External                 141
-#define  Pragma_AST_Entry                     142
-#define  Pragma_Interface                     143
-#define  Pragma_Storage_Size                  144
-#define  Pragma_Storage_Unit                  145
+#define  Pragma_Linker_Constructor            96
+#define  Pragma_Linker_Destructor             97
+#define  Pragma_Linker_Options                98
+#define  Pragma_Linker_Section                99
+#define  Pragma_List                          100
+#define  Pragma_Machine_Attribute             101
+#define  Pragma_Main                          102
+#define  Pragma_Main_Storage                  103
+#define  Pragma_Memory_Size                   104
+#define  Pragma_No_Return                     105
+#define  Pragma_Obsolescent                   106
+#define  Pragma_Optimize                      107
+#define  Pragma_Optional_Overriding           108
+#define  Pragma_Pack                          109
+#define  Pragma_Page                          110
+#define  Pragma_Passive                       111
+#define  Pragma_Preelaborate                  112
+#define  Pragma_Preelaborate_05               113
+#define  Pragma_Priority                      114
+#define  Pragma_Psect_Object                  115
+#define  Pragma_Pure                          116
+#define  Pragma_Pure_05                       117
+#define  Pragma_Pure_Function                 118
+#define  Pragma_Remote_Call_Interface         119
+#define  Pragma_Remote_Types                  120
+#define  Pragma_Share_Generic                 121
+#define  Pragma_Shared                        122
+#define  Pragma_Shared_Passive                123
+#define  Pragma_Source_Reference              124
+#define  Pragma_Stream_Convert                125
+#define  Pragma_Subtitle                      126
+#define  Pragma_Suppress_All                  127
+#define  Pragma_Suppress_Debug_Info           128
+#define  Pragma_Suppress_Initialization       129
+#define  Pragma_System_Name                   130
+#define  Pragma_Task_Info                     131
+#define  Pragma_Task_Name                     132
+#define  Pragma_Task_Storage                  133
+#define  Pragma_Thread_Body                   134
+#define  Pragma_Time_Slice                    135
+#define  Pragma_Title                         136
+#define  Pragma_Unchecked_Union               137
+#define  Pragma_Unimplemented_Unit            138
+#define  Pragma_Unreferenced                  139
+#define  Pragma_Unreserve_All_Interrupts      140
+#define  Pragma_Volatile                      141
+#define  Pragma_Volatile_Components           142
+#define  Pragma_Weak_External                 143
+#define  Pragma_AST_Entry                     144
+#define  Pragma_Interface                     145
+#define  Pragma_Storage_Size                  146
+#define  Pragma_Storage_Unit                  147
 
 /* End of snames.h (C version of Snames package spec) */

gcc/ada/trans.c

@@ -35,6 +35,7 @@
 #include "rtl.h"
 #include "expr.h"
 #include "ggc.h"
+#include "cgraph.h"
 #include "function.h"
 #include "except.h"
 #include "debug.h"
@@ -164,6 +165,7 @@ static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
 static tree gnat_stabilize_reference_1 (tree, bool);
 static void annotate_with_node (tree, Node_Id);
+static void build_global_cdtor (int, tree *);
 
 
 /* This is the main program of the back-end.  It sets up all the table
@@ -410,7 +412,11 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	       && (! DECL_RENAMING_GLOBAL_P (gnu_result)
 		   || global_bindings_p ())
 	       /* Make sure it's an lvalue like INDIRECT_REF.  */
-	       && (DECL_P (renamed_obj) || REFERENCE_CLASS_P (renamed_obj)))
+	       && (DECL_P (renamed_obj)
+		   || REFERENCE_CLASS_P (renamed_obj)
+		   || (TREE_CODE (renamed_obj) == VIEW_CONVERT_EXPR
+		       && (DECL_P (TREE_OPERAND (renamed_obj, 0))
+			   || REFERENCE_CLASS_P (TREE_OPERAND (renamed_obj,0))))))
 	gnu_result = renamed_obj;
       else
 	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
@@ -2445,6 +2451,15 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
   /* Generate elaboration code for this unit, if necessary, and say whether
      we did or not.  */
   pop_stack (&gnu_elab_proc_stack);
+
+  /* Generate functions to call static constructors and destructors
+     for targets that do not support .ctors/.dtors sections.  These
+     functions have magic names which are detected by collect2.  */
+  if (static_ctors)
+    build_global_cdtor ('I', &static_ctors);
+
+  if (static_dtors)
+    build_global_cdtor ('D', &static_dtors);
 }
 
 /* This function is the driver of the GNAT to GCC tree transformation
@@ -5353,8 +5368,8 @@ addressable_p (tree gnu_expr)
 
     case COMPONENT_REF:
       return (!DECL_BIT_FIELD (TREE_OPERAND (gnu_expr, 1))
-	      && (!DECL_NONADDRESSABLE_P (TREE_OPERAND (gnu_expr, 1))
-		  || !flag_strict_aliasing)
+	      && !(STRICT_ALIGNMENT
+		   && DECL_NONADDRESSABLE_P (TREE_OPERAND (gnu_expr, 1)))
 	      && addressable_p (TREE_OPERAND (gnu_expr, 0)));
 
     case ARRAY_REF:  case ARRAY_RANGE_REF:
@@ -5860,6 +5875,28 @@ gnat_stabilize_reference_1 (tree e, bool force)
   return result;
 }
 
+/* Build a global constructor or destructor function.  METHOD_TYPE gives
+   the type of the function and CDTORS points to the list of constructor
+   or destructor functions to be invoked.  FIXME: Migrate into cgraph.  */
+
+static void
+build_global_cdtor (int method_type, tree *cdtors)
+{
+  tree body = 0;
+
+  for (; *cdtors; *cdtors = TREE_CHAIN (*cdtors))
+    {
+      tree fn = TREE_VALUE (*cdtors);
+      tree fntype = TREE_TYPE (fn);
+      tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), fn);
+      tree fncall = build3 (CALL_EXPR, TREE_TYPE (fntype), fnaddr, NULL_TREE,
+			    NULL_TREE);
+      append_to_statement_list (fncall, &body);
+    }
+
+  cgraph_build_static_cdtor (method_type, body, DEFAULT_INIT_PRIORITY);
+}
+
 extern char *__gnat_to_canonical_file_spec (char *);
 
 /* Convert Sloc into *LOCUS (a location_t).  Return true if this Sloc

gcc/ada/utils.c

@@ -74,6 +74,11 @@ tree gnat_std_decls[(int) ADT_LAST];
 /* Functions to call for each of the possible raise reasons.  */
 tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
 
+/* List of functions called automatically at the beginning and
+   end of execution, on targets without .ctors/.dtors sections.  */
+tree static_ctors;
+tree static_dtors;
+
 /* Associates a GNAT tree node to a GCC tree node. It is used in
    `save_gnu_tree', `get_gnu_tree' and `present_gnu_tree'. See documentation
    of `save_gnu_tree' for more info.  */
@@ -1509,8 +1514,11 @@ process_attributes (tree decl, struct attrib *attr_list)
 	break;
 
       case ATTR_LINK_ALIAS:
+        if (! DECL_EXTERNAL (decl))
+	  {
 	    TREE_STATIC (decl) = 1;
 	    assemble_alias (decl, attr_list->name);
+	  }
 	break;
 
       case ATTR_WEAK_EXTERNAL:
@@ -1533,6 +1541,16 @@ process_attributes (tree decl, struct attrib *attr_list)
 	  post_error ("?section attributes are not supported for this target",
 		      attr_list->error_point);
 	break;
+
+      case ATTR_LINK_CONSTRUCTOR:
+	DECL_STATIC_CONSTRUCTOR (decl) = 1;
+	TREE_USED (decl) = 1;
+	break;
+
+      case ATTR_LINK_DESTRUCTOR:
+	DECL_STATIC_DESTRUCTOR (decl) = 1;
+	TREE_USED (decl) = 1;
+	break;
       }
 }
 
@@ -1728,6 +1746,14 @@ end_subprog_body (tree body)
   if (type_annotate_only)
     return;
 
+  /* If we don't have .ctors/.dtors sections, and this is a static
+     constructor or destructor, it must be recorded now.  */
+  if (DECL_STATIC_CONSTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
+    static_ctors = tree_cons (NULL_TREE, fndecl, static_ctors);
+
+  if (DECL_STATIC_DESTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
+    static_dtors = tree_cons (NULL_TREE, fndecl, static_dtors);
+
   /* We do different things for nested and non-nested functions.
      ??? This should be in cgraph.  */
   if (!DECL_CONTEXT (fndecl))