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------------------------------------------------------------------------------
31
32with Alloc; use Alloc;
33with Atree; use Atree;
34with Opt;   use Opt;
35with Sinfo; use Sinfo;
36with Table;
37
38package body SCIL_LL is
39
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).
43
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.
47
48   ----------------------------
49   --  SCIL_Nodes_Table_Size --
50   ----------------------------
51
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;
60
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.
70
71   --------------------
72   -- Copy_SCIL_Node --
73   --------------------
74
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;
79
80   ----------------
81   -- Initialize --
82   ----------------
83
84   procedure Initialize is
85   begin
86      SCIL_Nodes.Init;
87      Set_Reporting_Proc (Copy_SCIL_Node'Access);
88   end Initialize;
89
90   -------------------
91   -- Get_SCIL_Node --
92   -------------------
93
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;
104
105   -------------------
106   -- Set_SCIL_Node --
107   -------------------
108
109   procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is
110   begin
111      pragma Assert (Generate_SCIL);
112
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;
118
119            when N_SCIL_Dispatching_Call =>
120               pragma Assert (Nkind (N) in N_Subprogram_Call);
121               null;
122
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;
129
130            when others =>
131               pragma Assert (False);
132               raise Program_Error;
133         end case;
134      end if;
135
136      if Atree.Last_Node_Id > SCIL_Nodes.Last then
137         SCIL_Nodes.Set_Last (Atree.Last_Node_Id);
138      end if;
139
140      SCIL_Nodes.Set_Item (N, Value);
141   end Set_SCIL_Node;
142
143end SCIL_LL;
144