1-- EDIF nodes. This is in fact -*- Ada -*- 2-- Copyright (C) 2019 Tristan Gingold 3-- 4-- GHDL is free software; you can redistribute it and/or modify it under 5-- the terms of the GNU General Public License as published by the Free 6-- Software Foundation; either version 2, or (at your option) any later 7-- version. 8-- 9-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY 10-- WARRANTY; without even the implied warranty of MERCHANTABILITY or 11-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 12-- for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with GHDL; see the file COPYING. If not, write to the Free 16-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 17-- 02111-1307, USA. 18 19with Ada.Unchecked_Conversion; 20with Tables; 21with Edif.Nodes_Meta; use Edif.Nodes_Meta; 22 23package body Edif.Nodes is 24 type Format_Type is 25 ( 26 Format_X1, 27 Format_X2, 28 Format_X4 29 ); 30 31 -- Common fields are: 32 -- Nkind : Kind_Type 33 -- State1 : Bit2_Type 34 -- Flag1 : Boolean 35 -- Flag2 : Boolean 36 -- Flag3 : Boolean 37 -- Flag4 : Boolean 38 -- Flag5 : Boolean 39 -- Flag6 : Boolean 40 -- Flag7 : Boolean 41 -- Flag8 : Boolean 42 -- Flag9 : Boolean 43 -- Flag10 : Boolean 44 -- Flag11 : Boolean 45 -- Flag12 : Boolean 46 -- Flag13 : Boolean 47 -- Flag14 : Boolean 48 -- Field0 : Node 49 -- Field1 : Node 50 -- Field2 : Node 51 52 -- Fields of Format_X1: 53 54 -- Fields of Format_X2: 55 -- Field3 : Node 56 -- Field4 : Node 57 -- Field5 : Node 58 59 -- Fields of Format_X4: 60 -- Field3 : Node 61 -- Field4 : Node 62 -- Field5 : Node 63 -- Field6 : Node 64 -- Field7 : Node 65 -- Field8 : Node 66 -- Field9 : Node 67 -- Field10 : Node 68 -- Field11 : Node 69 70 type Bit2_Type is range 0 .. 2 ** 2 - 1; 71 72 type Node_Record is record 73 Kind : Nkind; -- 8 bits 74 State1 : Bit2_Type; 75 Flag1 : Boolean; 76 Flag2 : Boolean; 77 Flag3 : Boolean; 78 Flag4 : Boolean; 79 Flag5 : Boolean; 80 Flag6 : Boolean; 81 Flag7 : Boolean; 82 Flag8 : Boolean; 83 Flag9 : Boolean; 84 Flag10 : Boolean; 85 Flag11 : Boolean; 86 Flag12 : Boolean; 87 Flag13 : Boolean; 88 Flag14 : Boolean; 89 Flag15 : Boolean; 90 Flag16 : Boolean; 91 Flag17 : Boolean; 92 Flag18 : Boolean; 93 Flag19 : Boolean; 94 Flag20 : Boolean; 95 Flag21 : Boolean; 96 Flag22 : Boolean; 97 98 Field0 : Node; 99 Field1 : Node; 100 Field2 : Node; 101 end record; 102 pragma Pack (Node_Record); 103 for Node_Record'Size use 4 * 32; 104 105 package Nodet is new Tables 106 (Table_Component_Type => Node_Record, 107 Table_Index_Type => Node, 108 Table_Low_Bound => 2, 109 Table_Initial => 1024); 110 111 Init_Node : constant Node_Record := 112 (Kind => N_Error, 113 Flag1 | Flag2 | Flag3 | Flag4 | Flag5 | Flag6 | Flag7 | Flag8 => False, 114 Flag9 | Flag10 | Flag11 | Flag12 | Flag13 | Flag14 | Flag15 => False, 115 Flag16 | Flag17 | Flag18 | Flag19 | Flag20 | Flag21 | Flag22 => False, 116 State1 => 0, 117 Field0 | Field1 | Field2 => 0); 118 119 Free_Nodes : Node := Null_Node; 120 121 122 function Get_Last_Node return Node is 123 begin 124 return Nodet.Last; 125 end Get_Last_Node; 126 127 function Node_To_Uns32 is new Ada.Unchecked_Conversion 128 (Source => Node, Target => Uns32); 129 function Uns32_To_Node is new Ada.Unchecked_Conversion 130 (Source => Uns32, Target => Node); 131 132 function Node_To_Int32 is new Ada.Unchecked_Conversion 133 (Source => Node, Target => Int32); 134 function Int32_To_Node is new Ada.Unchecked_Conversion 135 (Source => Int32, Target => Node); 136 137 function Bit2_Type_To_Dir_Type is new Ada.Unchecked_Conversion 138 (Bit2_Type, Dir_Type); 139 function Dir_Type_To_Bit2_Type is new Ada.Unchecked_Conversion 140 (Dir_Type, Bit2_Type); 141 142 143 function Node_To_Location_Type (N : Node) return Location_Type is 144 begin 145 return Location_Type (N); 146 end Node_To_Location_Type; 147 148 function Location_Type_To_Node (L : Location_Type) return Node is 149 begin 150 return Node (L); 151 end Location_Type_To_Node; 152 153 154 procedure Set_Kind (N : Node; K : Nkind) is 155 begin 156 Nodet.Table (N).Kind := K; 157 end Set_Kind; 158 159 function Get_Kind (N : Node) return Nkind is 160 begin 161 pragma Assert (N /= Null_Node, "get_kind: null node"); 162 return Nodet.Table (N).Kind; 163 end Get_Kind; 164 165 procedure Set_State1 (N : Node; State : Bit2_Type) is 166 begin 167 Nodet.Table (N).State1 := State; 168 end Set_State1; 169 170 function Get_State1 (N : Node) return Bit2_Type is 171 begin 172 return Nodet.Table (N).State1; 173 end Get_State1; 174 175 176 procedure Set_Flag1 (N : Node; Flag : Boolean) is 177 begin 178 Nodet.Table (N).Flag1 := Flag; 179 end Set_Flag1; 180 181 function Get_Flag1 (N : Node) return Boolean is 182 begin 183 return Nodet.Table (N).Flag1; 184 end Get_Flag1; 185 186 187 procedure Set_Field0 (N : Node; V : Node) is 188 begin 189 Nodet.Table (N).Field0 := V; 190 end Set_Field0; 191 192 function Get_Field0 (N : Node) return Node is 193 begin 194 return Nodet.Table (N).Field0; 195 end Get_Field0; 196 197 198 procedure Set_Field1 (N : Node; V : Node) is 199 begin 200 Nodet.Table (N).Field1 := V; 201 end Set_Field1; 202 203 function Get_Field1 (N : Node) return Node is 204 begin 205 return Nodet.Table (N).Field1; 206 end Get_Field1; 207 208 209 procedure Set_Field2 (N : Node; V : Node) is 210 begin 211 Nodet.Table (N).Field2 := V; 212 end Set_Field2; 213 214 function Get_Field2 (N : Node) return Node is 215 begin 216 return Nodet.Table (N).Field2; 217 end Get_Field2; 218 219 220 procedure Set_Field3 (N : Node; V : Node) is 221 begin 222 Nodet.Table (N + 1).Field0 := V; 223 end Set_Field3; 224 225 function Get_Field3 (N : Node) return Node is 226 begin 227 return Nodet.Table (N + 1).Field0; 228 end Get_Field3; 229 230 231 procedure Set_Field4 (N : Node; V : Node) is 232 begin 233 Nodet.Table (N + 1).Field1 := V; 234 end Set_Field4; 235 236 function Get_Field4 (N : Node) return Node is 237 begin 238 return Nodet.Table (N + 1).Field1; 239 end Get_Field4; 240 241 242 procedure Set_Field5 (N : Node; V : Node) is 243 begin 244 Nodet.Table (N + 1).Field2 := V; 245 end Set_Field5; 246 247 function Get_Field5 (N : Node) return Node is 248 begin 249 return Nodet.Table (N + 1).Field2; 250 end Get_Field5; 251 252 253 procedure Set_Field6 (N : Node; V : Node) is 254 begin 255 Nodet.Table (N + 2).Field0 := V; 256 end Set_Field6; 257 258 function Get_Field6 (N : Node) return Node is 259 begin 260 return Nodet.Table (N + 2).Field0; 261 end Get_Field6; 262 263 264 procedure Set_Field7 (N : Node; V : Node) is 265 begin 266 Nodet.Table (N + 2).Field1 := V; 267 end Set_Field7; 268 269 function Get_Field7 (N : Node) return Node is 270 begin 271 return Nodet.Table (N + 2).Field1; 272 end Get_Field7; 273 274 275 procedure Set_Field8 (N : Node; V : Node) is 276 begin 277 Nodet.Table (N + 2).Field2 := V; 278 end Set_Field8; 279 280 function Get_Field8 (N : Node) return Node is 281 begin 282 return Nodet.Table (N + 2).Field2; 283 end Get_Field8; 284 285 286 function Get_Format (Kind : Nkind) return Format_Type; 287 288 function Create_Node (Kind : Nkind) return Node 289 is 290 Res : Node; 291 begin 292 case Get_Format (Kind) is 293 when Format_X1 => 294 if Free_Nodes /= Null_Node then 295 Res := Free_Nodes; 296 Free_Nodes := Get_Field1 (Res); 297 else 298 Nodet.Increment_Last; 299 Res := Nodet.Last; 300 end if; 301 when Format_X2 => 302 Res := Nodet.Allocate (2); 303 Nodet.Table (Res + 1) := Init_Node; 304 when Format_X4 => 305 Res := Nodet.Allocate (4); 306 Nodet.Table (Res + 1) := Init_Node; 307 Nodet.Table (Res + 2) := Init_Node; 308 Nodet.Table (Res + 3) := Init_Node; 309 end case; 310 Nodet.Table (Res) := Init_Node; 311 Set_Kind (Res, Kind); 312 return Res; 313 end Create_Node; 314 315 procedure Free_Node (N : Node) 316 is 317 begin 318 -- FIXME: handle extended nodes. 319 Set_Kind (N, N_Error); 320 Set_Field1 (N, Free_Nodes); 321 Free_Nodes := N; 322 end Free_Node; 323 324 function Get_Location (N : Node) return Location_Type is 325 begin 326 return Node_To_Location_Type (Get_Field0 (N)); 327 end Get_Location; 328 329 procedure Set_Location (N : Node; Loc : Location_Type) is 330 begin 331 Set_Field0 (N, Location_Type_To_Node (Loc)); 332 end Set_Location; 333 334 pragma Unreferenced (Get_Last_Node); 335 336 -- Subprograms 337 338end Edif.Nodes; 339