diff options
Diffstat (limited to 'gcc-4.9/gcc/ada/scil_ll.adb')
| -rw-r--r-- | gcc-4.9/gcc/ada/scil_ll.adb | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/scil_ll.adb b/gcc-4.9/gcc/ada/scil_ll.adb new file mode 100644 index 000000000..470ac9838 --- /dev/null +++ b/gcc-4.9/gcc/ada/scil_ll.adb @@ -0,0 +1,143 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S C I L _ L L -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2010-2012, 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Alloc; use Alloc; +with Atree; use Atree; +with Opt; use Opt; +with Sinfo; use Sinfo; +with Table; + +package body SCIL_LL is + + procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id); + -- Copy the SCIL field from Source to Target (it is used as the argument + -- for a call to Set_Reporting_Proc in package atree). + + function SCIL_Nodes_Table_Size return Pos; + -- Used to initialize the table of SCIL nodes because we do not want + -- to consume memory for this table if it is not required. + + ---------------------------- + -- SCIL_Nodes_Table_Size -- + ---------------------------- + + function SCIL_Nodes_Table_Size return Pos is + begin + if Generate_SCIL then + return Alloc.Orig_Nodes_Initial; + else + return 1; + end if; + end SCIL_Nodes_Table_Size; + + package SCIL_Nodes is new Table.Table ( + Table_Component_Type => Node_Id, + Table_Index_Type => Node_Id'Base, + Table_Low_Bound => First_Node_Id, + Table_Initial => SCIL_Nodes_Table_Size, + Table_Increment => Alloc.Orig_Nodes_Increment, + Table_Name => "SCIL_Nodes"); + -- This table records the value of attribute SCIL_Node of all the + -- tree nodes. + + -------------------- + -- Copy_SCIL_Node -- + -------------------- + + procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is + begin + Set_SCIL_Node (Target, Get_SCIL_Node (Source)); + end Copy_SCIL_Node; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize is + begin + SCIL_Nodes.Init; + Set_Reporting_Proc (Copy_SCIL_Node'Access); + end Initialize; + + ------------------- + -- Get_SCIL_Node -- + ------------------- + + function Get_SCIL_Node (N : Node_Id) return Node_Id is + begin + if Generate_SCIL + and then Present (N) + then + return SCIL_Nodes.Table (N); + else + return Empty; + end if; + end Get_SCIL_Node; + + ------------------- + -- Set_SCIL_Node -- + ------------------- + + procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is + begin + pragma Assert (Generate_SCIL); + + if Present (Value) then + case Nkind (Value) is + when N_SCIL_Dispatch_Table_Tag_Init => + pragma Assert (Nkind (N) = N_Object_Declaration); + null; + + when N_SCIL_Dispatching_Call => + pragma Assert (Nkind (N) in N_Subprogram_Call); + null; + + when N_SCIL_Membership_Test => + pragma Assert (Nkind_In (N, N_Identifier, + N_And_Then, + N_Or_Else, + N_Expression_With_Actions)); + null; + + when others => + pragma Assert (False); + raise Program_Error; + end case; + end if; + + if Atree.Last_Node_Id > SCIL_Nodes.Last then + SCIL_Nodes.Set_Last (Atree.Last_Node_Id); + end if; + + SCIL_Nodes.Set_Item (N, Value); + end Set_SCIL_Node; + +end SCIL_LL; |