Skip to content

R
riscv-gcc-1
Commit d06b3b1d by Javier Miranda Committed by Arnaud Charlet
Options

frontend.adb (Frontend): Code cleanup. 

2009-07-29  Javier Miranda  <miranda@adacore.com>

	* frontend.adb (Frontend): Code cleanup.
	* exp_atag.ads, exp_atag.adb (Build_Get_Predefined_Prim_Op_Address):
	Rewriten as a procedure because it a new out-mode parameters to
	keep up-to-date the controlling tag node in the caller.
	(Build_Get_Prim_Op_Address): Rewriten as a procedure because it has a
	new out-mode parameter to keep up-to-date the controlling tag node in
	the caller.
	* exp_ch7.adb, sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb,
	exp_ch6.adb, sem_ch4.adb, exp_ch3.adb: Add new dependency on new
	package Sem_SCIL.
	* sem_aux.ads, sem_aux.adb (First_Non_SCIL_Node): Removed. Routine
	available in new package Sem_SCIL.
	(Next_Non_SCIL_Node): Ditto.
	* exp_disp.adb (Adjust_SCIL_Node): Removed. Routine available in new
	package Sem_SCIL.
	(Expand_Dispatching_Call): Update call to modified Exp_Atags routines
	plus complete decoration of SCIL dispatching node.
	(Find_SCIL_Node): Removed. Routine available in new package Sem_SCIL.
	* exp_disp.ads (Adjust_SCIL_Node): Removed. Routine available in new
	package Sem_SCIL.
	(Find_SCIL_Node): Removed. Routine available in new package Sem_SCIL.
	* exp_ch3.adb (Build_Init_Procedure): Fix comment.
	* sem_scil.ads, sem_scil.adb: New files.
	* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Addition of sem_scil.o.
	Update dependencies.

