gcc/gcc/ada/scil_ll.adb

------------------------------------------------------------------------------
--                                                                          --
--                         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;