[multiple changes]

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* s-taskin.ads, s-tassta.adb, sem_ch13.adb: Minor reformatting.

2011-09-01  Thomas Quinot  <quinot@adacore.com>

	* Makefile.rtl: Move s-oscons.o from GNATRTL_TASKING_OBJS to
	GNATRTL_NONTASKING_OBJS.

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* einfo.ads (Is_Aliased): Fix existing documentation and add note on
	possibility of this flag being set for formals in Ada 2012 mode.
	* par-ch6.adb (P_Formal_Part): Handle aliased for parameters for Ada
	2012.
	* sem_ch6.adb (Process_Formals): Handle aliased parameters in Ada 2012
	mode.
	* sinfo.adb (Aliased_Present): Allowed in N_Parameter_Specification for
	Ada 2012.
	* sinfo.ads (Aliased_Present): Allowed in N_Parameter_Specification for
	Ada 2012.

2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Find_Insertion_Node): New routine. Determines the proper
	insertion node in a tree of nested Expression_With_Actions nodes.
	(Process_Transient_Object): In the case where a complex if statement
	has been converted into nested Expression_With_Actions nodes, the
	"hook" object and the associated access type must be inserted before
	the top most Expression_With_Actions.

From-SVN: r178401

11 files changed, 141 insertions, 51 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b8dea0d..57191fa 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,36 @@
 2011-09-01  Robert Dewar  <dewar@adacore.com>
 
+	* s-taskin.ads, s-tassta.adb, sem_ch13.adb: Minor reformatting.
+
+2011-09-01  Thomas Quinot  <quinot@adacore.com>
+
+	* Makefile.rtl: Move s-oscons.o from GNATRTL_TASKING_OBJS to
+	GNATRTL_NONTASKING_OBJS.
+
+2011-09-01  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads (Is_Aliased): Fix existing documentation and add note on
+	possibility of this flag being set for formals in Ada 2012 mode.
+	* par-ch6.adb (P_Formal_Part): Handle aliased for parameters for Ada
+	2012.
+	* sem_ch6.adb (Process_Formals): Handle aliased parameters in Ada 2012
+	mode.
+	* sinfo.adb (Aliased_Present): Allowed in N_Parameter_Specification for
+	Ada 2012.
+	* sinfo.ads (Aliased_Present): Allowed in N_Parameter_Specification for
+	Ada 2012.
+
+2011-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Find_Insertion_Node): New routine. Determines the proper
+	insertion node in a tree of nested Expression_With_Actions nodes.
+	(Process_Transient_Object): In the case where a complex if statement
+	has been converted into nested Expression_With_Actions nodes, the
+	"hook" object and the associated access type must be inserted before
+	the top most Expression_With_Actions.
+
+2011-09-01  Robert Dewar  <dewar@adacore.com>
+
 	* a-cbprqu.adb, a-cbprqu.ads, a-cuprqu.adb, a-cuprqu.ads,
 	a-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting.
 
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 7707300..30a9506 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -49,7 +49,6 @@ GNATRTL_TASKING_OBJS= \
   s-interr$(objext) \
   s-intman$(objext) \
   s-mudido$(objext) \
-  s-oscons$(objext) \
   s-osinte$(objext) \
   s-proinf$(objext) \
   s-solita$(objext) \
@@ -542,6 +541,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-memory$(objext) \
   s-multip$(objext) \
   s-os_lib$(objext) \
+  s-oscons$(objext) \
   s-osprim$(objext) \
   s-pack03$(objext) \
   s-pack05$(objext) \
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index ca9f7fd..c0dda86 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1997,8 +1997,9 @@ package Einfo is
 --       of pragma Ada_12 or Ada_2012.
 
 --    Is_Aliased (Flag15)
---       Present in objects whose declarations carry the keyword aliased,
---       and on record components that have the keyword.
+--       Present in all entities. Set for objects and types whose declarations
+--       carry the keyword aliased, and on record components that have the
+--       keyword. For Ada 2012, also applies to formal parameters.
 
 --    Is_AST_Entry (Flag132)
 --       Present in entry entities. Set if a valid pragma AST_Entry applies
@@ -4773,6 +4774,7 @@ package Einfo is
    --    Is_Ada_2005_Only                    (Flag185)
    --    Is_Ada_2012_Only                    (Flag199)
    --    Is_Bit_Packed_Array                 (Flag122)  (base type only)
+   --    Is_Aliased                          (Flag15)
    --    Is_Character_Type                   (Flag63)
    --    Is_Child_Unit                       (Flag73)
    --    Is_Compilation_Unit                 (Flag149)
