From: Arnaud Charlet <char...@adacore.com>
gcc/ada/
* osint-c.ads, osint-c.adb (Create_C_File, Close_C_File,
Delete_C_File): Put back, needed by LLVM based CCG.
* exp_unst.adb (Unnest_Subprogram): Complete previous change by
removing now dead code and corresponding ??? comment.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_unst.adb | 195 +------------------------------------------
gcc/ada/osint-c.adb | 40 +++++++++
gcc/ada/osint-c.ads | 18 ++--
3 files changed, 55 insertions(+), 198 deletions(-)
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 19bb8948a89..7ff1ea621bb 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -2190,197 +2190,10 @@ package body Exp_Unst is
end loop;
end Subp_Loop;
- -- Next step, process uplevel references. This has to be done in a
- -- separate pass, after completing the processing in Sub_Loop because we
- -- need all the AREC declarations generated, inserted, and analyzed so
- -- that the uplevel references can be successfully analyzed.
-
- Uplev_Refs : for J in Urefs.First .. Urefs.Last loop
- declare
- UPJ : Uref_Entry renames Urefs.Table (J);
-
- begin
- -- Ignore type references, these are implicit references that do
- -- not need rewriting (e.g. the appearance in a conversion).
- -- Also ignore if no reference was specified or if the rewriting
- -- has already been done (this can happen if the N_Identifier
- -- occurs more than one time in the tree). Also ignore references
- -- with GNAT-LLVM (CCG_Mode), since it will handle the processing
- -- for up-level refs).
- -- ??? At this stage, only GNAT LLVM uses front-end unnesting, so
- -- consider remove the code below.
-
- if No (UPJ.Ref)
- or else not Is_Entity_Name (UPJ.Ref)
- or else No (Entity (UPJ.Ref))
- or else Opt.CCG_Mode
- then
- goto Continue;
- end if;
-
- -- Rewrite one reference
-
- Rewrite_One_Ref : declare
- Loc : constant Source_Ptr := Sloc (UPJ.Ref);
- -- Source location for the reference
-
- Typ : constant Entity_Id := Etype (UPJ.Ent);
- -- The type of the referenced entity
-
- Atyp : Entity_Id;
- -- The actual subtype of the reference
-
- RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller);
- -- Subp_Index for caller containing reference
-
- STJR : Subp_Entry renames Subps.Table (RS_Caller);
- -- Subp_Entry for subprogram containing reference
-
- RS_Callee : constant SI_Type := Subp_Index (UPJ.Callee);
- -- Subp_Index for subprogram containing referenced entity
-
- STJE : Subp_Entry renames Subps.Table (RS_Callee);
- -- Subp_Entry for subprogram containing referenced entity
-
- Pfx : Node_Id;
- Comp : Entity_Id;
- SI : SI_Type;
-
- begin
- Atyp := Etype (UPJ.Ref);
-
- if Ekind (Atyp) /= E_Record_Subtype then
- Atyp := Get_Actual_Subtype (UPJ.Ref);
- end if;
-
- -- Ignore if no ARECnF entity for enclosing subprogram which
- -- probably happens as a result of not properly treating
- -- instance bodies. To be examined ???
-
- -- If this test is omitted, then the compilation of freeze.adb
- -- and inline.adb fail in unnesting mode.
-
- if No (STJR.ARECnF) then
- goto Continue;
- end if;
-
- -- If this is a reference to a global constant, use its value
- -- rather than create a reference. It is more efficient and
- -- furthermore indispensable if the context requires a
- -- constant, such as a branch of a case statement.
-
- if Ekind (UPJ.Ent) = E_Constant
- and then Is_True_Constant (UPJ.Ent)
- and then Present (Constant_Value (UPJ.Ent))
- and then Is_Static_Expression (Constant_Value (UPJ.Ent))
- then
- Rewrite (UPJ.Ref, New_Copy_Tree (Constant_Value (UPJ.Ent)));
- goto Continue;
- end if;
-
- -- Push the current scope, so that the pointer type Tnn, and
- -- any subsidiary entities resulting from the analysis of the
- -- rewritten reference, go in the right entity chain.
-
- Push_Scope (STJR.Ent);
-
- -- Now we need to rewrite the reference. We have a reference
- -- from level STJR.Lev to level STJE.Lev. The general form of
- -- the rewritten reference for entity X is:
-
- -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECmU.X)
-
- -- where a,b,c,d .. m =
- -- STJR.Lev - 1, STJR.Lev - 2, .. STJE.Lev
-
- pragma Assert (STJR.Lev > STJE.Lev);
-
- -- Compute the prefix of X. Here are examples to make things
- -- clear (with parens to show groupings, the prefix is
- -- everything except the .X at the end).
-
- -- level 2 to level 1
-
- -- AREC1F.X
-
- -- level 3 to level 1
-
- -- (AREC2F.AREC1U).X
-
- -- level 4 to level 1
-
- -- ((AREC3F.AREC2U).AREC1U).X
-
- -- level 6 to level 2
-
- -- (((AREC5F.AREC4U).AREC3U).AREC2U).X
-
- -- In the above, ARECnF and ARECnU are pointers, so there are
- -- explicit dereferences required for these occurrences.
-
- Pfx :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (STJR.ARECnF, Loc));
- SI := RS_Caller;
- for L in STJE.Lev .. STJR.Lev - 2 loop
- SI := Enclosing_Subp (SI);
- Pfx :=
- Make_Explicit_Dereference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => Pfx,
- Selector_Name =>
- New_Occurrence_Of (Subps.Table (SI).ARECnU, Loc)));
- end loop;
-
- -- Get activation record component (must exist)
-
- Comp := Activation_Record_Component (UPJ.Ent);
- pragma Assert (Present (Comp));
-
- -- Do the replacement. If the component type is an access type,
- -- this is an uplevel reference for an entity that requires a
- -- fat pointer, so dereference the component.
-
- if Is_Access_Type (Etype (Comp)) then
- Rewrite (UPJ.Ref,
- Make_Explicit_Dereference (Loc,
- Prefix =>
- Make_Selected_Component (Loc,
- Prefix => Pfx,
- Selector_Name =>
- New_Occurrence_Of (Comp, Loc))));
-
- else
- Rewrite (UPJ.Ref,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Atyp, Loc),
- Attribute_Name => Name_Deref,
- Expressions => New_List (
- Make_Selected_Component (Loc,
- Prefix => Pfx,
- Selector_Name =>
- New_Occurrence_Of (Comp, Loc)))));
- end if;
-
- -- Analyze and resolve the new expression. We do not need to
- -- establish the relevant scope stack entries here, because we
- -- have already set all the correct entity references, so no
- -- name resolution is needed. We have already set the current
- -- scope, so that any new entities created will be in the right
- -- scope.
-
- -- We analyze with all checks suppressed (since we do not
- -- expect any exceptions)
-
- Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks);
- Pop_Scope;
- end Rewrite_One_Ref;
- end;
-
- <<Continue>>
- null;
- end loop Uplev_Refs;
+ -- Note: we used to process uplevel references, in particular for the
+ -- old CCG (cprint.adb). With GNAT LLVM, processing of uplevel
+ -- references needs to be done directly there which is more reliable, so
+ -- we no longer need to do it here.
-- Finally, loop through all calls adding extra actual for the
-- activation record where it is required.
diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb
index 0fef274217a..08abbae9464 100644
--- a/gcc/ada/osint-c.adb
+++ b/gcc/ada/osint-c.adb
@@ -44,6 +44,23 @@ package body Osint.C is
-- output file and Suffix is the desired suffix (dg/rep/xxx for debug/
-- repinfo/list file where xxx is specified extension.
+ ------------------
+ -- Close_C_File --
+ ------------------
+
+ procedure Close_C_File is
+ Status : Boolean;
+
+ begin
+ Close (Output_FD, Status);
+
+ if not Status then
+ Fail
+ ("error while closing file "
+ & Get_Name_String (Output_File_Name));
+ end if;
+ end Close_C_File;
+
----------------------
-- Close_Debug_File --
----------------------
@@ -173,6 +190,18 @@ package body Osint.C is
return Result;
end Create_Auxiliary_File;
+ -------------------
+ -- Create_C_File --
+ -------------------
+
+ procedure Create_C_File is
+ Dummy : Boolean;
+ begin
+ Set_File_Name ("c");
+ Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
+ Create_File_And_Check (Output_FD, Text);
+ end Create_C_File;
+
-----------------------
-- Create_Debug_File --
-----------------------
@@ -265,6 +294,17 @@ package body Osint.C is
end if;
end Debug_File_Eol_Length;
+ -------------------
+ -- Delete_C_File --
+ -------------------
+
+ procedure Delete_C_File is
+ Dummy : Boolean;
+ begin
+ Set_File_Name ("c");
+ Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
+ end Delete_C_File;
+
-------------------
-- Delete_H_File --
-------------------
diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads
index bde37c72723..583d9e4b433 100644
--- a/gcc/ada/osint-c.ads
+++ b/gcc/ada/osint-c.ads
@@ -160,22 +160,26 @@ package Osint.C is
--------------------------
-- These routines are used by the compiler when the C translation option
- -- is activated to write *.h files to the current object directory.
- -- Note that the files are written via the Output package routines, using
- -- Output_FD.
+ -- is activated to write *.c or *.h files to the current object directory.
+ -- Each routine exists in a C and an H form for the two kinds of files.
+ -- Only one of these files can be written at a time. Note that the files
+ -- are written via the Output package routines, using Output_FD.
+ procedure Create_C_File;
procedure Create_H_File;
- -- Creates the *.h file for the source file which is currently being
+ -- Creates the *.c/*.h file for the source file which is currently being
-- compiled (i.e. the file which was most recently returned by
-- Next_Main_Source).
+ procedure Close_C_File;
procedure Close_H_File;
- -- Closes the file created by Create_H file, flushing any buffers, etc.
+ -- Closes the file created by Create_C/H file, flushing any buffers, etc.
-- from writes by Write_C_File and Write_H_File;
+ procedure Delete_C_File;
procedure Delete_H_File;
- -- Deletes the .h file corresponding to the source file which is currently
- -- being compiled.
+ -- Deletes the .c/.h file corresponding to the source file which is
+ -- currently being compiled.
----------------------
-- List File Output --
--
2.45.2
