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