@@ -4994,7 +4996,6 @@ package Einfo is
    --    Component_Alignment                 (special)  (base type only)
    --    Has_Component_Size_Clause           (Flag68)   (base type only)
    --    Has_Pragma_Pack                     (Flag121)  (impl base type only)
-   --    Is_Aliased                          (Flag15)
    --    Is_Constrained                      (Flag12)
    --    Next_Index                          (synth)
    --    Number_Dimensions                   (synth)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 3811e19..00ebdbb 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4415,10 +4415,32 @@ package body Exp_Ch4 is
       ------------------------------
 
       procedure Process_Transient_Object (Decl : Node_Id) is
-         Ins_Nod : constant Node_Id := Parent (N);
-         --  To avoid the insertion of generated code in the list of Actions,
-         --  Insert_Action must look at the parent field of the EWA.
 
+         function Find_Insertion_Node return Node_Id;
+         --  Complex if statements may be converted into nested EWAs. In this
+         --  case, any generated code must be inserted before the if statement
+         --  to ensure proper visibility of the "hook" objects. This routine
+         --  returns the top most short circuit operator or the parent of the
+         --  EWA if no nesting was detected.
+
+         -------------------------
+         -- Find_Insertion_Node --
+         -------------------------
+
+         function Find_Insertion_Node return Node_Id is
+            Par : Node_Id := N;
+
+         begin
+            --  Climb up the branches of a complex if statement
+
+            while Nkind_In (Parent (Par), N_And_Then, N_Op_Not, N_Or_Else) loop
+               Par := Parent (Par);
+            end loop;
+
+            return Par;
+         end Find_Insertion_Node;
+
+         Ins_Nod   : constant Node_Id    := Find_Insertion_Node;
          Loc       : constant Source_Ptr := Sloc (Decl);
          Obj_Id    : constant Entity_Id  := Defining_Identifier (Decl);
          Obj_Typ   : constant Entity_Id  := Etype (Obj_Id);
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 97dd084..167f43e 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1186,8 +1186,8 @@ package body Ch6 is
    --  FORMAL_PART ::= (PARAMETER_SPECIFICATION {; PARAMETER_SPECIFICATION})
 
    --  PARAMETER_SPECIFICATION ::=
-   --    DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK
-   --      [:= DEFAULT_EXPRESSION]
+   --    DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
+   --      SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
    --  | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
    --      [:= DEFAULT_EXPRESSION]
 
@@ -1195,6 +1195,8 @@ package body Ch6 is
    --  that the initial token is a left parenthesis, and skipped past it, so
    --  that on entry Token is the first token following the left parenthesis.
 
+   --  Note: The ALIASED keyword is allowed only in Ada 2012 mode (AI 142)
+
    --  Error recovery: cannot raise Error_Resync
 
    function P_Formal_Part return List_Id is
@@ -1235,9 +1237,11 @@ package body Ch6 is
 
                if Token /= Tok_Comma then
 
-                  --  Assume colon if IN or OUT keyword found
+                  --  Assume colon if ALIASED, IN or OUT keyword found
 
-                  exit Ident_Loop when Token = Tok_In or else Token = Tok_Out;
+                  exit Ident_Loop when Token = Tok_Aliased or else
+                                       Token = Tok_In      or else
+                                       Token = Tok_Out;
 
                   --  Otherwise scan ahead
 
@@ -1303,6 +1307,18 @@ package body Ch6 is
                  New_Node (N_Parameter_Specification, Ident_Sloc);
                Set_Defining_Identifier (Specification_Node, Idents (Ident));
 
+               --  Scan possible ALIASED for Ada 2012 (AI-142)
+
+               if Token = Tok_Aliased then
+                  if Ada_Version < Ada_2012 then
+                     Error_Msg_SC ("ALIASED parameter is an Ada2012 feature");
+                  else
+                     Set_Aliased_Present (Specification_Node);
+                  end if;
+
+                  Scan; -- past ALIASED
+               end if;
+
                --  Scan possible NOT NULL for Ada 2005 (AI-231, AI-447)
 
                Not_Null_Sloc := Token_Ptr;
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 6200d20..8b4e61a 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -415,22 +415,24 @@ package System.Tasking is
    --  We need to store whether there are tasks allocated to concrete
    --  processors in the default system dispatching domain because we need to
    --  check it before creating a new dispatching domain. Two comments about