From-SVN: r150199
parent bc4eac6d
Showing with 149 additions and 112 deletions
gcc/ada/ChangeLog
2009-07-29 Javier Miranda <miranda@adacore.com>
* frontend.adb (Frontend): Code cleanup.
* exp_atag.ads, exp_atag.adb (Build_Get_Predefined_Prim_Op_Address):
Rewriten as a procedure because it a new out-mode parameters to
keep up-to-date the controlling tag node in the caller.
(Build_Get_Prim_Op_Address): Rewriten as a procedure because it has a
new out-mode parameter to keep up-to-date the controlling tag node in
the caller.
* exp_ch7.adb, sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb,
exp_ch6.adb, sem_ch4.adb, exp_ch3.adb: Add new dependency on new
package Sem_SCIL.
* sem_aux.ads, sem_aux.adb (First_Non_SCIL_Node): Removed. Routine
available in new package Sem_SCIL.
(Next_Non_SCIL_Node): Ditto.
* exp_disp.adb (Adjust_SCIL_Node): Removed. Routine available in new
package Sem_SCIL.
(Expand_Dispatching_Call): Update call to modified Exp_Atags routines
plus complete decoration of SCIL dispatching node.
(Find_SCIL_Node): Removed. Routine available in new package Sem_SCIL.
* exp_disp.ads (Adjust_SCIL_Node): Removed. Routine available in new
package Sem_SCIL.
(Find_SCIL_Node): Removed. Routine available in new package Sem_SCIL.
* exp_ch3.adb (Build_Init_Procedure): Fix comment.
* sem_scil.ads, sem_scil.adb: New files.
* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Addition of sem_scil.o.
Update dependencies.
2009-07-28 Robert Dewar <dewar@adacore.com>
* adaint.h, einfo.ads, prj.adb, sem_util.adb, makeutl.ads,
......
gcc/ada/exp_atag.adb
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -227,12 +227,22 @@ package body Exp_Atag is
-- Build_Get_Predefined_Prim_Op_Address --
------------------------------------------
function Build_Get_Predefined_Prim_Op_Address
procedure Build_Get_Predefined_Prim_Op_Address
(Loc : Source_Ptr;
Tag_Node : Node_Id;
Position : Uint) return Node_Id
Position : Uint;
Tag_Node : in out Node_Id;
New_Node : out Node_Id)
is
Ctrl_Tag : Node_Id;
begin
Ctrl_Tag := Unchecked_Convert_To (RTE (RE_Address), Tag_Node);
-- Unchecked_Convert_To relocates the controlling tag node and therefore
-- we must update it.
Tag_Node := Expression (Ctrl_Tag);
-- Build code that retrieves the address of the dispatch table
-- containing the predefined Ada primitives:
--
......@@ -240,7 +250,7 @@ package body Exp_Atag is
-- To_Predef_Prims_Table_Ptr
-- (To_Addr_Ptr (To_Address (Tag) - Predef_Prims_Offset).all);
return
New_Node :=
Make_Indexed_Component (Loc,
Prefix =>
Unchecked_Convert_To (RTE (RE_Predef_Prims_Table_Ptr),
......@@ -257,7 +267,7 @@ package body Exp_Atag is
Make_Identifier (Loc,
Chars => Name_Op_Subtract)),
Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Address), Tag_Node),
Ctrl_Tag,
New_Reference_To (RTE (RE_DT_Predef_Prims_Offset),
Loc)))))),
Expressions =>
......@@ -337,12 +347,15 @@ package body Exp_Atag is
-- Build_Get_Prim_Op_Address --
-------------------------------
function Build_Get_Prim_Op_Address
procedure Build_Get_Prim_Op_Address
(Loc : Source_Ptr;
Typ : Entity_Id;
Tag_Node : Node_Id;
Position : Uint) return Node_Id
Position : Uint;
Tag_Node : in out Node_Id;
New_Node : out Node_Id)
is
New_Prefix : Node_Id;
begin
pragma Assert
(Position <= DT_Entry_Count (First_Tag_Component (Typ)));
......@@ -351,11 +364,18 @@ package body Exp_Atag is
-- declaration required to convert the tag into a pointer to
-- the prims_ptr table (see Freeze_Record_Type).
return
New_Prefix :=
Unchecked_Convert_To
(Node (Last_Elmt (Access_Disp_Table (Typ))), Tag_Node);
-- Unchecked_Convert_To relocates the controlling tag node and therefore
-- we must update it.
Tag_Node := Expression (New_Prefix);
New_Node :=
Make_Indexed_Component (Loc,
Prefix =>
Unchecked_Convert_To
(Node (Last_Elmt (Access_Disp_Table (Typ))), Tag_Node),
Prefix => New_Prefix,
Expressions => New_List (Make_Integer_Literal (Loc, Position)));
end Build_Get_Prim_Op_Address;
......@@ -482,11 +502,15 @@ package body Exp_Atag is
Position : Uint;
Address_Node : Node_Id) return Node_Id
is
Ctrl_Tag : Node_Id := Tag_Node;
New_Node : Node_Id;
begin
Build_Get_Prim_Op_Address (Loc, Typ, Position, Ctrl_Tag, New_Node);
return
Make_Assignment_Statement (Loc,
Name => Build_Get_Prim_Op_Address
(Loc, Typ, Tag_Node, Position),
Name => New_Node,
Expression => Address_Node);
end Build_Set_Prim_Op_Address;
......
gcc/ada/exp_atag.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -61,23 +61,26 @@ package Exp_Atag is
--
-- Generates: TSD (Tag).Access_Level
function Build_Get_Predefined_Prim_Op_Address
procedure Build_Get_Predefined_Prim_Op_Address
(Loc : Source_Ptr;
Tag_Node : Node_Id;
Position : Uint) return Node_Id;
Position : Uint;
Tag_Node : in out Node_Id;
New_Node : out Node_Id);
-- Given a pointer to a dispatch table (T) and a position in the DT, build
-- code that gets the address of the predefined virtual function stored in
-- it (used for dispatching calls).
-- it (used for dispatching calls). Tag_Node is relocated.
--
-- Generates: Predefined_DT (Tag).D (Position);
function Build_Get_Prim_Op_Address
procedure Build_Get_Prim_Op_Address
(Loc : Source_Ptr;
Typ : Entity_Id;
Tag_Node : Node_Id;
Position : Uint) return Node_Id;
Position : Uint;
Tag_Node : in out Node_Id;
New_Node : out Node_Id);
-- Build code that retrieves the address of the virtual function stored in
-- a given position of the dispatch table (used for dispatching calls).
-- Tag_Node is relocated.
--
-- Generates: To_Tag (Tag).D (Position);
......
gcc/ada/exp_ch3.adb
......@@ -59,6 +59,7 @@ with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
......@@ -2507,8 +2508,8 @@ package body Exp_Ch3 is
if List_Length (Body_Stmts) = 1
-- We must skip SCIL nodes because they are currently implemented
-- as special N_Null_Statement nodes.
-- We must skip SCIL nodes because they may have been added to this
-- list by Insert_Actions.
and then Nkind (First_Non_SCIL_Node (Body_Stmts)) = N_Null_Statement
and then VM_Target = No_VM
......
gcc/ada/exp_ch4.adb
......@@ -58,6 +58,7 @@ with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
......
gcc/ada/exp_ch6.adb
......@@ -64,6 +64,7 @@ with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Mech; use Sem_Mech;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
......
gcc/ada/exp_ch7.adb
......@@ -54,6 +54,7 @@ with Sem_Ch3; use Sem_Ch3;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Snames; use Snames;
......
gcc/ada/exp_disp.ads
......@@ -170,10 +170,6 @@ package Exp_Disp is
-- Exp_Disp.Default_Prim_Op_Position - indirect use
-- Exp_Disp.Set_All_DT_Position - direct use
procedure Adjust_SCIL_Node (Old_Node : Node_Id; New_Node : Node_Id);
-- Searches for a SCIL dispatching node associated with Old_Node. If found
-- then update its SCIL_Related_Node field to reference New_Node.
procedure Apply_Tag_Checks (Call_Node : Node_Id);
-- Generate checks required on dispatching calls
......@@ -219,10 +215,6 @@ package Exp_Disp is
-- Otherwise they are set to the defining identifier and the subprogram
-- body of the generated thunk.
function Find_SCIL_Node (Node : Node_Id) return Node_Id;
-- Searches for a SCIL dispatching node associated with Node. If not found
-- then return Empty.
function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-251): Determines if E is a predefined primitive operation
......
gcc/ada/exp_util.adb
......@@ -32,7 +32,6 @@ with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
with Exp_Disp; use Exp_Disp;
with Inline; use Inline;
with Itypes; use Itypes;
with Lib; use Lib;
......@@ -44,6 +43,7 @@ with Rident; use Rident;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_SCIL; use Sem_SCIL;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
......
gcc/ada/frontend.adb
......@@ -46,12 +46,13 @@ with Prep;
with Prepcomp;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind;
with Rtsfind; use Rtsfind;
with Sprint;
with Scn; use Scn;
with Sem; use Sem;
with Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_SCIL;
with Sem_Elab; use Sem_Elab;
with Sem_Prag; use Sem_Prag;
with Sem_Warn; use Sem_Warn;
......@@ -63,40 +64,6 @@ with Tbuild; use Tbuild;
with Types; use Types;
procedure Frontend is
-- Comment: I think SCIL processing is gettings scattered too much, this
-- is a good case, why should the top level frontend driver be doing stuff
-- at this level, seems wrong to me. I think we should introduce a new
-- unit Sem_SCIL, and move a lot of this SCIL stuff there. ???
function Check_SCIL_Node (N : Node_Id) return Traverse_Result;
-- Process a single node during the tree traversal, verifying that field
-- SCIL_Related_Node of SCIL dispatching call nodes reference subprogram
-- calls.
procedure Check_SCIL_Nodes is new Traverse_Proc (Check_SCIL_Node);
-- The traversal procedure itself
---------------------
-- Check_SCIL_Node --
---------------------
function Check_SCIL_Node (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_SCIL_Dispatching_Call then
if not Nkind_In (SCIL_Related_Node (N), N_Function_Call,
N_Procedure_Call_Statement)
then
pragma Assert (False);
raise Program_Error;
end if;
return Skip;
else
return OK;
end if;
end Check_SCIL_Node;
Config_Pragmas : List_Id;
-- Gather configuration pragmas
......@@ -404,7 +371,7 @@ begin
-- dispatching calls reference subprogram calls.
if Generate_SCIL then
pragma Debug (Check_SCIL_Nodes (Cunit (Main_Unit)));
pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit)));
null;
end if;
......
gcc/ada/sem_aux.adb
......@@ -33,7 +33,6 @@
with Atree; use Atree;
with Einfo; use Einfo;
with Namet; use Namet;
with Nlists; use Nlists;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
......@@ -236,22 +235,6 @@ package body Sem_Aux is
return Ent;
end First_Discriminant;
-------------------------
-- First_Non_SCIL_Node --
-------------------------
function First_Non_SCIL_Node (L : List_Id) return Node_Id is
N : Node_Id;
begin
N := First (L);
while Nkind (N) in N_SCIL_Node loop
Next (N);
end loop;
return N;
end First_Non_SCIL_Node;
-------------------------------
-- First_Stored_Discriminant --
-------------------------------
......@@ -754,22 +737,6 @@ package body Sem_Aux is
end Nearest_Dynamic_Scope;
------------------------
-- Next_Non_SCIL_Node --
------------------------
function Next_Non_SCIL_Node (N : Node_Id) return Node_Id is
Aux_N : Node_Id;
begin
Aux_N := Next (N);
while Nkind (Aux_N) in N_SCIL_Node loop
Next (Aux_N);
end loop;
return Aux_N;
end Next_Non_SCIL_Node;
------------------------
-- Next_Tag_Component --
------------------------
......
gcc/ada/sem_aux.ads
......@@ -138,9 +138,6 @@ package Sem_Aux is
-- discriminants from Gigi's standpoint, i.e. those that will be stored in
-- actual objects of the type.
function First_Non_SCIL_Node (L : List_Id) return Node_Id;
-- Returns the first non-SCIL node of list L
function First_Subtype (Typ : Entity_Id) return Entity_Id;
-- Applies to all types and subtypes. For types, yields the first subtype
-- of the type. For subtypes, yields the first subtype of the base type of
......@@ -188,10 +185,6 @@ package Sem_Aux is
-- a dynamic scope, then it is returned. Otherwise the result is the same
-- as that returned by Enclosing_Dynamic_Scope.
function Next_Non_SCIL_Node (N : Node_Id) return Node_Id;
-- N must be a member of a list. Returns the next non SCIL node in the list
-- containing N, or Empty if this is the last non SCIL node in the list.
function Next_Tag_Component (Tag : Entity_Id) return Entity_Id;
-- Tag must be an entity representing a _Tag field of a tagged record.
-- The result returned is the next _Tag field in this record, or Empty
......
gcc/ada/sem_ch4.adb
......@@ -28,7 +28,6 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Disp; use Exp_Disp;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Itypes; use Itypes;
......@@ -48,6 +47,7 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_SCIL; use Sem_SCIL;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
......
gcc/ada/sem_ch5.adb
......@@ -28,7 +28,6 @@ with Checks; use Checks;
with Einfo; use Einfo;
with Errout; use Errout;
with Expander; use Expander;
with Exp_Disp; use Exp_Disp;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
......@@ -47,6 +46,7 @@ with Sem_Disp; use Sem_Disp;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
......
gcc/ada/sem_scil.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ S C I L --
-- --
-- B o d y --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains routines involved in the frontend addition and
-- verification of SCIL nodes.
with Atree; use Atree;
with Types; use Types;
package Sem_SCIL is
-- Here would be a good place to document what SCIL is all about ???
procedure Adjust_SCIL_Node (Old_Node : Node_Id; New_Node : Node_Id);
-- Searches for a SCIL dispatching node associated with Old_Node. If found
-- then update its SCIL_Related_Node field to reference New_Node.
function Check_SCIL_Node (N : Node_Id) return Traverse_Result;
-- Process a single node during the tree traversal. Done to verify that
-- SCIL nodes decoration fulfill the requirements of the SCIL backend.
procedure Check_SCIL_Nodes is new Traverse_Proc (Check_SCIL_Node);
-- The traversal procedure itself
function Find_SCIL_Node (Node : Node_Id) return Node_Id;
-- Searches for a SCIL dispatching node associated with Node. If not found
-- then return Empty.
function First_Non_SCIL_Node (L : List_Id) return Node_Id;
-- Returns the first non-SCIL node of list L
function Next_Non_SCIL_Node (N : Node_Id) return Node_Id;
-- N must be a member of a list. Returns the next non SCIL node in the list
-- containing N, or Empty if this is the last non SCIL node in the list.
end Sem_SCIL;
gcc/ada/sem_util.adb
......@@ -50,6 +50,7 @@ with Sem_Ch8; use Sem_Ch8;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_SCIL; use Sem_SCIL;
with Sem_Type; use Sem_Type;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment