1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Alloc; use Alloc;
33 with Atree; use Atree;
35 with Sinfo; use Sinfo;
38 package body SCIL_LL is
40 procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id);
41 -- Copy the SCIL field from Source to Target (it is used as the argument
42 -- for a call to Set_Reporting_Proc in package atree).
44 function SCIL_Nodes_Table_Size return Pos;
45 -- Used to initialize the table of SCIL nodes because we do not want
46 -- to consume memory for this table if it is not required.
48 ----------------------------
49 -- SCIL_Nodes_Table_Size --
50 ----------------------------
52 function SCIL_Nodes_Table_Size return Pos is
55 return Alloc.Orig_Nodes_Initial;
59 end SCIL_Nodes_Table_Size;
61 package SCIL_Nodes is new Table.Table (
62 Table_Component_Type => Node_Id,
63 Table_Index_Type => Node_Id'Base,
64 Table_Low_Bound => First_Node_Id,
65 Table_Initial => SCIL_Nodes_Table_Size,
66 Table_Increment => Alloc.Orig_Nodes_Increment,
67 Table_Name => "SCIL_Nodes");
68 -- This table records the value of attribute SCIL_Node of all the
75 procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
77 Set_SCIL_Node (Target, Get_SCIL_Node (Source));
84 procedure Initialize is
87 Set_Reporting_Proc (Copy_SCIL_Node'Access);
94 function Get_SCIL_Node (N : Node_Id) return Node_Id is
99 return SCIL_Nodes.Table (N);
109 procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is
111 pragma Assert (Generate_SCIL);
113 if Present (Value) then
114 case Nkind (Value) is
115 when N_SCIL_Dispatch_Table_Tag_Init =>
116 pragma Assert (Nkind (N) = N_Object_Declaration);
119 when N_SCIL_Dispatching_Call =>
120 pragma Assert (Nkind (N) in N_Subprogram_Call);
123 when N_SCIL_Membership_Test =>
124 pragma Assert (Nkind_In (N, N_Identifier,
127 N_Expression_With_Actions));
131 pragma Assert (False);
136 if Atree.Last_Node_Id > SCIL_Nodes.Last then
137 SCIL_Nodes.Set_Last (Atree.Last_Node_Id);
140 SCIL_Nodes.Set_Item (N, Value);