projects / thirdparty / gcc.git / blame
| 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 | -- -- | |
| 8d0d46f4 | 9 | -- Copyright (C) 2010-2021, 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 -- | |
| b740cf28 AC |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| 17 | -- for more details. You should have received a copy of the GNU General -- | |
| 18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- | |
| 19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
| 7665e4bd AC |
20 | -- -- |
| 21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
| 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
| 23 | -- -- | |
| 24 | ------------------------------------------------------------------------------ | |
| 25 | ||
| 5f325af2 AC |
26 | with Atree; use Atree; |
| 27 | with Opt; use Opt; | |
| 76f9c7f4 BD |
28 | with Sinfo; use Sinfo; |
| 29 | with Sinfo.Nodes; use Sinfo.Nodes; | |
| 5f325af2 | 30 | with System.HTable; use System.HTable; |
| 7665e4bd AC |
31 | |
| 32 | package body SCIL_LL is | |
| 33 | ||
| e771c085 AC |
34 | procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id); |
| 35 | -- Copy the SCIL field from Source to Target (it is used as the argument | |
| 36 | -- for a call to Set_Reporting_Proc in package atree). | |
| 37 | ||
| 5f325af2 AC |
38 | type Header_Num is range 1 .. 4096; |
| 39 | ||
| 40 | function Hash (N : Node_Id) return Header_Num; | |
| 41 | -- Hash function for Node_Ids | |
| 42 | ||
| 43 | -------------------------- | |
| 44 | -- Internal Hash Tables -- | |
| 45 | -------------------------- | |
| 46 | ||
| 5f325af2 AC |
47 | package SCIL_Nodes is new Simple_HTable |
| 48 | (Header_Num => Header_Num, | |
| 49 | Element => Node_Id, | |
| 50 | No_Element => Empty, | |
| 51 | Key => Node_Id, | |
| 52 | Hash => Hash, | |
| 53 | Equal => "="); | |
| b5f3c913 | 54 | -- This table records the value of attribute SCIL_Node of tree nodes |
| 5f325af2 AC |
55 | |
| 56 | -------------------- | |
| 57 | -- Copy_SCIL_Node -- | |
| 58 | -------------------- | |
| 59 | ||
| 60 | procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is | |
| 61 | begin | |
| 62 | Set_SCIL_Node (Target, Get_SCIL_Node (Source)); | |
| 63 | end Copy_SCIL_Node; | |
| 7665e4bd | 64 | |
| 7665e4bd AC |
65 | ------------------- |
| 66 | -- Get_SCIL_Node -- | |
| 67 | ------------------- | |
| 68 | ||
| 69 | function Get_SCIL_Node (N : Node_Id) return Node_Id is | |
| 70 | begin | |
| 71 | if Generate_SCIL | |
| 72 | and then Present (N) | |
| 73 | then | |
| 5f325af2 | 74 | return SCIL_Nodes.Get (N); |
| 7665e4bd AC |
75 | else |
| 76 | return Empty; | |
| 77 | end if; | |
| 78 | end Get_SCIL_Node; | |
| 79 | ||
| 5f325af2 AC |
80 | ---------- |
| 81 | -- Hash -- | |
| 82 | ---------- | |
| 83 | ||
| 84 | function Hash (N : Node_Id) return Header_Num is | |
| 85 | begin | |
| 86 | return Header_Num (1 + N mod Node_Id (Header_Num'Last)); | |
| 87 | end Hash; | |
| 88 | ||
| 89 | ---------------- | |
| 90 | -- Initialize -- | |
| 91 | ---------------- | |
| 92 | ||
| 93 | procedure Initialize is | |
| 94 | begin | |
| 95 | SCIL_Nodes.Reset; | |
| 5f325af2 AC |
96 | Set_Reporting_Proc (Copy_SCIL_Node'Access); |
| 97 | end Initialize; | |
| 98 | ||
| 7665e4bd AC |
99 | ------------------- |
| 100 | -- Set_SCIL_Node -- | |
| 101 | ------------------- | |
| 102 | ||
| 103 | procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is | |
| 104 | begin | |
| 105 | pragma Assert (Generate_SCIL); | |
| 106 | ||
| 107 | if Present (Value) then | |
| 108 | case Nkind (Value) is | |
| 109 | when N_SCIL_Dispatch_Table_Tag_Init => | |
| 110 | pragma Assert (Nkind (N) = N_Object_Declaration); | |
| 111 | null; | |
| 112 | ||
| 113 | when N_SCIL_Dispatching_Call => | |
| d3b00ce3 | 114 | pragma Assert (Nkind (N) in N_Subprogram_Call); |
| 7665e4bd AC |
115 | null; |
| 116 | ||
| 117 | when N_SCIL_Membership_Test => | |
| 4a08c95c AC |
118 | pragma Assert |
| 119 | (Nkind (N) in N_Identifier | N_And_Then | N_Or_Else | | |
| 3d5f1f27 | 120 | N_Expression_With_Actions | N_Function_Call); |
| 7665e4bd AC |
121 | null; |
| 122 | ||
| 123 | when others => | |
| 124 | pragma Assert (False); | |
| 125 | raise Program_Error; | |
| 126 | end case; | |
| 127 | end if; | |
| 128 | ||
| 5f325af2 | 129 | SCIL_Nodes.Set (N, Value); |
| 7665e4bd AC |
130 | end Set_SCIL_Node; |
| 131 | ||
| 132 | end SCIL_LL; |