+2014-07-29 Doug Rupp <rupp@adacore.com>
+
+ * init.c: Complete previous change.
+
+2014-07-29 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained
+ array case.
+
+2014-07-29 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Access_Attribute): If the prefix is a subprogram
+ and the completion will appear in the same declarative part,
+ create elaboration flag.
+ * exp_util.adb (Set_Elaboration_Flag): If the subprogram body
+ is a completion of a declaration in the same declarative part,
+ and the subprogram has had its address taken, add elaboration
+ check inside the subprogram body, to detect elaboration errors
+ that may occur through indirect calls.
+
2014-07-29 Doug Rupp <rupp@adacore.com>
* sigtramp-armvxw.c: Enhance to handle RTP trampolining.
return;
end if;
- -- If the type is limited or unconstrained, we expand as follows to
- -- avoid any possibility of improper copies.
-
- -- Note: it may be possible to avoid this special processing if the
- -- back end uses its own mechanisms for handling by-reference types ???
+ -- If the type is limited, and the back end does not handle limited
+ -- types, then we expand as follows to avoid the possibility of
+ -- improper copying.
-- type Ptr is access all Typ;
-- Cnn : Ptr;
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
+ -- If the result is an unconstrained array and the if expression is in a
+ -- context other than the initializing expression of the declaration of
+ -- an object, then we pull out the if expression as follows:
+
+ -- Cnn : constant typ := if-expression
+
+ -- and then replace the if expression with an occurrence of Cnn. This
+ -- avoids the need in the back end to create on-the-fly variable length
+ -- temporaries (which it cannot do!)
+
+ -- Note that the test for being in an object declaration avoids doing an
+ -- unnecessary expansion, and also avoids infinite recursion.
+
+ elsif Is_Array_Type (Typ) and then not Is_Constrained (Typ)
+ and then (Nkind (Parent (N)) /= N_Object_Declaration
+ or else Expression (Parent (N)) /= N)
+ then
+ declare
+ Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N);
+ begin
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Cnn,
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression => Relocate_Node (N),
+ Has_Init_Expression => True));
+
+ Rewrite (N, New_Occurrence_Of (Cnn, Loc));
+ return;
+ end;
+
-- For other types, we only need to expand if there are other actions
-- associated with either branch.
-- pick up bogus indications of the wrong constant value.
Set_Current_Value (Ent, Empty);
+
+ -- If the subprogram is in the current declarative part and
+ -- 'access has been applied to it, generate an elaboration
+ -- check at the beginning of the declarations of the body.
+
+ if Nkind (N) = N_Subprogram_Body
+ and then Address_Taken (Spec_Id)
+ and then
+ Ekind_In (Scope (Spec_Id), E_Block, E_Procedure, E_Function)
+ then
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Decls : constant List_Id := Declarations (N);
+ Chk : Node_Id;
+
+ begin
+ -- No need to generate this check if first entry in the
+ -- declaration list is a raise of Program_Error now.
+
+ if Present (Decls)
+ and then Nkind (First (Decls)) = N_Raise_Program_Error
+ then
+ return;
+ end if;
+
+ -- Otherwise generate the check
+
+ Chk :=
+ Make_Raise_Program_Error (Loc,
+ Condition =>
+ Make_Op_Eq (Loc,
+ Left_Opnd => New_Occurrence_Of (Ent, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
+ Reason => PE_Access_Before_Elaboration);
+
+ if No (Decls) then
+ Set_Declarations (N, New_List (Chk));
+ else
+ Prepend (Chk, Decls);
+ end if;
+
+ Analyze (Chk);
+ end;
+ end if;
end if;
end if;
end Set_Elaboration_Flag;
#include <signal.h>
#include <taskLib.h>
-#ifdef __RTP__
-#include <base/b_ucontext_t.h>
-#else
+#ifndef __RTP__
#include <intLib.h>
#include <iv.h>
#endif
if Is_Entity_Name (P) then
Set_Address_Taken (Entity (P));
end if;
+
+ if Is_Entity_Name (P) then
+ declare
+ E : constant Entity_Id := Entity (P);
+ Flag : Entity_Id;
+
+ -- If the access has been taken and the body of the subprogram
+ -- has not been see yet, indirect calls must be protected with
+ -- elaboration checks. We have the proper elaboration machinery
+ -- for subprograms declared in packages, but within a block or
+ -- a subprogram the body will appear in the same declarative
+ -- part, and we must insert a check in the eventual body itself
+ -- using the elaboration flag that we generate now. The check
+ -- is then inserted when the body is expanded.
+
+ begin
+ if Is_Subprogram (E)
+ and then Comes_From_Source (E)
+ and then Comes_From_Source (N)
+ and then In_Open_Scopes (Scope (E))
+ and then
+ Ekind_In (Scope (E), E_Block, E_Procedure, E_Function)
+ and then not Has_Completion (E)
+ and then No (Elaboration_Entity (E))
+ and then Expander_Active
+ then
+ -- Create elaboration variable for it
+
+ Flag := Make_Temporary (Loc, 'E');
+
+ Set_Elaboration_Entity (E, Flag);
+
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Flag,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Short_Integer, Loc),
+ Expression =>
+ Make_Integer_Literal (Loc, Uint_0)));
+ Set_Is_Frozen (Flag);
+ end if;
+ end;
+ end if;
end Access_Attribute;
-------------
projects / gcc.git / commitdiff