-   --  the reason why we use a pointer here and not in package
-   --  Dispatching_Domains.
-   --  1) We use an array created dynamically in procedure Initialize which is
-   --  called at the beginning of the initialization of the run-time library.
-   --  Declaring a static array here in the spec would not work across
-   --  different installations because it would get the value of Number_Of_CPUs
-   --  from the machine where the run-time library is built, and not from the
-   --  machine where the application is executed. That is the reason why we
-   --  create the array (CPU'First .. Number_Of_CPUs) at execution time in the
-   --  procedure body, ensuring that the function Number_Of_CPUs is executed at
-   --  execution time (the same trick as we use for System_Domain).
-   --  2) We have moved this declaration from package Dispatching_Domains
-   --  because when we use a pragma CPU, the affinity is passed through the
-   --  call to Create_Task. Hence, at this point, we may need to update the
-   --  number of tasks associated to the processor, but we do not want to force
-   --  a dependency from this package on Dispatching_Domains.
+   --  why we use a pointer here and not in package Dispatching_Domains:
+   --
+   --    1) We use an array created dynamically in procedure Initialize which
+   --    is called at the beginning of the initialization of the run-time
+   --    library. Declaring a static array here in the spec would not work
+   --    across different installations because it would get the value of
+   --    Number_Of_CPUs from the machine where the run-time library is built,
+   --    and not from the machine where the application is executed. That is
+   --    the reason why we create the array (CPU'First .. Number_Of_CPUs) at
+   --    execution time in the procedure body, ensuring that the function
+   --    Number_Of_CPUs is executed at execution time (the same trick as we
+   --    use for System_Domain).
+   --
+   --    2) We have moved this declaration from package Dispatching_Domains
+   --    because when we use a pragma CPU, the affinity is passed through the
+   --    call to Create_Task. Hence, at this point, we may need to update the
+   --    number of tasks associated to the processor, but we do not want to
+   --    force a dependency from this package on Dispatching_Domains.
 
    ------------------------------------
    -- Task related other definitions --
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 3711ce3..224b197 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -659,21 +659,21 @@ package body System.Tasking.Stages is
       --  The CPU associated to the task (if any) must belong to the
       --  dispatching domain.
 
-      if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
-        (Base_CPU not in T.Common.Domain'Range
-         or else not T.Common.Domain (Base_CPU))
+      if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
+        and then
+          (Base_CPU not in T.Common.Domain'Range
+            or else not T.Common.Domain (Base_CPU))
       then
          Initialization.Undefer_Abort_Nestable (Self_ID);
          raise Tasking_Error with "CPU not in dispatching domain";
       end if;
 
-      --  In order to handle the interaction between pragma CPU and
-      --  dispatching domains we need to signal that this task is being
-      --  allocated to a processor. This is needed only for tasks belonging to
-      --  the system domain (the creation of new dispatching domains can only
-      --  take processors from the system domain) and only before the
-      --  environment task calls the main procedure (dispatching domains cannot
-      --  be created after this).
+      --  To handle the interaction between pragma CPU and dispatching domains
+      --  we need to signal that this task is being allocated to a processor.
+      --  This is needed only for tasks belonging to the system domain (the
+      --  creation of new dispatching domains can only take processors from the
+      --  system domain) and only before the environment task calls the main
+      --  procedure (dispatching domains cannot be created after this).
 
       if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
         and then T.Common.Domain = System.Tasking.System_Domain
@@ -686,9 +686,8 @@ package body System.Tasking.Stages is
            Dispatching_Domain_Tasks (Base_CPU) + 1;
       end if;
 
-      --  Note: we should not call 'new' while holding locks since new
-      --  may use locks (e.g. RTS_Lock under Windows) itself and cause a
-      --  deadlock.
+      --  Note: we should not call 'new' while holding locks since new may use
+      --  locks (e.g. RTS_Lock under Windows) itself and cause a deadlock.
 
       if Build_Entry_Names then
          T.Entry_Names :=
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0eb4ed7..17f49a8 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1152,9 +1152,10 @@ package body Sem_Ch13 is
                when Aspect_Priority           |
                     Aspect_Interrupt_Priority |
                     Aspect_Dispatching_Domain |
-                    Aspect_CPU                  =>
+                    Aspect_CPU                =>
                   declare
                      Pname : Name_Id;
+
                   begin
                      if A_Id = Aspect_Priority then
                         Pname := Name_Priority;
@@ -1505,7 +1506,7 @@ package body Sem_Ch13 is
                      when Aspect_Priority           |
                           Aspect_Interrupt_Priority |
                           Aspect_Dispatching_Domain |
