Commit 4017021b by Arnaud Charlet

[multiple changes]

2009-04-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Task_Name): Do not expand argument
	of pragma. It will be recopied and analyzed when used in call to
	Create_Task.

	* sem_res.adb (Resolve_Call): Clarify use of secondary stack within
	initialization operations and recognize use of it in procedure calls
	within init_procs.

	* exp_ch9.adb (Make_Task_Create_Call): Copy full tree of Task_Name
	argument, because it may have side-effects.

	* exp_ch2.adb: Remove obsolete comments on default functions

2009-04-10  Jose Ruiz  <ruiz@adacore.com>

	* adaint.c (RTX section): Do for RTX the same thing as we do for
	Windows (include ctype.h and define a fallback ISALPHA if IN_RTS).

From-SVN: r145882
parent 24357840
2009-04-10 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Task_Name): Do not expand argument
of pragma. It will be recopied and analyzed when used in call to
Create_Task.
* sem_res.adb (Resolve_Call): Clarify use of secondary stack within
initialization operations and recognize use of it in procedure calls
within init_procs.
* exp_ch9.adb (Make_Task_Create_Call): Copy full tree of Task_Name
argument, because it may have side-effects.
* exp_ch2.adb: Remove obsolete comments on default functions
2009-04-10 Jose Ruiz <ruiz@adacore.com>
* adaint.c (RTX section): Do for RTX the same thing as we do for
Windows (include ctype.h and define a fallback ISALPHA if IN_RTS).
2009-04-10 Robert Dewar <dewar@adacore.com> 2009-04-10 Robert Dewar <dewar@adacore.com>
* sem_aux.ads, sem_aux.adb (Nearest_Current_Scope): New function. * sem_aux.ads, sem_aux.adb (Nearest_Current_Scope): New function.
...@@ -75,14 +75,15 @@ ...@@ -75,14 +75,15 @@
#include "version.h" #include "version.h"
#endif #endif
#if defined (__MINGW32__)
#if defined (RTX) #if defined (RTX)
#include <windows.h> #include <windows.h>
#include <Rtapi.h> #include <Rtapi.h>
#include <sys/utime.h> #else
#elif defined (__MINGW32__)
#include "mingw32.h" #include "mingw32.h"
#endif
#include <sys/utime.h> #include <sys/utime.h>
/* For isalpha-like tests in the compiler, we're expected to resort to /* For isalpha-like tests in the compiler, we're expected to resort to
......
...@@ -267,11 +267,9 @@ package body Exp_Ch2 is ...@@ -267,11 +267,9 @@ package body Exp_Ch2 is
end loop; end loop;
-- If the discriminant occurs within the default expression for a -- If the discriminant occurs within the default expression for a
-- formal of an entry or protected operation, create a default -- formal of an entry or protected operation, replace it with a
-- function for it, and replace the discriminant with a reference to -- reference to the discriminant of the formal of the enclosing
-- the discriminant of the formal of the default function. The -- operation.
-- discriminant entity is the one defined in the corresponding
-- record.
if Present (Parent_P) if Present (Parent_P)
and then Present (Corresponding_Spec (Parent_P)) and then Present (Corresponding_Spec (Parent_P))
...@@ -284,8 +282,9 @@ package body Exp_Ch2 is ...@@ -284,8 +282,9 @@ package body Exp_Ch2 is
Disc : Entity_Id; Disc : Entity_Id;
begin begin
-- Verify that we are within a default function: the type of -- Verify that we are within the body of an entry or protected
-- its formal parameter is the same task or protected type. -- operation. Its first formal parameter is the synchronized
-- type itself.
if Present (Formal) if Present (Formal)
and then Etype (Formal) = Scope (Entity (N)) and then Etype (Formal) = Scope (Entity (N))
......
...@@ -11990,8 +11990,11 @@ package body Exp_Ch9 is ...@@ -11990,8 +11990,11 @@ package body Exp_Ch9 is
if Present (Tdef) if Present (Tdef)
and then Has_Task_Name_Pragma (Tdef) and then Has_Task_Name_Pragma (Tdef)
then then
-- Copy expression in full, because it may be dynamic and have
-- side effects.
Append_To (Args, Append_To (Args,
New_Copy ( New_Copy_Tree (
Expression (First ( Expression (First (
Pragma_Argument_Associations ( Pragma_Argument_Associations (
Find_Task_Or_Protected_Pragma Find_Task_Or_Protected_Pragma
......
...@@ -11168,7 +11168,11 @@ package body Sem_Prag is ...@@ -11168,7 +11168,11 @@ package body Sem_Prag is
Check_Arg_Count (1); Check_Arg_Count (1);
Arg := Expression (Arg1); Arg := Expression (Arg1);
Analyze_And_Resolve (Arg, Standard_String);
-- The expression is used in the call to create_task, and must
-- be expanded there, not in the context of the current spec.
Preanalyze_And_Resolve (New_Copy_Tree (Arg), Standard_String);
if Nkind (P) /= N_Task_Definition then if Nkind (P) /= N_Task_Definition then
Pragma_Misplaced; Pragma_Misplaced;
......
...@@ -5043,28 +5043,38 @@ package body Sem_Res is ...@@ -5043,28 +5043,38 @@ package body Sem_Res is
-- Create a transient scope if the resulting type requires it -- Create a transient scope if the resulting type requires it
-- There are 4 notable exceptions: in init procs, the transient scope -- There are several notable exceptions:
-- overhead is not needed and even incorrect due to the actual expansion
-- of adjust calls; the second case is enumeration literal pseudo calls; -- a) in init procs, the transient scope overhead is not needed, and is
-- the third case is intrinsic subprograms (Unchecked_Conversion and -- even incorrect when the call is a nested initialization call for a
-- source information functions) that do not use the secondary stack -- component whose expansion may generate adjust calls. However, if the
-- even though the return type is unconstrained; the fourth case is a -- call is some other procedure call within an initialization procedure
-- call to a build-in-place function, since such functions may allocate -- (for example a call to Create_Task in the init_proc of the task
-- their result directly in a target object, and cases where the result -- run-time record) a transient scope must be created around this call.
-- does get allocated in the secondary stack are checked for within the
-- specialized Exp_Ch6 procedures for expanding build-in-place calls. -- b) enumeration literal pseudo-calls need no transient scope.
-- If this is an initialization call for a type whose initialization -- c) intrinsic subprograms (Unchecked_Conversion and source info
-- uses the secondary stack, we also need to create a transient scope -- functions) do not use the secondary stack even though the return
-- for it, precisely because we will not do it within the init proc -- type may be unconstrained;
-- itself.
-- d) calls to a build-in-place function, since such functions may
-- If the subprogram is marked Inline_Always, then even if it returns -- allocate their result directly in a target object, and cases where
-- the result does get allocated in the secondary stack are checked for
-- within the specialized Exp_Ch6 procedures for expanding those
-- build-in-place calls.
-- e) If the subprogram is marked Inline_Always, then even if it returns
-- an unconstrained type the call does not require use of the secondary -- an unconstrained type the call does not require use of the secondary
-- stack. However, inlining will only take place if the body to inline -- stack. However, inlining will only take place if the body to inline
-- is already present. It may not be available if e.g. the subprogram is -- is already present. It may not be available if e.g. the subprogram is
-- declared in a child instance. -- declared in a child instance.
-- If this is an initialization call for a type whose construction
-- uses the secondary stack, and it is not a nested call to initialize
-- a component, we do need to create a transient scope for it. We
-- check for this by traversing the type in Check_Initialization_Call.
if Is_Inlined (Nam) if Is_Inlined (Nam)
and then Has_Pragma_Inline_Always (Nam) and then Has_Pragma_Inline_Always (Nam)
and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
...@@ -5072,13 +5082,19 @@ package body Sem_Res is ...@@ -5072,13 +5082,19 @@ package body Sem_Res is
then then
null; null;
elsif Ekind (Nam) = E_Enumeration_Literal
or else Is_Build_In_Place_Function (Nam)
or else Is_Intrinsic_Subprogram (Nam)
then
null;
elsif Expander_Active elsif Expander_Active
and then Is_Type (Etype (Nam)) and then Is_Type (Etype (Nam))
and then Requires_Transient_Scope (Etype (Nam)) and then Requires_Transient_Scope (Etype (Nam))
and then not Is_Build_In_Place_Function (Nam) and then
and then Ekind (Nam) /= E_Enumeration_Literal (not Within_Init_Proc
and then not Within_Init_Proc or else
and then not Is_Intrinsic_Subprogram (Nam) (not Is_Init_Proc (Nam) and then Ekind (Nam) /= E_Function))
then then
Establish_Transient_Scope (N, Sec_Stack => True); Establish_Transient_Scope (N, Sec_Stack => True);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment