-- The following code is a bit kludgy. It would be cleaner to
-- Add an entry Change_Expanded_Name_To_Selected_Component to
- -- Sinfo.CN, but that's an earthquake, because it has the wrong
- -- license, and Atree is used outside the compiler, e.g. in the
- -- binder and in ASIS, so we don't want to add that dependency.
+ -- Sinfo.CN, but that's delicate because Atree is used in the
+ -- binder, so we don't want to add that dependency.
+ -- ??? Revisit now that ASIS is no longer using this unit.
-- Consequently we have no choice but to hold our noses and do
-- the change manually. At least we are Atree, so this odd use
elsif Present (Items) then
-- Do not analyze the pre/postconditions of an entry declaration
- -- unless annotating the original tree for ASIS or GNATprove. The
+ -- unless annotating the original tree for GNATprove. The
-- real analysis occurs when the pre/postconditons are relocated to
-- the contract wrapper procedure (see Build_Contract_Wrapper).
if Prag_Nam = Name_Contract_Cases then
-- Do not analyze the contract cases of an entry declaration
- -- unless annotating the original tree for ASIS or GNATprove.
+ -- unless annotating the original tree for GNATprove.
-- The real analysis occurs when the contract cases are moved
-- to the contract wrapper procedure (Build_Contract_Wrapper).
-- d.y Disable implicit pragma Elaborate_All on task bodies
-- d.z Restore previous support for frontend handling of Inline_Always
- -- d.A Read/write Aspect_Specifications hash table to tree
+ -- d.A
-- d.B Generate a bug box on abort_statement
-- d.C Generate concatenation call, do not generate inline code
-- d.D Disable errors on use of overriding keyword in Ada 95 mode
-- handling of Inline_Always by the front end on such targets. For the
-- targets that do not use the GCC back end, this switch is ignored.
- -- d.A There seems to be a problem with ASIS if we activate the circuit
- -- for reading and writing the aspect specification hash table, so
- -- for now, this is controlled by the debug flag d.A. The hash table
- -- is only written and read if this flag is set.
-
-- d.B Generate a bug box when we see an abort_statement, even though
-- there is no bug. Useful for testing Comperr.Compiler_Abort: write
-- some code containing an abort_statement, and compile it with
elsif CodePeer_Mode then
null;
- -- Omit check if component has a generic type. This can
- -- happen in an instantiation within a generic in ASIS
- -- mode, where we force freeze actions without full
- -- expansion.
-
- elsif Is_Generic_Type (Etype (Comp)) then
- null;
-
-- Do the check
elsif not
with Output; use Output;
with Snames; use Snames;
with Table;
+with Ttypes;
package body Repinfo.Input is
- SSU : constant := 8;
- -- Value for Storage_Unit, we do not want to get this from TTypes, since
- -- this introduces problematic dependencies in ASIS, and in any case this
- -- value is assumed to be 8 for the implementation of the DDA.
+ SSU : Pos renames Ttypes.System_Storage_Unit;
+ -- Value for Storage_Unit
type JSON_Entity_Kind is (JE_Record_Type, JE_Array_Type, JE_Other);
-- Kind of an entiy
------------------------------------------------------------------------------
with Alloc;
-with Atree; use Atree;
-with Casing; use Casing;
-with Debug; use Debug;
-with Einfo; use Einfo;
-with Lib; use Lib;
-with Namet; use Namet;
-with Nlists; use Nlists;
-with Opt; use Opt;
-with Output; use Output;
-with Sem_Aux; use Sem_Aux;
-with Sinfo; use Sinfo;
-with Sinput; use Sinput;
-with Snames; use Snames;
-with Stringt; use Stringt;
+with Atree; use Atree;
+with Casing; use Casing;
+with Debug; use Debug;
+with Einfo; use Einfo;
+with Lib; use Lib;
+with Namet; use Namet;
+with Nlists; use Nlists;
+with Opt; use Opt;
+with Output; use Output;
+with Sem_Aux; use Sem_Aux;
+with Sem_Eval; use Sem_Eval;
+with Sinfo; use Sinfo;
+with Sinput; use Sinput;
+with Snames; use Snames;
+with Stringt; use Stringt;
with Table;
-with Uname; use Uname;
-with Urealp; use Urealp;
+with Ttypes;
+with Uname; use Uname;
+with Urealp; use Urealp;
with Ada.Unchecked_Conversion;
package body Repinfo is
- SSU : constant := 8;
- -- Value for Storage_Unit, we do not want to get this from TTypes, since
- -- this introduces problematic dependencies in ASIS, and in any case this
- -- value is assumed to be 8 for the implementation of the DDA.
+ SSU : Pos renames Ttypes.System_Storage_Unit;
+ -- Value for Storage_Unit
---------------------------------------
-- Representation of GCC Expressions --
function Back_End_Layout return Boolean;
-- Test for layout mode, True = back end, False = front end. This function
-- is used rather than checking the configuration parameter because we do
- -- not want Repinfo to depend on Targparm (for ASIS)
+ -- not want Repinfo to depend on Targparm.
procedure List_Entities
(Ent : Entity_Id;
-------------------------
procedure List_Linker_Section (Ent : Entity_Id) is
- function Expr_Value_S (N : Node_Id) return Node_Id;
- -- Returns the folded value of the expression. This function is called
- -- in instances where it has already been determined that the expression
- -- is static or its value is known at compile time. This version is used
- -- for string types and returns the corresponding N_String_Literal node.
- -- NOTE: This is an exact copy of Sem_Eval.Expr_Value_S. Licensing stops
- -- Repinfo from within Sem_Eval. Once ASIS is removed, and the licenses
- -- are modified, Repinfo should be able to rely on Sem_Eval.
-
- ------------------
- -- Expr_Value_S --
- ------------------
-
- function Expr_Value_S (N : Node_Id) return Node_Id is
- begin
- if Nkind (N) = N_String_Literal then
- return N;
- else
- pragma Assert (Ekind (Entity (N)) = E_Constant);
- return Expr_Value_S (Constant_Value (Entity (N)));
- end if;
- end Expr_Value_S;
-
- -- Local variables
-
Args : List_Id;
Sect : Node_Id;
- -- Start of processing for List_Linker_Section
-
begin
if Present (Linker_Section_Pragma (Ent)) then
Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
-- We skip evaluation if the expander is not active. This is not just
-- an optimization. It is of key importance that we not rewrite the
-- attribute in a generic template, since we want to pick up the
- -- setting of the check in the instance, Testing Expander_Active
- -- might seem an easy way of doing this, but we need to account for
- -- ASIS needs, so check explicitly for a generic context.
+ -- setting of the check in the instance.
if not Inside_A_Generic then
declare
when Attribute_Constrained =>
-- The expander might fold it and set the static flag accordingly,
- -- but with expansion disabled (as in ASIS), it remains as an
- -- attribute reference, and this reference is not static.
+ -- but with expansion disabled, it remains as an attribute reference,
+ -- and this reference is not static.
Set_Is_Static_Expression (N, False);
-- as a small optimization to subsequent handling of private_with
-- clauses in other nested packages. We replace the clause with
-- a null statement, which is otherwise ignored by the rest of
- -- the compiler, so that ASIS tools can reconstruct the source.
- -- Is this still needed now that ASIS mode is removed???
+ -- the compiler.
if In_Regular_With_Clause (Entity (Name (Item))) then
declare
Args : List_Id;
Comp_Expr : Node_Id;
Comp_Assn : Node_Id;
- New_Expr : Node_Id;
begin
Args := New_List;
goto Continue;
end if;
- -- Make pragma expressions refer to the original aspect
- -- expressions through the Original_Node link. This is used
- -- in semantic analysis for ASIS mode, so that the original
- -- expression also gets analyzed.
- -- Is this still needed???
+ -- Create the list of arguments for building the Test_Case
+ -- pragma.
Comp_Expr := First (Expressions (Expr));
while Present (Comp_Expr) loop
- New_Expr := Relocate_Node (Comp_Expr);
Append_To (Args,
Make_Pragma_Argument_Association (Sloc (Comp_Expr),
- Expression => New_Expr));
+ Expression => Relocate_Node (Comp_Expr)));
Next (Comp_Expr);
end loop;
-- the primitives of the interfaces with the primitives that cover them.
-- Note: These entities were originally generated only when generating
-- code because their main purpose was to provide support to initialize
- -- the secondary dispatch tables. They are now generated also when
- -- compiling with no code generation to provide ASIS the relationship
- -- between interface primitives and tagged type primitives. They are
- -- also used to locate primitives covering interfaces when processing
- -- generics (see Derive_Subprograms).
- -- ??? Revisit now that ASIS mode is gone.
+ -- the secondary dispatch tables. They are also used to locate
+ -- primitives covering interfaces when processing generics (see
+ -- Derive_Subprograms).
-- This is not needed in the generic case
-- the list since it would invalidate the tree.
-- So we have to rewrite the variant part with a Rewrite
-- call that replaces it with a copy and clobber the copy.
- -- This is no longer needed for ASIS, but possibly for
- -- GNATprove???
if not Expander_Active then
declare
-- We only want to do this if the expander is active, since
-- we do not want to clobber the tree.
- -- This is no longer needed for ASIS, is this needed for
- -- GNATprove_Mode???
if Expander_Active then
declare
if Present (Acc_Def) then
Create_Extra_Formals (Designated_Type (Anon_Access));
-
- -- If an access to object, preserve entity of designated type,
- -- for ASIS use, before rewriting the component definition.
- -- Is this still needed???
-
- else
- declare
- Desig : Entity_Id;
-
- begin
- Desig := Entity (Subtype_Indication (Type_Def));
-
- -- If the access definition is to the current record,
- -- the visible entity at this point is an incomplete
- -- type. Retrieve the full view to simplify ASIS queries
-
- if Ekind (Desig) = E_Incomplete_Type then
- Desig := Full_View (Desig);
- end if;
-
- Set_Entity
- (Subtype_Mark (Access_Definition (Comp_Def)), Desig);
- end;
end if;
Rewrite (Comp_Def,
and then (Nkind (Parent (N)) /= N_Quantified_Expression
or else Operating_Mode = Check_Semantics)
- -- Do not perform this expansion for ASIS and when expansion is
- -- disabled, where the temporary may hide the transformation of a
- -- selected component into a prefixed function call, and references
- -- need to see the original expression.
+ -- Do not perform this expansion when expansion is disabled, where the
+ -- temporary may hide the transformation of a selected component into
+ -- a prefixed function call, and references need to see the original
+ -- expression.
and then Expander_Active
then
-- This is the one case where we remove dead code in the
-- semantics as opposed to the expander, and we do not want
-- to remove code if we are not in code generation mode,
- -- since this messes up the ASIS trees or loses useful
- -- information in the CodePeer tree.
+ -- since this messes up the tree or loses useful information
+ -- for CodePeer.
-- Note that one might react by moving the whole circuit to
-- exp_ch5, but then we lose the warning in -gnatc mode.
Relocate_Pragmas_To_Body (N);
Analyze (N);
- -- Once the aspects of the generated body have been analyzed, create
- -- a copy for ASIS purposes and associate it with the original node.
- -- Is this still needed???
-
- if Has_Aspects (N) then
- Set_Aspect_Specifications (Orig_N,
- New_Copy_List_Tree (Aspect_Specifications (N)));
- end if;
-
-- Prev is the previous entity with the same name, but it is can
-- be an unrelated spec that is not completed by the expression
-- function. In that case the relevant entity is the one in the body.
Analyze (N);
- -- Once the aspects of the generated spec have been analyzed, create
- -- a copy for ASIS purposes and associate it with the original node.
- -- Is this still needed???
-
- if Has_Aspects (N) then
- Set_Aspect_Specifications (Orig_N,
- New_Copy_List_Tree (Aspect_Specifications (N)));
- end if;
-
-- If aspect SPARK_Mode was specified on the body, it needs to be
-- repeated both on the generated spec and the body.
T := Defining_Identifier (Dec);
Set_Etype (Nam, T);
end if;
-
- -- Complete analysis of the subtype mark in any case, for ASIS use
-
- if Present (Subtype_Mark (N)) then
- Find_Type (Subtype_Mark (N));
- end if;
-
elsif Present (Subtype_Mark (N))
or else not Present (Access_Definition (N))
then
-- routines, but this is too tricky for that.
-- Note that using Rewrite would be wrong, because we would
- -- have a tree where the original node is unanalyzed, and
- -- this violates the required interface for ASIS.
+ -- have a tree where the original node is unanalyzed.
Replace (P,
Make_Function_Call (Sloc (P), Name => Nam));
-- It is not an error if the prefix is the current instance of
-- type name, e.g. the expression of a type aspect, when it is
- -- analyzed for ASIS use, or within a generic unit. We still
- -- have to verify that a component of that name exists, and
- -- decorate the node accordingly.
+ -- analyzed within a generic unit. We still have to verify that a
+ -- component of that name exists, and decorate the node
+ -- accordingly.
elsif Is_Entity_Name (P) and then Is_Current_Instance (P) then
declare
Set_Analyzed (Def, False);
-- Keep the original subtree to ensure a properly
- -- formed tree (e.g. for ASIS use).
+ -- formed tree.
Rewrite
(Discrete_Subtype_Definition (Index_Spec), Def);
-- The primitive operations of a tagged synchronized type are placed
-- on the Corresponding_Record for proper dispatching, but are
-- attached to the synchronized type itself when expansion is
- -- disabled, for ASIS use.
+ -- disabled.
Set_Direct_Primitive_Operations (T, New_Elmt_List);
end if;
end if;
- -- If the tagged type is a concurrent type then we must be compiling
- -- with no code generation (we are either compiling a generic unit or
- -- compiling under -gnatc mode) because we have previously tested that
- -- no serious errors has been reported. In this case we do not add the
- -- primitive to the list of primitives of Tagged_Type but we leave the
- -- primitive decorated as a dispatching operation to be able to analyze
- -- and report errors associated with the Object.Operation notation.
-
- elsif Is_Concurrent_Type (Tagged_Type) then
- pragma Assert (not Expander_Active);
-
- -- Attach operation to list of primitives of the synchronized type
- -- itself, for ASIS use.
-
- Add_Dispatching_Operation (Tagged_Type, Subp);
-
-- If no old subprogram, then we add this as a dispatching operation,
-- but we avoid doing this if an error was posted, to prevent annoying
-- cascaded errors.
return;
end if;
- -- If we are folding a named number, retain the entity in the literal,
- -- for ASIS use.
+ -- If we are folding a named number, retain the entity in the literal
+ -- in the original tree.
if Is_Entity_Name (N) and then Ekind (Entity (N)) = E_Named_Integer then
Ent := Entity (N);
-- For a result of type integer, substitute an N_Integer_Literal node
-- for the result of the compile time evaluation of the expression.
- -- For ASIS use, set a link to the original named number when not in
- -- a generic context.
+ -- Set a link to the original named number when not in a generic context
+ -- for reference in the original tree.
if Is_Integer_Type (Typ) then
Rewrite (N, Make_Integer_Literal (Loc, Val));
return;
end if;
- -- If we are folding a named number, retain the entity in the literal,
- -- for ASIS use.
+ -- If we are folding a named number, retain the entity in the literal
+ -- in the original tree.
if Is_Entity_Name (N) and then Ekind (Entity (N)) = E_Named_Real then
Ent := Entity (N);
Rewrite (N, Make_Real_Literal (Loc, Realval => Val));
- -- Set link to original named number, for ASIS use
+ -- Set link to original named number
Set_Original_Entity (N, Ent);
begin
-- Use the expression of the original aspect when analyzing the template
-- of a generic unit. In both cases the aspect's tree must be decorated
- -- to allow for ASIS queries or to save the global references in the
- -- generic context.
+ -- to save the global references in the generic context.
if From_Aspect_Specification (Prag)
and then (Present (Context_Id) and then Is_Generic_Unit (Context_Id))
projects / gcc.git / commitdiff