+2017-04-25 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch3.adb (Build_Initialization_Call): Handle
+ subtypes of private types when searching for the underlying full
+ view of a private type.
+
+2017-04-25 Javier Miranda <miranda@adacore.com>
+
+ * sem_res.adb (Set_Mixed_Mode_Operand): A universal
+ real conditional expression can appear in a fixed-type context
+ and must be resolved with that context to facilitate the code
+ generation to the backend.
+
+2017-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.adb, einfo.ads (Body_Needed_For_Inlining): New flag,
+ to indicate whether during inline processing, when some unit U1
+ appears in the context of a unit U2 compiled for instantiation
+ or inlining purposes, the body of U1 needs to be compiled as well.
+ * sem_prag.adb (Process_Inline): Set Body_Needed_For_Inlining if
+ context is a package declaration.
+ * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration,
+ Analyze_Generic_Package_Declaration): ditto.
+ * inline.adb (Analyze_Inlined_Bodies): Check
+ Body_Needed_For_Inlining.
+
+2017-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * par.adb (Current_Assign_Node): Global variable use to record
+ the presence of a target_name in the right hand side of the
+ assignment being parsed.
+ * par-ch4.adb (P_Name): If the name is a target_name, mark the
+ enclosing assignment node accordingly.
+ * par-ch5.adb (P_Assignment_Statement): Set Current_Assign_Node
+ appropriately.
+ * sem_ch5.adb (Analyze_Assignment): Disable expansion before
+ analyzing RHS if the statement has target_names.
+ * sem_aggr.adb (Resolve_Iterated_Component_Association): Handle
+ properly choices that are subtype marks.
+ * exp_ch5.adb: Code cleanup.
+
+2017-04-25 Bob Duff <duff@adacore.com>
+
+ * s-memory.adb: Add a comment regarding efficiency.
+ * atree.adb: Fix the assertion, and combine 2 assertions into one,
+ "the source has an extension if and only if the destination does."
+ * sem_ch3.adb, sem_ch13.adb: Address ??? comments.
+
+2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>
+
+ * a-tasatt.adb (Set_Value): Fix handling of 32bits -> 64bits
+ conversion.
+
+2017-04-25 Doug Rupp <rupp@adacore.com>
+
+ * init.c (__gnat_error_handler) [vxworks]: Turn on sigtramp
+ handling for ppc64-vx7.
+ * sigtramp-vxworks-target.inc
+ [SIGTRAMP_BODY]: Add section for ppc64-vx7.
+
2017-04-25 Arnaud Charlet <charlet@adacore.com>
* ada_get_targ.adb: New file.
-- No finalization needed, simply set to Val
- TT.Attributes (Index) := To_Address (Val);
+ if Attribute'Size = Integer'Size then
+ TT.Attributes (Index) := Atomic_Address (To_Int (Val));
+ else
+ TT.Attributes (Index) := To_Address (Val);
+ end if;
else
Self_Id := STPO.Self;
-- Deal with copying extension nodes if present. No need to copy flags
-- table entries, since they are always zero for extending components.
- if Has_Extension (Source) then
- pragma Assert (Has_Extension (Destination));
+ pragma Assert (Has_Extension (Source) = Has_Extension (Destination));
+ if Has_Extension (Source) then
for J in 1 .. Num_Extension_Nodes loop
Nodes.Table (Destination + J) := Nodes.Table (Source + J);
end loop;
-
- else
- pragma Assert (not Has_Extension (Source));
- null;
end if;
end Copy_Node;
-- Has_Partial_Visible_Refinement Flag296
-- Is_Entry_Wrapper Flag297
-- Is_Underlying_Full_View Flag298
+ -- Body_Needed_For_Inlining Flag299
- -- (unused) Flag299
-- (unused) Flag300
-
-- (unused) Flag301
-- (unused) Flag302
-- (unused) Flag303
return Node19 (Id);
end Body_Entity;
+ function Body_Needed_For_Inlining (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ return Flag299 (Id);
+ end Body_Needed_For_Inlining;
+
function Body_Needed_For_SAL (Id : E) return B is
begin
pragma Assert
Set_Node19 (Id, V);
end Set_Body_Entity;
+ procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ Set_Flag299 (Id, V);
+ end Set_Body_Needed_For_Inlining;
+
procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
begin
pragma Assert
W ("Address_Taken", Flag104 (Id));
W ("Body_Needed_For_SAL", Flag40 (Id));
+ W ("Body_Needed_For_Inlining", Flag299 (Id));
W ("C_Pass_By_Copy", Flag125 (Id));
W ("Can_Never_Be_Null", Flag38 (Id));
W ("Checks_May_Be_Suppressed", Flag31 (Id));
-- units. Indicates that the source for the body must be included
-- when the unit is part of a standalone library.
+-- Body_Needed_For_Inlining (Flag299)
+-- Defined in package entities that are compilation units. Used to
+-- determine whether the body unit needs to be compiled when the
+-- package declaration appears in the list of units to inline. A body
+-- is needed for inline processing if the unit declaration contains
+-- functions that carry pragma Inline or Inline_Always, or if it
+-- contains a generic unit that requires a body.
+--
-- Body_References (Elist16)
-- Defined in abstract state entities. Contains an element list of
-- references (identifiers) that appear in a package body whose spec
-- SPARK_Pragma (Node40)
-- SPARK_Aux_Pragma (Node41)
-- Delay_Subprogram_Descriptors (Flag50)
+ -- Body_Needed_For_Inlining (Flag299)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Discard_Names (Flag88)
function Block_Node (Id : E) return N;
function Body_Entity (Id : E) return E;
function Body_Needed_For_SAL (Id : E) return B;
+ function Body_Needed_For_Inlining (Id : E) return B;
function Body_References (Id : E) return L;
function C_Pass_By_Copy (Id : E) return B;
function Can_Never_Be_Null (Id : E) return B;
procedure Set_BIP_Initialization_Call (Id : E; V : N);
procedure Set_Block_Node (Id : E; V : N);
procedure Set_Body_Entity (Id : E; V : E);
+ procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True);
procedure Set_Body_Needed_For_SAL (Id : E; V : B := True);
procedure Set_Body_References (Id : E; V : L);
procedure Set_C_Pass_By_Copy (Id : E; V : B := True);
pragma Inline (BIP_Initialization_Call);
pragma Inline (Block_Node);
pragma Inline (Body_Entity);
+ pragma Inline (Body_Needed_For_Inlining);
pragma Inline (Body_Needed_For_SAL);
pragma Inline (Body_References);
pragma Inline (C_Pass_By_Copy);
pragma Inline (Set_BIP_Initialization_Call);
pragma Inline (Set_Block_Node);
pragma Inline (Set_Body_Entity);
+ pragma Inline (Set_Body_Needed_For_Inlining);
pragma Inline (Set_Body_Needed_For_SAL);
pragma Inline (Set_Body_References);
pragma Inline (Set_C_Pass_By_Copy);
elsif Is_Generic_Actual_Type (Full_Type) then
Full_Type := Base_Type (Full_Type);
+ elsif Ekind (Full_Type) = E_Private_Subtype
+ and then (not Has_Discriminants (Full_Type)
+ or else No (Discriminant_Constraint (Full_Type)))
+ then
+ Full_Type := Etype (Full_Type);
+
-- The loop has recovered the [underlying] full view, stop the
-- traversal.
begin
if Nkind (N) = N_Target_Name then
Rewrite (N, New_Occurrence_Of (Ent, Sloc (N)));
+
+ -- The expression will be reanalyzed when the enclosing assignment
+ -- is reanalyzed, so reset the entity, which may be a temporary
+ -- created during analysis, e.g. a loop variable for an iterated
+ -- component association.
+
+ elsif Is_Entity_Name (N) then
+ Set_Entity (N, Empty);
end if;
Set_Analyzed (N, False);
sigdelset (&mask, sig);
sigprocmask (SIG_SETMASK, &mask, NULL);
-#if defined (__ARMEL__) || (defined (__PPC__) && !defined (__PPC64__)) || defined (__i386__) || defined (__x86_64__)
+#if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__) || defined (__x86_64__)
/* On certain targets, kernel mode, we process signals through a Call Frame
Info trampoline, voiding the need for myriads of fallback_frame_state
variants in the ZCX runtime. We have no simple way to distinguish ZCX
Comp_Unit := Parent (Comp_Unit);
end loop;
- -- Load the body, unless it is the main unit, or is an instance
- -- whose body has already been analyzed.
+ -- Load the body if it exists and contains inlineable entities,
+ -- unless it is the main unit, or is an instance whose body has
+ -- already been analyzed.
if Present (Comp_Unit)
and then Comp_Unit /= Cunit (Main_Unit)
and then Body_Required (Comp_Unit)
and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration
- or else No (Corresponding_Body (Unit (Comp_Unit))))
+ or else
+ (No (Corresponding_Body (Unit (Comp_Unit)))
+ and then Body_Needed_For_Inlining
+ (Defining_Entity (Unit (Comp_Unit)))))
then
declare
Bname : constant Unit_Name_Type :=
if Token = Tok_At_Sign then
Scan_Reserved_Identifier (Force_Msg => False);
+
+ if Present (Current_Assign_Node) then
+ Set_Has_Target_Names (Current_Assign_Node);
+ end if;
end if;
Name_Node := Token_Node;
begin
Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr);
+ Current_Assign_Node := Assign_Node;
Set_Name (Assign_Node, LHS);
Set_Expression (Assign_Node, P_Expression_No_Right_Paren);
TF_Semicolon;
+ Current_Assign_Node := Empty;
return Assign_Node;
end P_Assignment_Statement;
-- this may not be worth the effort. Also we could deal with the same
-- situation for EXIT with a label, but for now don't bother with that.
+ Current_Assign_Node : Node_Id := Empty;
+ -- This is the node of the current assignment statement being compiled.
+ -- It is used to record the presence of target_names on its RHS. This
+ -- context-dependent trick simplifies the analysis of such nodes, where
+ -- the RHS must first be analyzed with expansion disabled.
+
---------------------------------
-- Parsing Routines by Chapter --
---------------------------------
-- return Null_Address, and then we can check for that special value.
-- However, that doesn't work on VxWorks, because malloc(size_t'Last)
-- prints an unwanted warning message before returning Null_Address.
+ -- Note that the branch is correctly predicted on modern hardware, so
+ -- there is negligible overhead.
if Size = size_t'Last then
raise Storage_Error with "object too large";
Others_Present := True;
else
- Analyze_And_Resolve (Choice, Index_Typ);
+ Analyze (Choice);
+
+ -- Choice can be a subtype name, a range, or an expression.
+
+ if Is_Entity_Name (Choice)
+ and then Is_Type (Entity (Choice))
+ and then Base_Type (Entity (Choice)) = Base_Type (Index_Typ)
+ then
+ null;
+
+ else
+ Analyze_And_Resolve (Choice, Index_Typ);
+ end if;
end if;
Next (Choice);
-- Decorate the index variable in the current scope. The association
-- may have several choices, each one leading to a loop, so we create
-- this variable only once to prevent homonyms in this scope.
+ -- The expression has to be analyzed once the index variable is
+ -- directly visible.
if No (Scope (Id)) then
Enter_Name (Id);
End_Package_Scope (Id);
Exit_Generic_Scope (Id);
+ -- If the generic appears within a package unit, the body of that unit
+ -- has to be present for instantiation and inlining.
+
+ if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration then
+ Set_Body_Needed_For_Inlining
+ (Defining_Entity (Unit (Cunit (Current_Sem_Unit))));
+ end if;
+
if Nkind (Parent (N)) /= N_Compilation_Unit then
Move_Freeze_Nodes (Id, N, Visible_Declarations (Specification (N)));
Move_Freeze_Nodes (Id, N, Private_Declarations (Specification (N)));
Set_Body_Required (Parent (N), Unit_Requires_Body (Id));
end if;
+ -- If the generic appears within a package unit, the body of that unit
+ -- has to be present for instantiation and inlining.
+
+ if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
+ and then Unit_Requires_Body (Id)
+ then
+ Set_Body_Needed_For_Inlining
+ (Defining_Entity (Unit (Cunit (Current_Sem_Unit))));
+ end if;
+
Set_Categorization_From_Pragmas (N);
Validate_Categorization_Dependency (N, Id);
-- Turn off style checking in instances. If the check is enabled on the
-- generic unit, a warning in an instance would just be noise. If not
-- enabled on the generic, then a warning in an instance is just wrong.
+ -- This must be done after analyzing the actuals, which do come from
+ -- source and are subject to style checking.
Style_Check := False;
elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
Find_Direct_Name (N);
- if True or else not ASIS_Mode then -- ????
+ if not ASIS_Mode then
Set_Entity (N, Empty);
end if;
-- rejected. Pending notification we restrict this call to
-- ASIS mode.
- if False and then ASIS_Mode then -- ????
+ if ASIS_Mode then
Resolve_Aspects;
end if;
-- Ghost entity. Set the mode now to ensure that any nodes generated
-- during analysis and expansion are properly marked as Ghost.
+ if Has_Target_Names (N) then
+ Expander_Mode_Save_And_Set (False);
+ end if;
+
Mark_And_Set_Ghost_Assignment (N, Mode);
Analyze (Rhs);
else
Set_Has_Target_Names (Parent (Current_LHS));
Set_Etype (N, Etype (Current_LHS));
-
- -- Disable expansion for the rest of the analysis of the current
- -- right-hand side. The enclosing assignment statement will be
- -- rewritten during expansion, together with occurrences of the
- -- target name.
-
- if Expander_Active then
- Expander_Mode_Save_And_Set (False);
- end if;
end if;
end Analyze_Target_Name;
Next (Assoc);
end loop;
+
+ -- If the context is a package declaration, the pragma indicates
+ -- that inlining will require the presence of the corresponding
+ -- body. (this may be further refined).
+
+ if not In_Instance
+ and then Nkind (Unit (Cunit (Current_Sem_Unit)))
+ = N_Package_Declaration
+ then
+ Set_Body_Needed_For_Inlining (Cunit_Entity (Current_Sem_Unit));
+ end if;
end Process_Inline;
----------------------------
Resolve (Op2, T2);
end;
+ -- A universal real conditional expression can appear in a fixed-type
+ -- context and must be resolved with that context to facilitate the
+ -- code generation to the backend.
+
+ elsif Nkind_In (N, N_Case_Expression, N_If_Expression)
+ and then Etype (N) = Universal_Real
+ and then Is_Fixed_Point_Type (B_Typ)
+ then
+ Resolve (N, B_Typ);
+
else
Resolve (N);
end if;
/* Trampoline body block
--------------------- */
+#if !defined (__PPC64__)
#define SIGTRAMP_BODY \
CR("") \
TCR("# Allocate frame and save the non-volatile") \
TCR("") \
TCR("addi %r1,%r1,16") \
TCR("blr")
+#else
+#define SIGTRAMP_BODY \
+CR("") \
+TCR("0:") \
+TCR("addis 2,12,.TOC.-0@ha") \
+TCR("addi 2,2,.TOC.-0@l") \
+TCR("# Allocate frame and save the non-volatile") \
+TCR("# registers we're going to modify") \
+TCR("mflr %r0") \
+TCR("std %r0,16(%r1)") \
+TCR("stdu %r1,-32(%r1)") \
+TCR("std %r2,24(%r1)") \
+TCR("std %r" S(CFA_REG) ",8(%r1)") \
+TCR("") \
+TCR("# Setup CFA_REG = context, which we'll retrieve as our CFA value") \
+TCR("mr %r" S(CFA_REG) ", %r7") \
+TCR("") \
+TCR("# Call the real handler. The signo, siginfo and sigcontext") \
+TCR("# arguments are the same as those we received in r3, r4 and r5") \
+TCR("mr %r12,%r6") \
+TCR("mtctr %r6") \
+TCR("bctrl") \
+TCR("") \
+TCR("# Restore our callee-saved items, release our frame and return") \
+TCR("ld %r" S(CFA_REG) ",8(%r1)") \
+TCR("ld %r2,24(%r1)") \
+TCR("addi %r1,%r1,32") \
+TCR("ld %r0,16(%r1)") \
+TCR("mtlr %r0") \
+TCR("blr")
+#endif
#elif defined (__ARMEL__)
projects / gcc.git / commitdiff