[thirdparty/gcc.git] / gcc / ada / scil_ll.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S C I L _ L L                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2010-2020, 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 Atree;         use Atree;
with Opt;           use Opt;
with Sinfo;         use Sinfo;
with System.HTable; use System.HTable;

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).

   type Header_Num is range 1 .. 4096;

   function Hash (N : Node_Id) return Header_Num;
   --  Hash function for Node_Ids

   --------------------------
   -- Internal Hash Tables --
   --------------------------

   package SCIL_Nodes is new Simple_HTable
     (Header_Num => Header_Num,
      Element    => Node_Id,
      No_Element => Empty,
      Key        => Node_Id,
      Hash       => Hash,
      Equal      => "=");
   --  This table records the value of attribute SCIL_Node of 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;

   -------------------
   -- 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.Get (N);
      else
         return Empty;
      end if;
   end Get_SCIL_Node;

   ----------
   -- Hash --
   ----------

   function Hash (N : Node_Id) return Header_Num is
   begin
      return Header_Num (1 + N mod Node_Id (Header_Num'Last));
   end Hash;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      SCIL_Nodes.Reset;
      Set_Reporting_Proc (Copy_SCIL_Node'Access);
   end Initialize;

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

      SCIL_Nodes.Set (N, Value);
   end Set_SCIL_Node;

end SCIL_LL;
Commit	Line	Data
7665e4bd AC	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- S C I L _ L L --
	6	-- --
	7	-- B o d y --
	8	-- --
4b490c1e	9	-- Copyright (C) 2010-2020, Free Software Foundation, Inc. --
7665e4bd AC	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
5f325af2 AC	32	with Atree; use Atree;
	33	with Opt; use Opt;
	34	with Sinfo; use Sinfo;
	35	with System.HTable; use System.HTable;
7665e4bd AC	36
	37	package body SCIL_LL is
	38
e771c085 AC	39	procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id);
	40	-- Copy the SCIL field from Source to Target (it is used as the argument
	41	-- for a call to Set_Reporting_Proc in package atree).
	42
5f325af2 AC	43	type Header_Num is range 1 .. 4096;
	44
	45	function Hash (N : Node_Id) return Header_Num;
	46	-- Hash function for Node_Ids
	47
	48	--------------------------
	49	-- Internal Hash Tables --
	50	--------------------------
	51
5f325af2 AC	52	package SCIL_Nodes is new Simple_HTable
	53	(Header_Num => Header_Num,
	54	Element => Node_Id,
	55	No_Element => Empty,
	56	Key => Node_Id,
	57	Hash => Hash,
	58	Equal => "=");
b5f3c913	59	-- This table records the value of attribute SCIL_Node of tree nodes
5f325af2 AC	60
	61	--------------------
	62	-- Copy_SCIL_Node --
	63	--------------------
	64
	65	procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
	66	begin
	67	Set_SCIL_Node (Target, Get_SCIL_Node (Source));
	68	end Copy_SCIL_Node;
7665e4bd	69
7665e4bd AC	70	-------------------
	71	-- Get_SCIL_Node --
	72	-------------------
	73
	74	function Get_SCIL_Node (N : Node_Id) return Node_Id is
	75	begin
	76	if Generate_SCIL
	77	and then Present (N)
	78	then
5f325af2	79	return SCIL_Nodes.Get (N);
7665e4bd AC	80	else
	81	return Empty;
	82	end if;
	83	end Get_SCIL_Node;
	84
5f325af2 AC	85	----------
	86	-- Hash --
	87	----------
	88
	89	function Hash (N : Node_Id) return Header_Num is
	90	begin
	91	return Header_Num (1 + N mod Node_Id (Header_Num'Last));
	92	end Hash;
	93
	94	----------------
	95	-- Initialize --
	96	----------------
	97
	98	procedure Initialize is
	99	begin
	100	SCIL_Nodes.Reset;
5f325af2 AC	101	Set_Reporting_Proc (Copy_SCIL_Node'Access);
	102	end Initialize;
	103
7665e4bd AC	104	-------------------
	105	-- Set_SCIL_Node --
	106	-------------------
	107
	108	procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is
	109	begin
	110	pragma Assert (Generate_SCIL);
	111
	112	if Present (Value) then
	113	case Nkind (Value) is
	114	when N_SCIL_Dispatch_Table_Tag_Init =>
	115	pragma Assert (Nkind (N) = N_Object_Declaration);
	116	null;
	117
	118	when N_SCIL_Dispatching_Call =>
d3b00ce3	119	pragma Assert (Nkind (N) in N_Subprogram_Call);
7665e4bd AC	120	null;
	121
	122	when N_SCIL_Membership_Test =>
	123	pragma Assert (Nkind_In (N, N_Identifier,
	124	N_And_Then,
	125	N_Or_Else,
	126	N_Expression_With_Actions));
	127	null;
	128
	129	when others =>
	130	pragma Assert (False);
	131	raise Program_Error;
	132	end case;
	133	end if;
	134
5f325af2	135	SCIL_Nodes.Set (N, Value);
7665e4bd AC	136	end Set_SCIL_Node;
	137
	138	end SCIL_LL;