1-- PSL - Nodes definition. This is in fact -*- Ada -*- 2-- Copyright (C) 2002-2016 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 PSL.Errors; 22with PSL.Hash; 23with PSL.Nodes_Meta; use PSL.Nodes_Meta; 24 25package body PSL.Nodes is 26 -- Suppress the access check of the table base. This is really safe to 27 -- suppress this check because the table base cannot be null. 28 pragma Suppress (Access_Check); 29 30 -- Suppress the index check on the table. 31 -- Could be done during non-debug, since this may catch errors (reading 32 -- Null_Node. 33 --pragma Suppress (Index_Check); 34 35 type Format_Type is 36 ( 37 Format_Short 38 ); 39 40 -- Common fields are: 41 -- Flag1 : Boolean 42 -- Flag2 : Boolean 43 -- Flag3 : Boolean 44 -- Flag4 : Boolean 45 -- Flag5 : Boolean 46 -- Flag6 : Boolean 47 -- Nkind : Kind_Type 48 -- State1 : Bit2_Type 49 -- State2 : Bit2_Type 50 -- Location : Int32 51 -- Field1 : Node 52 -- Field2 : Node 53 -- Field3 : Node 54 -- Field4 : Node 55 56 -- Fields of Format_Short: 57 -- Field5 : Node 58 -- Field6 : Node 59 60 type State_Type is range 0 .. 3; 61 type Bit3_Type is range 0 .. 7; 62 63 type Node_Record is record 64 Kind : Nkind; 65 Flag1 : Boolean; 66 Flag2 : Boolean; 67 Flag3 : Boolean; 68 Flag4 : Boolean; 69 Flag5 : Boolean; 70 Flag6 : Boolean; 71 Flag7 : Boolean; 72 Flag8 : Boolean; 73 Flag9 : Boolean; 74 Flag10 : Boolean; 75 Flag11 : Boolean; 76 Flag12 : Boolean; 77 Flag13 : Boolean; 78 Flag14 : Boolean; 79 Flag15 : Boolean; 80 Flag16 : Boolean; 81 State1 : State_Type; 82 B3_1 : Bit3_Type; 83 Flag17 : Boolean; 84 Flag18 : Boolean; 85 Flag19 : Boolean; 86 87 Location : Int32; 88 Field1 : Node; 89 Field2 : Node; 90 Field3 : Node; 91 Field4 : Node; 92 Field5 : Node; 93 Field6 : Node; 94 end record; 95 pragma Pack (Node_Record); 96 for Node_Record'Size use 8 * 32; 97 98 package Nodet is new Tables 99 (Table_Component_Type => Node_Record, 100 Table_Index_Type => Node, 101 Table_Low_Bound => 1, 102 Table_Initial => 1024); 103 104 Init_Node : constant Node_Record := (Kind => N_Error, 105 Flag1 => False, 106 Flag2 => False, 107 State1 => 0, 108 B3_1 => 0, 109 Location => 0, 110 Field1 => 0, 111 Field2 => 0, 112 Field3 => 0, 113 Field4 => 0, 114 Field5 => 0, 115 Field6 => 0, 116 others => False); 117 118 Free_Nodes : Node := Null_Node; 119 120 121 function Get_Last_Node return Node is 122 begin 123 return Nodet.Last; 124 end Get_Last_Node; 125 126 function Node_To_Uns32 is new Ada.Unchecked_Conversion 127 (Source => Node, Target => Uns32); 128 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 135 function Int32_To_Node is new Ada.Unchecked_Conversion 136 (Source => Int32, Target => Node); 137 138 function Node_To_NFA is new Ada.Unchecked_Conversion 139 (Source => Node, Target => NFA); 140 141 function NFA_To_Node is new Ada.Unchecked_Conversion 142 (Source => NFA, Target => Node); 143 144 function Node_To_HDL_Node is new Ada.Unchecked_Conversion 145 (Source => Node, Target => HDL_Node); 146 147 function HDL_Node_To_Node is new Ada.Unchecked_Conversion 148 (Source => HDL_Node, Target => Node); 149 150 procedure Set_Kind (N : Node; K : Nkind) is 151 begin 152 Nodet.Table (N).Kind := K; 153 end Set_Kind; 154 155 function Get_Kind (N : Node) return Nkind is 156 begin 157 return Nodet.Table (N).Kind; 158 end Get_Kind; 159 160 161 procedure Set_Flag1 (N : Node; Flag : Boolean) is 162 begin 163 Nodet.Table (N).Flag1 := Flag; 164 end Set_Flag1; 165 166 function Get_Flag1 (N : Node) return Boolean is 167 begin 168 return Nodet.Table (N).Flag1; 169 end Get_Flag1; 170 171 procedure Set_Flag2 (N : Node; Flag : Boolean) is 172 begin 173 Nodet.Table (N).Flag2 := Flag; 174 end Set_Flag2; 175 176 function Get_Flag2 (N : Node) return Boolean is 177 begin 178 return Nodet.Table (N).Flag2; 179 end Get_Flag2; 180 181 182 procedure Set_State1 (N : Node; S : State_Type) is 183 begin 184 Nodet.Table (N).State1 := S; 185 end Set_State1; 186 187 function Get_State1 (N : Node) return State_Type is 188 begin 189 return Nodet.Table (N).State1; 190 end Get_State1; 191 192 193 function Get_Location (N : Node) return Location_Type is 194 begin 195 return Location_Type (Nodet.Table (N).Location); 196 end Get_Location; 197 198 procedure Set_Location (N : Node; Loc : Location_Type) is 199 begin 200 Nodet.Table (N).Location := Int32 (Loc); 201 end Set_Location; 202 203 procedure Copy_Location (N : Node; Src : Node) is 204 begin 205 Set_Location (N, Get_Location (Src)); 206 end Copy_Location; 207 208 procedure Set_Field1 (N : Node; V : Node) is 209 begin 210 Nodet.Table (N).Field1 := V; 211 end Set_Field1; 212 213 function Get_Field1 (N : Node) return Node is 214 begin 215 return Nodet.Table (N).Field1; 216 end Get_Field1; 217 218 219 procedure Set_Field2 (N : Node; V : Node) is 220 begin 221 Nodet.Table (N).Field2 := V; 222 end Set_Field2; 223 224 function Get_Field2 (N : Node) return Node is 225 begin 226 return Nodet.Table (N).Field2; 227 end Get_Field2; 228 229 230 function Get_Field3 (N : Node) return Node is 231 begin 232 return Nodet.Table (N).Field3; 233 end Get_Field3; 234 235 procedure Set_Field3 (N : Node; V : Node) is 236 begin 237 Nodet.Table (N).Field3 := V; 238 end Set_Field3; 239 240 241 function Get_Field4 (N : Node) return Node is 242 begin 243 return Nodet.Table (N).Field4; 244 end Get_Field4; 245 246 procedure Set_Field4 (N : Node; V : Node) is 247 begin 248 Nodet.Table (N).Field4 := V; 249 end Set_Field4; 250 251 252 function Get_Field5 (N : Node) return Node is 253 begin 254 return Nodet.Table (N).Field5; 255 end Get_Field5; 256 257 procedure Set_Field5 (N : Node; V : Node) is 258 begin 259 Nodet.Table (N).Field5 := V; 260 end Set_Field5; 261 262 263 function Get_Field6 (N : Node) return Node is 264 begin 265 return Nodet.Table (N).Field6; 266 end Get_Field6; 267 268 procedure Set_Field6 (N : Node; V : Node) is 269 begin 270 Nodet.Table (N).Field6 := V; 271 end Set_Field6; 272 273 274 function Get_Format (Kind : Nkind) return Format_Type; 275 pragma Unreferenced (Get_Format); 276 277 function Create_Node (Kind : Nkind) return Node 278 is 279 Res : Node; 280 begin 281 if Free_Nodes /= Null_Node then 282 Res := Free_Nodes; 283 Free_Nodes := Get_Field1 (Res); 284 else 285 Nodet.Increment_Last; 286 Res := Nodet.Last; 287 end if; 288 Nodet.Table (Res) := Init_Node; 289 Set_Kind (Res, Kind); 290 return Res; 291 end Create_Node; 292 293 procedure Free_Node (N : Node) 294 is 295 begin 296 Set_Kind (N, N_Error); 297 Set_Field1 (N, Free_Nodes); 298 Free_Nodes := N; 299 end Free_Node; 300 301 procedure Failed (Msg : String; N : Node) 302 is 303 begin 304 Errors.Error_Kind (Msg, N); 305 end Failed; 306 307 procedure Init (Loc : Location_Type) is 308 begin 309 pragma Assert (Loc /= No_Location); 310 Nodet.Init; 311 312 if Create_Node (N_False) /= False_Node then 313 raise Internal_Error; 314 end if; 315 Set_Location (False_Node, Loc); 316 317 if Create_Node (N_True) /= True_Node then 318 raise Internal_Error; 319 end if; 320 Set_Location (True_Node, Loc); 321 322 if Create_Node (N_Number) /= One_Node then 323 raise Internal_Error; 324 end if; 325 Set_Value (One_Node, 1); 326 Set_Location (One_Node, Loc); 327 328 if Create_Node (N_EOS) /= EOS_Node then 329 raise Internal_Error; 330 end if; 331 Set_Hash (EOS_Node, 0); 332 Set_Location (EOS_Node, Loc); 333 PSL.Hash.Init; 334 end Init; 335 336 function Get_Psl_Type (N : Node) return PSL_Types is 337 begin 338 case Get_Kind (N) is 339 when N_And_Prop 340 | N_Or_Prop 341 | N_Paren_Prop 342 | N_Log_Imp_Prop 343 | N_Log_Equiv_Prop 344 | N_Always 345 | N_Never 346 | N_Eventually 347 | N_Next 348 | N_Next_E 349 | N_Next_A 350 | N_Next_Event 351 | N_Next_Event_A 352 | N_Next_Event_E 353 | N_Before 354 | N_Until 355 | N_Abort 356 | N_Strong 357 | N_Property_Parameter 358 | N_Property_Instance => 359 return Type_Property; 360 when N_Braced_SERE 361 | N_Concat_SERE 362 | N_Fusion_SERE 363 | N_Within_SERE 364 | N_Clocked_SERE 365 | N_Overlap_Imp_Seq 366 | N_Imp_Seq 367 | N_And_Seq 368 | N_Or_Seq 369 | N_Match_And_Seq 370 | N_Star_Repeat_Seq 371 | N_Goto_Repeat_Seq 372 | N_Equal_Repeat_Seq 373 | N_Plus_Repeat_Seq 374 | N_Clock_Event 375 | N_Sequence_Instance 376 | N_Endpoint_Instance 377 | N_Sequence_Parameter => 378 return Type_Sequence; 379 when N_Name => 380 return Get_Psl_Type (Get_Decl (N)); 381 when N_HDL_Expr => 382 -- FIXME. 383 return Type_Boolean; 384 when N_Or_Bool 385 | N_And_Bool 386 | N_Not_Bool 387 | N_Imp_Bool 388 | N_Equiv_Bool 389 | N_False 390 | N_True 391 | N_Boolean_Parameter 392 | N_Paren_Bool 393 | N_HDL_Bool => 394 return Type_Boolean; 395 when N_Number 396 | N_Const_Parameter => 397 return Type_Numeric; 398 when N_Vmode 399 | N_Vunit 400 | N_Vprop 401 | N_Hdl_Mod_Name 402 | N_Assert_Directive 403 | N_Sequence_Declaration 404 | N_Endpoint_Declaration 405 | N_Property_Declaration 406 | N_Actual 407 | N_Name_Decl 408 | N_Error 409 | N_EOS => 410 PSL.Errors.Error_Kind ("get_psl_type", N); 411 end case; 412 end Get_Psl_Type; 413 414 procedure Reference_Failed (Msg : String; N : Node) is 415 begin 416 Failed (Msg, N); 417 end Reference_Failed; 418 pragma Unreferenced (Reference_Failed); 419 420 -- Subprograms 421 422end PSL.Nodes; 423