2008-04-14 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r134275

	stilly buggy for libgcc muldi3: internal compiler error: in
	execute_ipa_pass_list, at passes.c:1235



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@134279 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 61 insertions, 27 deletions

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b48c8a95446..a5cb1db6694 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -139,6 +139,13 @@ package Sem_Util is
    --  N is one of the statement forms that is a potentially blocking
    --  operation. If it appears within a protected action, emit warning.
 
+   procedure Check_Unprotected_Access
+     (Context : Node_Id;
+      Expr    : Node_Id);
+   --  Check whether the expression is a pointer to a protected component,
+   --  and the context is external to the protected operation, to warn against
+   --  a possible unlocked access to data.
+
    procedure Check_VMS (Construct : Node_Id);
    --  Check that this the target is OpenVMS, and if so, return with
    --  no effect, otherwise post an error noting this can only be used
@@ -196,6 +203,12 @@ package Sem_Util is
    --  Sets the Has_Delayed_Freeze flag of New if the Delayed_Freeze flag
    --  of Old is set and Old has no yet been Frozen (i.e. Is_Frozen is false);
 
+   function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
+   --  Utility to create a parameter profile for a new subprogram spec,
+   --  when the subprogram has a body that acts as spec. This is done for
+   --  some cases of inlining, and for private protected ops. Also used
+   --  to create bodies for stubbed subprograms.
+
    function Current_Entity (N : Node_Id) return Entity_Id;
    --  Find the currently visible definition for a given identifier, that is to
    --  say the first entry in the visibility chain for the Chars of N.
@@ -232,6 +245,9 @@ package Sem_Util is
    --  components of protected types, and constraint checks on entry
    --  families constrained by discriminants.
 
+   function Denotes_Variable (N : Node_Id) return Boolean;
+   --  Returns True if node N denotes a single variable without parentheses.
+
    function Depends_On_Discriminant (N : Node_Id) return Boolean;
    --  Returns True if N denotes a discriminant or if N is a range, a subtype
    --  indication or a scalar subtype where one of the bounds is a
@@ -425,7 +441,7 @@ package Sem_Util is
       Pos : Uint;
       Loc : Source_Ptr) return Entity_Id;
    --  This function obtains the E_Enumeration_Literal entity for the
-   --  specified value from the enumneration type or subtype T. The
+   --  specified value from the enumeration type or subtype T. The
    --  second argument is the Pos value, which is assumed to be in range.
    --  The third argument supplies a source location for constructed
    --  nodes returned by this function.
@@ -474,11 +490,13 @@ package Sem_Util is
    --  declaration.
 
    function Has_Access_Values (T : Entity_Id) return Boolean;
-   --  Returns true if type or subtype T is an access type, or has a
-   --  component (at any recursive level) that is an access type. This
-   --  is a conservative predicate, if it is not known whether or not
-   --  T contains access values (happens for generic formals in some
-   --  cases), then False is returned.
+   --  Returns true if type or subtype T is an access type, or has a component
+   --  (at any recursive level) that is an access type. This is a conservative
+   --  predicate, if it is not known whether or not T contains access values
+   --  (happens for generic formals in some cases), then False is returned.
+   --  Note that tagged types return False. Even though the tag is implemented
+   --  as an access type internally, this function tests only for access types
+   --  known to the programmer. See also Has_Tagged_Component.
 
    function Has_Abstract_Interfaces
      (T             : Entity_Id;
@@ -527,8 +545,12 @@ package Sem_Util is
    function Has_Null_Exclusion (N : Node_Id) return Boolean;
    --  Determine whether node N has a null exclusion
 
+   function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
+   --  Predicate to determine whether a controlled type has a user-defined
+   --  initialize procedure, which makes the type not preelaborable.
+
    function Has_Preelaborable_Initialization (E : Entity_Id) return Boolean;
-   --  Return True iff type E has preelaborable initialiation as defined in
+   --  Return True iff type E has preelaborable initialisation as defined in
    --  Ada 2005 (see AI-161 for details of the definition of this attribute).
 
    function Has_Private_Component (Type_Id : Entity_Id) return Boolean;
@@ -544,8 +566,11 @@ package Sem_Util is
    --  if there is no underlying type).
 
    function Has_Tagged_Component (Typ : Entity_Id) return Boolean;
-   --  Typ must be a composite type (array or record). This function is used
-   --  to check if '=' has to be expanded into a bunch component comparaisons.
+   --  Returns True if Typ is a composite type (array or record) which is
+   --  either itself a tagged type, or has a component (recursively) which is
+   --  a tagged type. Returns False for non-composite type, or if no tagged
+   --  component is present. This function is used to check if '=' has to be
+   --  expanded into a bunch component comparisons.
 
    function In_Instance return Boolean;
    --  Returns True if the current scope is within a generic instance
@@ -668,7 +693,7 @@ package Sem_Util is
    --  i.e. a library unit or an entity declared in a library package.
 
    function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean;
-   --  Determines whether Expr is a refeference to a variable or IN OUT
+   --  Determines whether Expr is a reference to a variable or IN OUT
    --  mode parameter of the current enclosing subprogram.
    --  Why are OUT parameters not considered here ???
 
