blob: 487dd3630f334a75cad22cb0c299ffbbf2513eab [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S C I L _ L L --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010-2021, 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;