From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/scil_ll.adb | 144 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 144 insertions(+) create mode 100644 gcc/ada/scil_ll.adb (limited to 'gcc/ada/scil_ll.adb') diff --git a/gcc/ada/scil_ll.adb b/gcc/ada/scil_ll.adb new file mode 100644 index 000000000..4591d8ef2 --- /dev/null +++ b/gcc/ada/scil_ll.adb @@ -0,0 +1,144 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S C I L _ L L -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2010, 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 -- +-- . -- +-- -- +-- 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_In (N, N_Function_Call, + N_Procedure_Call_Statement)); + 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; -- cgit v1.2.3