@@ -725,7 +750,7 @@ package Sem_Util is
    function Is_Selector_Name (N : Node_Id) return Boolean;
    --  Given an N_Identifier node N, determines if it is a Selector_Name.
    --  As described in Sinfo, Selector_Names are special because they
-   --  represent use of the N_Identifier node for a true identifer, when
+   --  represent use of the N_Identifier node for a true identifier, when
    --  normally such nodes represent a direct name.
 
    function Is_Statement (N : Node_Id) return Boolean;
@@ -773,14 +798,15 @@ package Sem_Util is
    --  entities in the current scope and in any parent scopes if the current
    --  scope is a block or a package (and that recursion continues to the top
    --  scope that is not a block or a package). This is used when the
-   --  sequential flow-of-control assumption is violated (occurence of a label,
-   --  head of a loop, or start of an exception handler). The effect of the
-   --  call is to clear the Constant_Value field (but we do not need to clear
-   --  the Is_True_Constant flag, since that only gets reset if there really is
-   --  an assignment somewhere in the entity scope). This procedure also calls
-   --  Kill_All_Checks, since this is a special case of needing to forget saved
-   --  values. This procedure also clears Is_Known_Non_Null flags in variables,
-   --  constants or parameters since these are also not known to be valid.
+   --  sequential flow-of-control assumption is violated (occurrence of a
+   --  label, head of a loop, or start of an exception handler). The effect of
+   --  the call is to clear the Constant_Value field (but we do not need to
+   --  clear the Is_True_Constant flag, since that only gets reset if there
+   --  really is an assignment somewhere in the entity scope). This procedure
+   --  also calls Kill_All_Checks, since this is a special case of needing to
+   --  forget saved values. This procedure also clears Is_Known_Non_Null flags
+   --  in variables, constants or parameters since these are also not known to
+   --  be valid.
    --
    --  The Last_Assignment_Only flag is set True to clear only Last_Assignment
    --  fields and leave other fields unchanged. This is used when we encounter
@@ -801,10 +827,10 @@ package Sem_Util is
    --  set if you want to clear only the Last_Assignment field (see above).
 
    procedure Kill_Size_Check_Code (E : Entity_Id);
-   --  Called when an address clause or pragma Import is applied to an
-   --  entity. If the entity is a variable or a constant, and size check
-   --  code is present, this size check code is killed, since the object
-   --  will not be allocated by the program.
+   --  Called when an address clause or pragma Import is applied to an entity.
+   --  If the entity is a variable or a constant, and size check code is
+   --  present, this size check code is killed, since the object will not
+   --  be allocated by the program.
 
    function Known_To_Be_Assigned (N : Node_Id) return Boolean;
    --  The node N is an entity reference. This function determines whether the
@@ -889,7 +915,7 @@ package Sem_Util is
    --  next entry of the Parameter_Associations list. The argument is an
    --  actual previously returned by a call to First_Actual or Next_Actual.
    --  Note that the result produced is always an expression, not a parameter
-   --  assciation node, even if named notation was used.
+   --  association node, even if named notation was used.
 
    procedure Normalize_Actuals
      (N       : Node_Id;
@@ -897,16 +923,20 @@ package Sem_Util is
       Report  : Boolean;
       Success : out Boolean);
    --  Reorders lists of actuals according to names of formals, value returned
-   --  in Success indicates sucess of reordering. For more details, see body.
+   --  in Success indicates success of reordering. For more details, see body.
    --  Errors are reported only if Report is set to True.
 
-   procedure Note_Possible_Modification (N : Node_Id);
+   procedure Note_Possible_Modification (N : Node_Id; Sure : Boolean);
    --  This routine is called if the sub-expression N maybe the target of
    --  an assignment (e.g. it is the left side of an assignment, used as
    --  an out parameters, or used as prefixes of access attributes). It
    --  sets May_Be_Modified in the associated entity if there is one,
    --  taking into account the rule that in the case of renamed objects,
    --  it is the flag in the renamed object that must be set.
+   --
+   --  The parameter Sure is set True if the modification is sure to occur
+   --  (e.g. target of assignment, or out parameter), and to False if the
+   --  modification is only potential (e.g. address of entity taken).
 
    function Object_Access_Level (Obj : Node_Id) return Uint;
    --  Return the accessibility level of the view of the object Obj.
@@ -993,7 +1023,7 @@ package Sem_Util is
 
    function Same_Object (Node1, Node2 : Node_Id) return Boolean;
    --  Determine if Node1 and Node2 are known to designate the same object.
-   --  This is a semantic test and both nodesmust be fully analyzed. A result
+   --  This is a semantic test and both nodes must be fully analyzed. A result
    --  of True is decisively correct. A result of False does not necessarily
    --  mean that different objects are designated, just that this could not
    --  be reliably determined at compile time.
@@ -1057,6 +1087,10 @@ package Sem_Util is
    --  parameters are already members of a list, and do not need to be
    --  chained separately. See also First_Actual and Next_Actual.
 
+   procedure Set_Optimize_Alignment_Flags (E : Entity_Id);
+   pragma Inline (Set_Optimize_Alignment_Flags);
+   --  Sets Optimize_Aliignment_Space/Time flags in E from current settings
+
    procedure Set_Public_Status (Id : Entity_Id);
    --  If an entity (visible or otherwise) is defined in a library
    --  package, or a package that is itself public, then this subprogram