------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S C I L _ L L                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2010-2023, 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.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- 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 Sinfo.Nodes;    use Sinfo.Nodes;
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 (N) in N_Identifier | N_And_Then | N_Or_Else |
                               N_Expression_With_Actions | N_Function_Call);
               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;