Daily bump.
[official-gcc.git] / gcc / ada / scil_ll.adb
blob470ac98382ff7aedac3042011619f673f91ece63
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S C I L _ L L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
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. --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
32 with Alloc; use Alloc;
33 with Atree; use Atree;
34 with Opt; use Opt;
35 with Sinfo; use Sinfo;
36 with Table;
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
53 begin
54 if Generate_SCIL then
55 return Alloc.Orig_Nodes_Initial;
56 else
57 return 1;
58 end if;
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
69 -- tree nodes.
71 --------------------
72 -- Copy_SCIL_Node --
73 --------------------
75 procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
76 begin
77 Set_SCIL_Node (Target, Get_SCIL_Node (Source));
78 end Copy_SCIL_Node;
80 ----------------
81 -- Initialize --
82 ----------------
84 procedure Initialize is
85 begin
86 SCIL_Nodes.Init;
87 Set_Reporting_Proc (Copy_SCIL_Node'Access);
88 end Initialize;
90 -------------------
91 -- Get_SCIL_Node --
92 -------------------
94 function Get_SCIL_Node (N : Node_Id) return Node_Id is
95 begin
96 if Generate_SCIL
97 and then Present (N)
98 then
99 return SCIL_Nodes.Table (N);
100 else
101 return Empty;
102 end if;
103 end Get_SCIL_Node;
105 -------------------
106 -- Set_SCIL_Node --
107 -------------------
109 procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is
110 begin
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);
117 null;
119 when N_SCIL_Dispatching_Call =>
120 pragma Assert (Nkind (N) in N_Subprogram_Call);
121 null;
123 when N_SCIL_Membership_Test =>
124 pragma Assert (Nkind_In (N, N_Identifier,
125 N_And_Then,
126 N_Or_Else,
127 N_Expression_With_Actions));
128 null;
130 when others =>
131 pragma Assert (False);
132 raise Program_Error;
133 end case;
134 end if;
136 if Atree.Last_Node_Id > SCIL_Nodes.Last then
137 SCIL_Nodes.Set_Last (Atree.Last_Node_Id);
138 end if;
140 SCIL_Nodes.Set_Item (N, Value);
141 end Set_SCIL_Node;
143 end SCIL_LL;