-                          Aspect_CPU                  =>
+                          Aspect_CPU                =>
                         declare
                            T : Node_Id; -- the type declaration
                            L : List_Id; -- list of decls of task/protected
@@ -1513,7 +1514,6 @@ package body Sem_Ch13 is
                         begin
                            if Nkind (N) = N_Object_Declaration then
                               T := Parent (Etype (Defining_Identifier (N)));
-
                            else
                               T := N;
                            end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 242cfcb..e84d8f5 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8900,7 +8900,6 @@ package body Sem_Ch6 is
                elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
                                                N_Access_Procedure_Definition)
                then
-
                   --  AI05-0151: Tagged incomplete types are allowed in all
                   --  formal parts. Untagged incomplete types are not allowed
                   --  in bodies.
@@ -8935,6 +8934,14 @@ package body Sem_Ch6 is
                   Parameter_Type (Param_Spec), Formal_Type);
             end if;
 
+            --  Ada 2012 (AI-142): Handle aliased parameters
+
+            if Ada_Version >= Ada_2012
+              and then Aliased_Present (Param_Spec)
+            then
+               Set_Is_Aliased (Formal);
+            end if;
+
             --  Ada 2005 (AI-231): Create and decorate an internal subtype
             --  declaration corresponding to the null-excluding type of the
             --  formal in the enclosing scope. Finally, replace the parameter
@@ -9005,6 +9012,8 @@ package body Sem_Ch6 is
 
          Set_Etype (Formal, Formal_Type);
 
+         --  Deal with default expression if present
+
          Default := Expression (Param_Spec);
 
          if Present (Default) then
@@ -9118,6 +9127,12 @@ package body Sem_Ch6 is
             Num_Out_Params := Num_Out_Params + 1;
          end if;
 
+         --  Force call by reference if aliased
+
+         if Is_Aliased (Formal) then
+            Set_Mechanism (Formal, By_Reference);
+         end if;
+
          Next (Param_Spec);
       end loop;
 
@@ -9579,8 +9594,7 @@ package body Sem_Ch6 is
          if Ekind (Designator) /= E_Procedure then
             declare
                Rent : constant Entity_Id :=
-                        Make_Defining_Identifier (Loc,
-                          Chars => Name_uResult);
+                        Make_Defining_Identifier (Loc, Name_uResult);
                Ftyp : constant Entity_Id := Etype (Designator);
 
             begin
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 4c9d6aa..67baab9 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -206,7 +206,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Definition
-        or else NT (N).Nkind = N_Object_Declaration);
+        or else NT (N).Nkind = N_Object_Declaration
+        or else NT (N).Nkind = N_Parameter_Specification);
       return Flag4 (N);
    end Aliased_Present;
 
@@ -3265,7 +3266,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Component_Definition
-        or else NT (N).Nkind = N_Object_Declaration);
+        or else NT (N).Nkind = N_Object_Declaration
+        or else NT (N).Nkind = N_Parameter_Specification);
       Set_Flag4 (N, Val);
    end Set_Aliased_Present;
 
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 5e520cb..af6fab2 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2322,7 +2322,7 @@ package Sinfo is
       --  N_Object_Declaration
       --  Sloc points to first identifier
       --  Defining_Identifier (Node1)
-      --  Aliased_Present (Flag4) set if ALIASED appears
+      --  Aliased_Present (Flag4)
       --  Constant_Present (Flag17) set if CONSTANT appears
       --  Null_Exclusion_Present (Flag11)
       --  Object_Definition (Node4) subtype indic./array type def./access def.
@@ -4514,8 +4514,8 @@ package Sinfo is
       ----------------------------------
 
       --  PARAMETER_SPECIFICATION ::=
-      --    DEFINING_IDENTIFIER_LIST : MODE [NULL_EXCLUSION] SUBTYPE_MARK
-      --      [:= DEFAULT_EXPRESSION]
+      --    DEFINING_IDENTIFIER_LIST : [ALIASED] MODE [NULL_EXCLUSION]
+      --      SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
       --  | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
       --      [:= DEFAULT_EXPRESSION]
 
@@ -4527,9 +4527,12 @@ package Sinfo is
       --  Prev_Ids flags to preserve the original source form as described
       --  in the section on "Handling of Defining Identifier Lists".
 
+      --  ALIASED can only be present in Ada 2012 mode
+
       --  N_Parameter_Specification
       --  Sloc points to first identifier
       --  Defining_Identifier (Node1)
+      --  Aliased_Present (Flag4)
       --  In_Present (Flag15)
       --  Out_Present (Flag17)
       --  Null_Exclusion_Present (Flag11)