exp_prag.adb (Expand_Pragma_Common_Object): Use a single Machine_Attribute…

exp_prag.adb (Expand_Pragma_Common_Object): Use a single Machine_Attribute pragma internally to implement the user pragma.

2006-10-31  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb (Expand_Pragma_Common_Object): Use a single
	Machine_Attribute pragma internally to implement the user pragma.
	Add processing for pragma Interface so that it is now completely
	equivalent to pragma Import.

	* sem_prag.adb (Analyze_Pragma, case Obsolescent): Extend this pragma
	so that it can be applied to all entities, including record components
	and enumeration literals.
	(Analyze_Pragma, case Priority_Specific_Dispatching): Check whether
	priority ranges are correct, verify compatibility against task
	dispatching and locking policies, and if everything is correct an entry
	is added to the table containing priority specific dispatching entries
	for this compilation unit.
	(Delay_Config_Pragma_Analyze): Delay processing
	Priority_Specific_Dispatching pragmas because when processing the
	pragma we need to access run-time data, such as the range of
	System.Any_Priority.
	(Sig_Flags): Add Pragma_Priority_Specific_Dispatching.
	Allow pragma Unreferenced as a context item
	Add pragma Preelaborable_Initialization
	(Analyze_Pragma, case Interface): Interface is extended so that it is
	now syntactically and semantically equivalent to Import.
	(Analyze_Pragma, case Compile_Time_Warning): Fix error of blowups on
	insertion characters.
	Add handling for Pragma_Wide_Character_Encoding
	(Process_Restrictions_Restriction_Warnings): Ensure that a warning
	never supercedes a real restriction, and that a real restriction
	always supercedes a warning.
	(Analyze_Pragma, case Assert): Set Low_Bound_Known if assert is of
	appropriate form.

From-SVN: r118268

gcc/ada/exp_prag.adb

@@ -63,7 +63,7 @@ package body Exp_Prag is
    procedure Expand_Pragma_Abort_Defer             (N : Node_Id);
    procedure Expand_Pragma_Assert                  (N : Node_Id);
    procedure Expand_Pragma_Common_Object           (N : Node_Id);
-   procedure Expand_Pragma_Import                  (N : Node_Id);
+   procedure Expand_Pragma_Import_Or_Interface     (N : Node_Id);
    procedure Expand_Pragma_Import_Export_Exception (N : Node_Id);
    procedure Expand_Pragma_Inspection_Point        (N : Node_Id);
    procedure Expand_Pragma_Interrupt_Priority      (N : Node_Id);
@@ -136,7 +136,7 @@ package body Exp_Prag is
                Expand_Pragma_Import_Export_Exception (N);
 
             when Pragma_Import =>
-               Expand_Pragma_Import (N);
+               Expand_Pragma_Import_Or_Interface (N);
 
             when Pragma_Import_Exception =>
                Expand_Pragma_Import_Export_Exception (N);
@@ -144,6 +144,9 @@ package body Exp_Prag is
             when Pragma_Inspection_Point =>
                Expand_Pragma_Inspection_Point (N);
 
+            when Pragma_Interface =>
+               Expand_Pragma_Import_Or_Interface (N);
+
             when Pragma_Interrupt_Priority =>
                Expand_Pragma_Interrupt_Priority (N);
 
@@ -299,19 +302,12 @@ package body Exp_Prag is
    -- Expand_Pragma_Common_Object --
    ---------------------------------
 
-   --  Add series of pragmas to replicate semantic effect in DEC Ada
+   --  Use a machine attribute to replicate semantic effect in DEC Ada
 
-   --    pragma Linker_Section (internal_name, external_name);
-   --    pragma Machine_Attribute (internal_name, "overlaid");
-   --    pragma Machine_Attribute (internal_name, "global");
-   --    pragma Machine_Attribute (internal_name, "initialize");
+   --    pragma Machine_Attribute (intern_name, "common_object", extern_name);
 
    --  For now we do nothing with the size attribute ???
 
-   --  Really this expansion would be much better in the back end. The
-   --  front end should not need to know about target dependent, back end
-   --  dependent semantics ???
-
    procedure Expand_Pragma_Common_Object (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
@@ -351,34 +347,9 @@ package body Exp_Prag is
 
       Ploc := Sloc (Psect);
 
-      --  Insert pragmas
-
-      Insert_List_After_And_Analyze (N, New_List (
-
-         --  The Linker_Section pragma ensures the correct section
-
-         Make_Pragma (Loc,
-           Chars => Name_Linker_Section,
-           Pragma_Argument_Associations => New_List (
-             Make_Pragma_Argument_Association (Iloc,
-               Expression => New_Copy_Tree (Internal)),
-             Make_Pragma_Argument_Association (Ploc,
-               Expression => New_Copy_Tree (Psect)))),
-
-         --  Machine_Attribute "overlaid" ensures that this section
-         --  overlays any other sections of the same name.
-
-         Make_Pragma (Loc,
-           Chars => Name_Machine_Attribute,
-           Pragma_Argument_Associations => New_List (
-             Make_Pragma_Argument_Association (Iloc,
-               Expression => New_Copy_Tree (Internal)),
-             Make_Pragma_Argument_Association (Eloc,
-               Expression =>
-                 Make_String_Literal (Sloc => Ploc,
-                   Strval => "overlaid")))),
+      --  Insert the pragma
 
-         --  Machine_Attribute "global" ensures that section is visible
+      Insert_After_And_Analyze (N,
 
          Make_Pragma (Loc,
            Chars => Name_Machine_Attribute,
@@ -388,24 +359,15 @@ package body Exp_Prag is
              Make_Pragma_Argument_Association (Eloc,
                Expression =>
                  Make_String_Literal (Sloc => Ploc,
-                   Strval => "global")))),
-
-         --  Machine_Attribute "initialize" ensures section is demand zeroed
+                   Strval => "common_object")),
+             Make_Pragma_Argument_Association (Ploc,
+               Expression => New_Copy_Tree (Psect)))));
 
-         Make_Pragma (Loc,
-           Chars => Name_Machine_Attribute,
-           Pragma_Argument_Associations => New_List (
-             Make_Pragma_Argument_Association (Iloc,
-               Expression => New_Copy_Tree (Internal)),
-             Make_Pragma_Argument_Association (Eloc,
-               Expression =>
-                 Make_String_Literal (Sloc => Ploc,
-                   Strval => "initialize"))))));
    end Expand_Pragma_Common_Object;
 
-   --------------------------
-   -- Expand_Pragma_Import --
-   --------------------------
+   ---------------------------------------
+   -- Expand_Pragma_Import_Or_Interface --
+   ---------------------------------------
 
    --  When applied to a variable, the default initialization must not be
    --  done. As it is already done when the pragma is found, we just get rid
@@ -418,7 +380,7 @@ package body Exp_Prag is
    --  have to elaborate the initialization expression when it is first
    --  seen (i.e. this elaboration cannot be deferred to the freeze point).
 
-   procedure Expand_Pragma_Import (N : Node_Id) is
+   procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
       Def_Id    : constant Entity_Id := Entity (Arg2 (N));
       Typ       : Entity_Id;
       Init_Call : Node_Id;
@@ -455,7 +417,7 @@ package body Exp_Prag is
             Set_Expression (Parent (Def_Id), Empty);
          end if;
       end if;
-   end Expand_Pragma_Import;
+   end Expand_Pragma_Import_Or_Interface;
 
    -------------------------------------------
    -- Expand_Pragma_Import_Export_Exception --