-- for all computed bounds (which may be out of range of Istyp in the
-- case of null ranges).
- Intyp : Entity_Id;
+ Artyp : Entity_Id;
-- This is the type we use to do arithmetic to compute the bounds and
-- lengths of operands. The choice of this type is a little subtle and
-- is discussed in a separate section at the start of the body code.
-- Set to an entity of type Natural that contains the length of an
-- operand whose length is not known at compile time. Entries in this
-- array are set only if the corresponding entry in Is_Fixed_Length
- -- is False. The entity is of type Intyp.
+ -- is False. The entity is of type Artyp.
Aggr_Length : array (0 .. N) of Node_Id;
-- The J'th entry in an expression node that represents the total length
-- of operands 1 through J. It is either an integer literal node, or a
-- reference to a constant entity with the right value, so it is fine
-- to just do a Copy_Node to get an appropriate copy. The extra zero'th
- -- entry always is set to zero. The length is of type Intyp.
+ -- entry always is set to zero. The length is of type Artyp.
Low_Bound : Node_Id;
-- A tree node representing the low bound of the result (of type Ityp).
Result : Node_Id;
-- Result of the concatenation (of type Ityp)
- function To_Intyp (X : Node_Id) return Node_Id;
+ function To_Artyp (X : Node_Id) return Node_Id;
-- Given a node of type Ityp, returns the corresponding value of type
- -- Intyp. For non-enumeration types, this is the identity. For enum
+ -- Artyp. For non-enumeration types, this is the identity. For enum
-- types, the Pos of the value is returned.
function To_Ityp (X : Node_Id) return Node_Id;
-- The inverse function (uses Val in the case of enumeration types)
--------------
- -- To_Intyp --
+ -- To_Artyp --
--------------
- function To_Intyp (X : Node_Id) return Node_Id is
+ function To_Artyp (X : Node_Id) return Node_Id is
begin
- if Ityp = Base_Type (Intyp) then
+ if Ityp = Base_Type (Artyp) then
return X;
elsif Is_Enumeration_Type (Ityp) then
Expressions => New_List (X));
else
- return Convert_To (Intyp, X);
+ return Convert_To (Artyp, X);
end if;
- end To_Intyp;
+ end To_Artyp;
-------------
-- To_Ityp --
-- we analyzed and resolved the expression.
Set_Parent (X, Cnode);
- Analyze_And_Resolve (X);
+ Analyze_And_Resolve (X, Artyp);
if Compile_Time_Compare
- (X, Type_High_Bound (Istyp),
- Assume_Valid => False) = GT
+ (X, Type_High_Bound (Istyp), Assume_Valid => False) = GT
or else
Compile_Time_Compare
- (X, Type_High_Bound (Ityp),
- Assume_Valid => False) = GT
+ (X, Type_High_Bound (Ityp), Assume_Valid => False) = GT
then
Apply_Compile_Time_Constraint_Error
(N => Cnode,
raise Concatenation_Error;
else
- if Ityp = Base_Type (Intyp) then
+ if Ityp = Base_Type (Artyp) then
return X;
else
return Convert_To (Ityp, X);
-- arithmetic with POS values, not representation values).
if Is_Enumeration_Type (Ityp) then
- Intyp := Standard_Integer;
+ Artyp := Standard_Integer;
-- For modular types, we use a 32-bit modular type for types whose size
-- is in the range 1-31 bits. For 32-bit unsigned types, we use the
elsif Is_Modular_Integer_Type (Ityp) then
if RM_Size (Ityp) < RM_Size (Standard_Unsigned) then
- Intyp := Standard_Unsigned;
+ Artyp := Standard_Unsigned;
elsif RM_Size (Ityp) = RM_Size (Standard_Unsigned) then
- Intyp := Ityp;
+ Artyp := Ityp;
else
- Intyp := RTE (RE_Long_Long_Unsigned);
+ Artyp := RTE (RE_Long_Long_Unsigned);
end if;
-- Similar treatment for signed types
else
if RM_Size (Ityp) < RM_Size (Standard_Integer) then
- Intyp := Standard_Integer;
+ Artyp := Standard_Integer;
elsif RM_Size (Ityp) = RM_Size (Standard_Integer) then
- Intyp := Ityp;
+ Artyp := Ityp;
else
- Intyp := Standard_Long_Long_Integer;
+ Artyp := Standard_Long_Long_Integer;
end if;
end if;
Constant_Present => True,
Object_Definition =>
- New_Occurrence_Of (Intyp, Loc),
+ New_Occurrence_Of (Artyp, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Constant_Present => True,
Object_Definition =>
- New_Occurrence_Of (Intyp, Loc),
+ New_Occurrence_Of (Artyp, Loc),
Expression =>
Make_Op_Add (Loc,
High_Bound :=
To_Ityp (
Make_Op_Add (Loc,
- Left_Opnd => To_Intyp (New_Copy (Low_Bound)),
+ Left_Opnd => To_Artyp (New_Copy (Low_Bound)),
Right_Opnd =>
Make_Op_Subtract (Loc,
Left_Opnd => New_Copy (Aggr_Length (NN)),
declare
Lo : constant Node_Id :=
Make_Op_Add (Loc,
- Left_Opnd => To_Intyp (New_Copy (Low_Bound)),
+ Left_Opnd => To_Artyp (New_Copy (Low_Bound)),
Right_Opnd => Aggr_Length (J - 1));
Hi : constant Node_Id :=
Make_Op_Add (Loc,
- Left_Opnd => To_Intyp (New_Copy (Low_Bound)),
+ Left_Opnd => To_Artyp (New_Copy (Low_Bound)),
Right_Opnd =>
Make_Op_Subtract (Loc,
Left_Opnd => Aggr_Length (J),
-- inlined under ZCX because the numeric suffix generated by gigi
-- will be different in the body and the place of the inlined call.
--
- -- This procedure must be carefully coordinated with the back end
+ -- If the body to be inlined contains calls to subprograms declared
+ -- in the same body that have no previous spec, the back-end cannot
+ -- inline either because the bodies to be inlined are processed before
+ -- the rest of the enclosing package body, and gigi will then find
+ -- references to entities that have not been elaborated yet.
+ --
+ -- This procedure must be carefully coordinated with the back end.
----------------------------
-- Back_End_Cannot_Inline --
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
Body_Ent : Entity_Id;
Ent : Entity_Id;
+ Bad_Call : Node_Id;
+
+ function Process (N : Node_Id) return Traverse_Result;
+ -- Look for calls to subprograms with no previous spec, declared
+ -- in the same enclosiong package body.
+
+ -------------
+ -- Process --
+ -------------
+
+ function Process (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) = N_Procedure_Call_Statement
+ or else Nkind (N) = N_Function_Call
+ then
+ if Is_Entity_Name (Name (N))
+ and then
+ Nkind (Unit_Declaration_Node (Entity (Name (N))))
+ = N_Subprogram_Body
+ and then In_Same_Extended_Unit (Subp, Entity (Name (N)))
+ then
+ Bad_Call := N;
+ return Abandon;
+ else
+ return OK;
+ end if;
+ else
+ return OK;
+ end if;
+ end Process;
+
+ function Has_Exposed_Call is new Traverse_Func (Process);
+
+ -- Start of processing for Back_End_Cannot_Inline
begin
if Nkind (Decl) = N_Subprogram_Declaration
if Present
(Exception_Handlers
(Handled_Statement_Sequence
- (Unit_Declaration_Node (Corresponding_Body (Decl)))))
+ (Unit_Declaration_Node (Corresponding_Body (Decl)))))
then
return True;
end if;
Ent := First_Entity (Body_Ent);
-
while Present (Ent) loop
if Is_Subprogram (Ent)
and then Is_Generic_Instance (Ent)
Next_Entity (Ent);
end loop;
- return False;
+
+ if Has_Exposed_Call
+ (Unit_Declaration_Node (Corresponding_Body (Decl))) = Abandon
+ then
+ if Ineffective_Inline_Warnings then
+ Error_Msg_N
+ ("?call to subprogram with no separate spec"
+ & " prevents inlining!!", Bad_Call);
+ end if;
+
+ return True;
+ else
+ return False;
+ end if;
end Back_End_Cannot_Inline;
-- Start of processing for Add_Inlined_Subprogram
end if;
Inlined.Table (Index).Listed := True;
- Succ := Inlined.Table (Index).First_Succ;
+ Succ := Inlined.Table (Index).First_Succ;
while Succ /= No_Succ loop
Subp := Successors.Table (Succ).Subp;
Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
Load_Needed_Body (Comp_Unit, OK);
if not OK then
+
+ -- Warn that a body was not available for inlining
+ -- by the back-end.
+
Error_Msg_Unit_1 := Bname;
Error_Msg_N
- ("one or more inlined subprograms accessed in $!",
+ ("one or more inlined subprograms accessed in $!?",
Comp_Unit);
Error_Msg_File_1 :=
Get_File_Name (Bname, Subunit => False);
- Error_Msg_N ("\but file{ was not found!", Comp_Unit);
- raise Unrecoverable_Error;
+ Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
end if;
end if;
end;
projects / gcc.git / commitdiff