1-- Common operations on nodes. 2-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Name_Table; 18with Str_Table; 19with Std_Names; use Std_Names; 20with Flags; 21with Vhdl.Std_Package; 22with Vhdl.Errors; use Vhdl.Errors; 23with PSL.Nodes; 24 25package body Vhdl.Utils is 26 function Is_Error (N : Iir) return Boolean is 27 begin 28 return Get_Kind (N) = Iir_Kind_Error; 29 end Is_Error; 30 31 function Is_Overflow_Literal (N : Iir) return Boolean is 32 begin 33 return Get_Kind (N) = Iir_Kind_Overflow_Literal; 34 end Is_Overflow_Literal; 35 36 function Strip_Literal_Origin (N : Iir) return Iir 37 is 38 Orig : Iir; 39 begin 40 if N = Null_Iir then 41 return N; 42 end if; 43 case Get_Kind (N) is 44 when Iir_Kind_String_Literal8 45 | Iir_Kind_Integer_Literal 46 | Iir_Kind_Floating_Point_Literal 47 | Iir_Kind_Physical_Int_Literal 48 | Iir_Kind_Physical_Fp_Literal 49 | Iir_Kind_Simple_Aggregate 50 | Iir_Kind_Overflow_Literal 51 | Iir_Kind_Enumeration_Literal 52 | Iir_Kind_Aggregate => 53 Orig := Get_Literal_Origin (N); 54 if Orig /= Null_Iir then 55 return Orig; 56 else 57 return N; 58 end if; 59 when others => 60 return N; 61 end case; 62 end Strip_Literal_Origin; 63 64 function List_To_Flist (L : Iir_List) return Iir_Flist 65 is 66 Len : constant Natural := Get_Nbr_Elements (L); 67 It : List_Iterator; 68 Temp_L : Iir_List; 69 Res : Iir_Flist; 70 begin 71 Res := Create_Iir_Flist (Len); 72 It := List_Iterate (L); 73 for I in 0 .. Len - 1 loop 74 pragma Assert (Is_Valid (It)); 75 Set_Nth_Element (Res, I, Get_Element (It)); 76 Next (It); 77 end loop; 78 pragma Assert (not Is_Valid (It)); 79 80 Temp_L := L; 81 Destroy_Iir_List (Temp_L); 82 83 return Res; 84 end List_To_Flist; 85 86 function Truncate_Flist (L : Iir_Flist; Len : Natural) return Iir_Flist 87 is 88 Res : Iir_Flist; 89 Temp_L : Iir_Flist; 90 begin 91 Res := Create_Iir_Flist (Len); 92 for I in 0 .. Len - 1 loop 93 Set_Nth_Element (Res, I, Get_Nth_Element (L, I)); 94 end loop; 95 Temp_L := L; 96 Destroy_Iir_Flist (Temp_L); 97 return Res; 98 end Truncate_Flist; 99 100 function Get_Operator_Name (Op : Iir) return Name_Id is 101 begin 102 case Get_Kind (Op) is 103 when Iir_Kind_And_Operator 104 | Iir_Kind_Reduction_And_Operator => 105 return Name_And; 106 when Iir_Kind_Or_Operator 107 | Iir_Kind_Reduction_Or_Operator => 108 return Name_Or; 109 when Iir_Kind_Nand_Operator 110 | Iir_Kind_Reduction_Nand_Operator => 111 return Name_Nand; 112 when Iir_Kind_Nor_Operator 113 | Iir_Kind_Reduction_Nor_Operator => 114 return Name_Nor; 115 when Iir_Kind_Xor_Operator 116 | Iir_Kind_Reduction_Xor_Operator => 117 return Name_Xor; 118 when Iir_Kind_Xnor_Operator 119 | Iir_Kind_Reduction_Xnor_Operator => 120 return Name_Xnor; 121 122 when Iir_Kind_Equality_Operator => 123 return Name_Op_Equality; 124 when Iir_Kind_Inequality_Operator => 125 return Name_Op_Inequality; 126 when Iir_Kind_Less_Than_Operator => 127 return Name_Op_Less; 128 when Iir_Kind_Less_Than_Or_Equal_Operator => 129 return Name_Op_Less_Equal; 130 when Iir_Kind_Greater_Than_Operator => 131 return Name_Op_Greater; 132 when Iir_Kind_Greater_Than_Or_Equal_Operator => 133 return Name_Op_Greater_Equal; 134 135 when Iir_Kind_Match_Equality_Operator => 136 return Name_Op_Match_Equality; 137 when Iir_Kind_Match_Inequality_Operator => 138 return Name_Op_Match_Inequality; 139 when Iir_Kind_Match_Less_Than_Operator => 140 return Name_Op_Match_Less; 141 when Iir_Kind_Match_Less_Than_Or_Equal_Operator => 142 return Name_Op_Match_Less_Equal; 143 when Iir_Kind_Match_Greater_Than_Operator => 144 return Name_Op_Match_Greater; 145 when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 146 return Name_Op_Match_Greater_Equal; 147 148 when Iir_Kind_Sll_Operator => 149 return Name_Sll; 150 when Iir_Kind_Sla_Operator => 151 return Name_Sla; 152 when Iir_Kind_Srl_Operator => 153 return Name_Srl; 154 when Iir_Kind_Sra_Operator => 155 return Name_Sra; 156 when Iir_Kind_Rol_Operator => 157 return Name_Rol; 158 when Iir_Kind_Ror_Operator => 159 return Name_Ror; 160 when Iir_Kind_Addition_Operator => 161 return Name_Op_Plus; 162 when Iir_Kind_Substraction_Operator => 163 return Name_Op_Minus; 164 when Iir_Kind_Concatenation_Operator => 165 return Name_Op_Concatenation; 166 when Iir_Kind_Multiplication_Operator => 167 return Name_Op_Mul; 168 when Iir_Kind_Division_Operator => 169 return Name_Op_Div; 170 when Iir_Kind_Modulus_Operator => 171 return Name_Mod; 172 when Iir_Kind_Remainder_Operator => 173 return Name_Rem; 174 when Iir_Kind_Exponentiation_Operator => 175 return Name_Op_Exp; 176 when Iir_Kind_Not_Operator => 177 return Name_Not; 178 when Iir_Kind_Negation_Operator => 179 return Name_Op_Minus; 180 when Iir_Kind_Identity_Operator => 181 return Name_Op_Plus; 182 when Iir_Kind_Absolute_Operator => 183 return Name_Abs; 184 when Iir_Kind_Condition_Operator 185 | Iir_Kind_Implicit_Condition_Operator => 186 return Name_Op_Condition; 187 when others => 188 raise Internal_Error; 189 end case; 190 end Get_Operator_Name; 191 192 function Get_Longuest_Static_Prefix (Expr: Iir) return Iir 193 is 194 Adecl: Iir; 195 begin 196 Adecl := Expr; 197 loop 198 case Get_Kind (Adecl) is 199 when Iir_Kind_Variable_Declaration 200 | Iir_Kind_Interface_Variable_Declaration => 201 return Adecl; 202 when Iir_Kind_Constant_Declaration 203 | Iir_Kind_Interface_Constant_Declaration => 204 return Adecl; 205 when Iir_Kind_Signal_Declaration 206 | Iir_Kind_Guard_Signal_Declaration 207 | Iir_Kind_Anonymous_Signal_Declaration 208 | Iir_Kind_Interface_Signal_Declaration => 209 return Adecl; 210 when Iir_Kind_Object_Alias_Declaration => 211 -- LRM 4.3.3.1 Object Aliases 212 -- 2. The name must be a static name [...] 213 return Adecl; 214 when Iir_Kind_Slice_Name 215 | Iir_Kind_Indexed_Name 216 | Iir_Kind_Selected_Element => 217 if Get_Name_Staticness (Adecl) >= Globally then 218 return Adecl; 219 else 220 Adecl := Get_Prefix (Adecl); 221 end if; 222 when Iir_Kind_Simple_Name 223 | Iir_Kind_Selected_Name => 224 Adecl := Get_Named_Entity (Adecl); 225 when Iir_Kind_Type_Conversion => 226 return Null_Iir; 227 when others => 228 Error_Kind ("get_longuest_static_prefix", Adecl); 229 end case; 230 end loop; 231 end Get_Longuest_Static_Prefix; 232 233 function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True) 234 return Iir 235 is 236 Adecl : Iir; 237 begin 238 Adecl := Name; 239 loop 240 case Get_Kind (Adecl) is 241 when Iir_Kinds_Non_Alias_Object_Declaration 242 | Iir_Kinds_Quantity_Declaration 243 | Iir_Kind_Terminal_Declaration 244 | Iir_Kind_Interface_Quantity_Declaration 245 | Iir_Kind_Interface_Terminal_Declaration 246 | Iir_Kind_Interface_Type_Declaration 247 | Iir_Kind_Interface_Package_Declaration 248 | Iir_Kind_Interface_Function_Declaration 249 | Iir_Kind_Interface_Procedure_Declaration 250 | Iir_Kind_External_Signal_Name 251 | Iir_Kind_External_Constant_Name 252 | Iir_Kind_External_Variable_Name => 253 return Adecl; 254 when Iir_Kind_Object_Alias_Declaration => 255 if With_Alias then 256 Adecl := Get_Name (Adecl); 257 else 258 return Adecl; 259 end if; 260 when Iir_Kind_Indexed_Name 261 | Iir_Kind_Slice_Name 262 | Iir_Kind_Selected_Element 263 | Iir_Kind_Selected_By_All_Name => 264 Adecl := Get_Base_Name (Adecl); 265 when Iir_Kinds_Literal 266 | Iir_Kind_Overflow_Literal 267 | Iir_Kind_Enumeration_Literal 268 | Iir_Kinds_Monadic_Operator 269 | Iir_Kinds_Dyadic_Operator 270 | Iir_Kind_Function_Call 271 | Iir_Kind_Qualified_Expression 272 | Iir_Kind_Type_Conversion 273 | Iir_Kind_Allocator_By_Expression 274 | Iir_Kind_Allocator_By_Subtype 275 | Iir_Kind_Parenthesis_Expression 276 | Iir_Kinds_Attribute 277 | Iir_Kind_Attribute_Value 278 | Iir_Kind_Aggregate 279 | Iir_Kind_Simple_Aggregate 280 | Iir_Kind_Dereference 281 | Iir_Kind_Implicit_Dereference 282 | Iir_Kind_Unit_Declaration 283 | Iir_Kind_Psl_Expression 284 | Iir_Kinds_Concurrent_Statement 285 | Iir_Kinds_Sequential_Statement 286 | Iir_Kinds_Simultaneous_Statement => 287 return Adecl; 288 when Iir_Kind_Simple_Name 289 | Iir_Kind_Selected_Name => 290 Adecl := Get_Named_Entity (Adecl); 291 when Iir_Kind_Attribute_Name => 292 return Get_Named_Entity (Adecl); 293 when Iir_Kind_Error 294 | Iir_Kind_Unused 295 | Iir_Kind_Parenthesis_Name 296 | Iir_Kind_Conditional_Expression 297 | Iir_Kind_Character_Literal 298 | Iir_Kind_Operator_Symbol 299 | Iir_Kind_Design_File 300 | Iir_Kind_Design_Unit 301 | Iir_Kind_Library_Clause 302 | Iir_Kind_Use_Clause 303 | Iir_Kind_Context_Reference 304 | Iir_Kind_Library_Declaration 305 | Iir_Kinds_Library_Unit 306 | Iir_Kind_Component_Declaration 307 | Iir_Kind_Function_Declaration 308 | Iir_Kind_Procedure_Declaration 309 | Iir_Kind_Function_Instantiation_Declaration 310 | Iir_Kind_Procedure_Instantiation_Declaration 311 | Iir_Kind_Attribute_Declaration 312 | Iir_Kind_Nature_Declaration 313 | Iir_Kind_Subnature_Declaration 314 | Iir_Kinds_Type_Declaration 315 | Iir_Kinds_Type_And_Subtype_Definition 316 | Iir_Kinds_Nature_Definition 317 | Iir_Kinds_Subnature_Definition 318 | Iir_Kind_Wildcard_Type_Definition 319 | Iir_Kind_Subtype_Definition 320 | Iir_Kind_Group_Template_Declaration 321 | Iir_Kind_Group_Declaration 322 | Iir_Kind_Anonymous_Signal_Declaration 323 | Iir_Kind_Signal_Attribute_Declaration 324 | Iir_Kind_Unaffected_Waveform 325 | Iir_Kind_Waveform_Element 326 | Iir_Kind_Conditional_Waveform 327 | Iir_Kind_Binding_Indication 328 | Iir_Kind_Component_Configuration 329 | Iir_Kind_Block_Configuration 330 | Iir_Kinds_Specification 331 | Iir_Kind_Non_Object_Alias_Declaration 332 | Iir_Kinds_Subprogram_Body 333 | Iir_Kind_Protected_Type_Body 334 | Iir_Kind_Generate_Statement_Body 335 | Iir_Kind_Procedure_Call 336 | Iir_Kind_Aggregate_Info 337 | Iir_Kind_Entity_Class 338 | Iir_Kind_Signature 339 | Iir_Kind_Break_Element 340 | Iir_Kind_Reference_Name 341 | Iir_Kind_Package_Header 342 | Iir_Kind_Block_Header 343 | Iir_Kinds_Association_Element 344 | Iir_Kinds_Choice 345 | Iir_Kinds_Entity_Aspect 346 | Iir_Kind_Psl_Hierarchical_Name 347 | Iir_Kind_Psl_Prev 348 | Iir_Kind_Psl_Stable 349 | Iir_Kind_Psl_Rose 350 | Iir_Kind_Psl_Fell 351 | Iir_Kind_If_Generate_Else_Clause 352 | Iir_Kind_Elsif 353 | Iir_Kind_Simultaneous_Elsif 354 | Iir_Kind_Record_Element_Constraint 355 | Iir_Kind_Array_Element_Resolution 356 | Iir_Kind_Record_Resolution 357 | Iir_Kind_Record_Element_Resolution 358 | Iir_Kind_Element_Declaration 359 | Iir_Kind_Nature_Element_Declaration 360 | Iir_Kind_Psl_Endpoint_Declaration 361 | Iir_Kind_Psl_Declaration 362 | Iir_Kind_Package_Pathname 363 | Iir_Kind_Absolute_Pathname 364 | Iir_Kind_Relative_Pathname 365 | Iir_Kind_Pathname_Element 366 | Iir_Kind_Range_Expression 367 | Iir_Kind_Overload_List => 368 return Adecl; 369 end case; 370 end loop; 371 end Get_Object_Prefix; 372 373 function Is_Object_Name (Name : Iir) return Boolean 374 is 375 Obj : constant Iir := Name_To_Object (Name); 376 begin 377 return Obj /= Null_Iir; 378 end Is_Object_Name; 379 380 function Name_To_Object (Name : Iir) return Iir is 381 begin 382 -- LRM08 6.4 Objects 383 -- An object is a named entity that contains (has) a value of a type. 384 -- An object is obe of the following: 385 case Get_Kind (Name) is 386 -- An object declared by an object declaration (see 6.4.2) 387 when Iir_Kind_Signal_Declaration 388 | Iir_Kind_Variable_Declaration 389 | Iir_Kind_File_Declaration 390 | Iir_Kind_Constant_Declaration 391 | Iir_Kind_Anonymous_Signal_Declaration 392 | Iir_Kind_Free_Quantity_Declaration 393 | Iir_Kind_Across_Quantity_Declaration 394 | Iir_Kind_Through_Quantity_Declaration => 395 return Name; 396 397 -- A loop of generate parameter. 398 when Iir_Kind_Iterator_Declaration => 399 return Name; 400 401 -- A formal parameter of a subprogram 402 -- A formal port 403 -- A formal generic constant 404 -- A local port 405 -- A local generic constant 406 when Iir_Kind_Interface_Constant_Declaration 407 | Iir_Kind_Interface_Variable_Declaration 408 | Iir_Kind_Interface_Signal_Declaration 409 | Iir_Kind_Interface_File_Declaration 410 | Iir_Kind_Interface_Quantity_Declaration => 411 return Name; 412 413 -- An implicit signak GUARD defined by the guard expression of a 414 -- block statement 415 when Iir_Kind_Guard_Signal_Declaration => 416 return Name; 417 418 -- In addition, the following are objects [ but are not named 419 -- entities]: 420 -- An implicit signal defined by any of the predefined attributes 421 -- 'DELAYED, 'STABLE, 'QUIET, and 'TRANSACTION 422 when Iir_Kinds_Signal_Attribute => 423 return Name; 424 425 -- An element or a slice of another object 426 when Iir_Kind_Slice_Name 427 | Iir_Kind_Indexed_Name 428 | Iir_Kind_Selected_Element => 429 if Name_To_Object (Get_Prefix (Name)) = Null_Iir then 430 -- The prefix may not be an object. 431 return Null_Iir; 432 end if; 433 return Name; 434 435 -- An object designated by a value of an access type 436 when Iir_Kind_Implicit_Dereference 437 | Iir_Kind_Dereference => 438 return Name; 439 440 -- LRM08 6.6 Alias declarations 441 -- An object alias is an alias whose alias designatore denotes an 442 -- object. 443 when Iir_Kind_Object_Alias_Declaration => 444 return Name; 445 446 when Iir_Kind_Simple_Name 447 | Iir_Kind_Selected_Name => 448 -- LRM08 8 Names 449 -- Names can denote declared entities [...] 450 -- GHDL: in particular, names can denote objects. 451 return Name_To_Object (Get_Named_Entity (Name)); 452 453 when Iir_Kinds_External_Name => 454 return Name; 455 456 -- AMS-LRM17 6.4 Objects 457 -- An implicit signal defined by any of the predefined attributes 458 -- 'above, [...] 459 when Iir_Kind_Above_Attribute => 460 return Name; 461 462 -- AMS-LRM17 6.4 Objects 463 -- An implicit quantity defined by any of the predefined attributes 464 -- 'DOT, 'INTEG, 'DELAYED, 'ZOH, 'LTF, 'ZTF, 'REFERENCE, 465 -- 'CONTRIBUTION, 'RAMP, and 'SLEW. 466 when Iir_Kind_Dot_Attribute 467 | Iir_Kind_Integ_Attribute => 468 return Name; 469 470 when others => 471 return Null_Iir; 472 end case; 473 end Name_To_Object; 474 475 function Name_To_Value (Name : Iir) return Iir is 476 begin 477 case Get_Kind (Name) is 478 when Iir_Kind_Attribute_Value 479 | Iir_Kind_Function_Call 480 | Iir_Kinds_Expression_Attribute => 481 return Name; 482 when Iir_Kind_Simple_Name 483 | Iir_Kind_Selected_Name => 484 return Name_To_Value (Get_Named_Entity (Name)); 485 when Iir_Kind_Indexed_Name 486 | Iir_Kind_Selected_Element 487 | Iir_Kind_Slice_Name => 488 -- Already a value. 489 return Name; 490 when others => 491 return Name_To_Object (Name); 492 end case; 493 end Name_To_Value; 494 495 -- Return TRUE if EXPR is a signal name. 496 function Is_Signal_Name (Expr : Iir) return Boolean 497 is 498 Obj : Iir; 499 begin 500 Obj := Name_To_Object (Expr); 501 if Obj /= Null_Iir then 502 return Is_Signal_Object (Obj); 503 else 504 return False; 505 end if; 506 end Is_Signal_Name; 507 508 function Is_Signal_Object (Name : Iir) return Boolean 509 is 510 Adecl: Iir; 511 begin 512 Adecl := Get_Object_Prefix (Name, True); 513 case Get_Kind (Adecl) is 514 when Iir_Kind_Signal_Declaration 515 | Iir_Kind_Interface_Signal_Declaration 516 | Iir_Kind_Guard_Signal_Declaration 517 | Iir_Kind_Anonymous_Signal_Declaration 518 | Iir_Kinds_Signal_Attribute => 519 return True; 520 when Iir_Kind_Object_Alias_Declaration => 521 -- Must have been handled by Get_Object_Prefix. 522 raise Internal_Error; 523 when others => 524 return False; 525 end case; 526 end Is_Signal_Object; 527 528 function Is_Quantity_Object (Name : Iir) return Boolean 529 is 530 Adecl: Iir; 531 begin 532 Adecl := Get_Object_Prefix (Name, True); 533 case Get_Kind (Adecl) is 534 when Iir_Kinds_Quantity_Declaration 535 | Iir_Kind_Interface_Quantity_Declaration 536 | Iir_Kind_Integ_Attribute 537 | Iir_Kind_Dot_Attribute => 538 return True; 539 when Iir_Kind_Object_Alias_Declaration => 540 -- Must have been handled by Get_Object_Prefix. 541 raise Internal_Error; 542 when others => 543 return False; 544 end case; 545 end Is_Quantity_Object; 546 547 function Is_Quantity_Name (Expr : Iir) return Boolean 548 is 549 Obj : Iir; 550 begin 551 Obj := Name_To_Object (Expr); 552 if Obj /= Null_Iir then 553 return Is_Quantity_Object (Obj); 554 else 555 return False; 556 end if; 557 end Is_Quantity_Name; 558 559 function Get_Interface_Of_Formal (Formal : Iir) return Iir 560 is 561 El : Iir; 562 begin 563 El := Formal; 564 loop 565 case Get_Kind (El) is 566 when Iir_Kind_Simple_Name 567 | Iir_Kind_Operator_Symbol => 568 -- Operator is for subprogram interfaces. 569 return Get_Named_Entity (El); 570 when Iir_Kinds_Interface_Declaration => 571 return El; 572 when Iir_Kind_Slice_Name 573 | Iir_Kind_Indexed_Name 574 | Iir_Kind_Selected_Element => 575 -- FIXME: use get_base_name ? 576 El := Get_Prefix (El); 577 when others => 578 Error_Kind ("get_interface_of_formal", El); 579 end case; 580 end loop; 581 end Get_Interface_Of_Formal; 582 583 function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir 584 is 585 Formal : constant Iir := Get_Formal (Assoc); 586 begin 587 if Formal /= Null_Iir then 588 return Get_Interface_Of_Formal (Formal); 589 else 590 return Inter; 591 end if; 592 end Get_Association_Interface; 593 594 procedure Next_Association_Interface 595 (Assoc : in out Iir; Inter : in out Iir) 596 is 597 Formal : constant Iir := Get_Formal (Assoc); 598 begin 599 -- In canon, open association can be inserted after an association by 600 -- name. So do not assume there is no association by position after 601 -- association by name. 602 if Is_Valid (Formal) then 603 Inter := Get_Chain (Get_Interface_Of_Formal (Formal)); 604 else 605 Inter := Get_Chain (Inter); 606 end if; 607 Assoc := Get_Chain (Assoc); 608 end Next_Association_Interface; 609 610 function Get_Association_Formal (Assoc : Iir; Inter : Iir) return Iir 611 is 612 Formal : constant Iir := Get_Formal (Assoc); 613 begin 614 if Formal /= Null_Iir then 615 -- Strip denoting name 616 case Get_Kind (Formal) is 617 when Iir_Kind_Simple_Name 618 | Iir_Kind_Operator_Symbol => 619 return Get_Named_Entity (Formal); 620 when Iir_Kinds_Interface_Declaration => 621 -- Shouldn't happen. 622 raise Internal_Error; 623 when Iir_Kind_Slice_Name 624 | Iir_Kind_Indexed_Name 625 | Iir_Kind_Selected_Element => 626 return Formal; 627 when others => 628 Error_Kind ("get_association_formal", Formal); 629 end case; 630 else 631 return Inter; 632 end if; 633 end Get_Association_Formal; 634 635 function Find_First_Association_For_Interface 636 (Assoc_Chain : Iir; Inter_Chain : Iir; Inter : Iir) return Iir 637 is 638 Assoc_El : Iir; 639 Inter_El : Iir; 640 begin 641 Assoc_El := Assoc_Chain; 642 Inter_El := Inter_Chain; 643 while Is_Valid (Assoc_El) loop 644 if Get_Association_Interface (Assoc_El, Inter_El) = Inter then 645 return Assoc_El; 646 end if; 647 Next_Association_Interface (Assoc_El, Inter_El); 648 end loop; 649 return Null_Iir; 650 end Find_First_Association_For_Interface; 651 652 function Is_Parameter (Inter : Iir) return Boolean is 653 begin 654 case Get_Kind (Get_Parent (Inter)) is 655 when Iir_Kinds_Subprogram_Declaration 656 | Iir_Kinds_Interface_Subprogram_Declaration => 657 return True; 658 when others => 659 -- Port 660 return False; 661 end case; 662 end Is_Parameter; 663 664 function Find_Name_In_Flist (List : Iir_Flist; Lit : Name_Id) return Iir 665 is 666 El : Iir; 667 begin 668 for I in Flist_First .. Flist_Last (List) loop 669 El := Get_Nth_Element (List, I); 670 if Get_Identifier (El) = Lit then 671 return El; 672 end if; 673 end loop; 674 return Null_Iir; 675 end Find_Name_In_Flist; 676 677 function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir 678 is 679 El: Iir := Chain; 680 begin 681 while El /= Null_Iir loop 682 if Get_Identifier (El) = Lit then 683 return El; 684 end if; 685 El := Get_Chain (El); 686 end loop; 687 return Null_Iir; 688 end Find_Name_In_Chain; 689 690 function Is_In_Chain (Chain : Iir; El : Iir) return Boolean 691 is 692 Chain_El : Iir; 693 begin 694 Chain_El := Chain; 695 while Chain_El /= Null_Iir loop 696 if Chain_El = El then 697 return True; 698 end if; 699 Chain_El := Get_Chain (Chain_El); 700 end loop; 701 return False; 702 end Is_In_Chain; 703 704 procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is 705 begin 706 -- Do not add self-dependency 707 if Unit = Target then 708 return; 709 end if; 710 711 pragma Assert (Kind_In (Unit, Iir_Kind_Design_Unit, 712 Iir_Kind_Entity_Aspect_Entity)); 713 714 Add_Element (Get_Dependence_List (Target), Unit); 715 end Add_Dependence; 716 717 function Get_Unit_From_Dependence (Dep : Iir) return Iir is 718 begin 719 case Get_Kind (Dep) is 720 when Iir_Kind_Design_Unit => 721 return Dep; 722 when Iir_Kind_Entity_Aspect_Entity => 723 return Get_Design_Unit (Get_Entity (Dep)); 724 when others => 725 Error_Kind ("get_unit_from_dependence", Dep); 726 end case; 727 end Get_Unit_From_Dependence; 728 729 procedure Clear_Instantiation_Configuration (Parent : Iir) 730 is 731 El : Iir; 732 begin 733 El := Get_Concurrent_Statement_Chain (Parent); 734 while El /= Null_Iir loop 735 case Get_Kind (El) is 736 when Iir_Kind_Component_Instantiation_Statement => 737 Set_Component_Configuration (El, Null_Iir); 738 when Iir_Kind_For_Generate_Statement => 739 declare 740 Bod : constant Iir := Get_Generate_Statement_Body (El); 741 begin 742 Set_Generate_Block_Configuration (Bod, Null_Iir); 743 end; 744 when Iir_Kind_If_Generate_Statement => 745 declare 746 Clause : Iir; 747 Bod : Iir; 748 begin 749 Clause := El; 750 while Clause /= Null_Iir loop 751 Bod := Get_Generate_Statement_Body (Clause); 752 Set_Generate_Block_Configuration (Bod, Null_Iir); 753 Clause := Get_Generate_Else_Clause (Clause); 754 end loop; 755 end; 756 when Iir_Kind_Block_Statement => 757 Set_Block_Block_Configuration (El, Null_Iir); 758 when others => 759 null; 760 end case; 761 El := Get_Chain (El); 762 end loop; 763 end Clear_Instantiation_Configuration; 764 765 -- Get identifier of NODE as a string. 766 function Image_Identifier (Node : Iir) return String is 767 begin 768 return Name_Table.Image (Vhdl.Nodes.Get_Identifier (Node)); 769 end Image_Identifier; 770 771 function Image_String_Lit (Str : Iir) return String is 772 begin 773 return Str_Table.String_String8 774 (Get_String8_Id (Str), Get_String_Length (Str)); 775 end Image_String_Lit; 776 777 function Copy_Enumeration_Literal (Lit : Iir) return Iir 778 is 779 Res : Iir; 780 begin 781 Res := Create_Iir (Iir_Kind_Enumeration_Literal); 782 Set_Identifier (Res, Get_Identifier (Lit)); 783 Location_Copy (Res, Lit); 784 Set_Parent (Res, Get_Parent (Lit)); 785 Set_Type (Res, Get_Type (Lit)); 786 Set_Enum_Pos (Res, Get_Enum_Pos (Lit)); 787 Set_Expr_Staticness (Res, Locally); 788 return Res; 789 end Copy_Enumeration_Literal; 790 791 procedure Create_Range_Constraint_For_Enumeration_Type 792 (Def : Iir_Enumeration_Type_Definition) 793 is 794 Range_Expr : Iir_Range_Expression; 795 Literal_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); 796 List_Len : constant Natural := Get_Nbr_Elements (Literal_List); 797 begin 798 -- Create a constraint. 799 Range_Expr := Create_Iir (Iir_Kind_Range_Expression); 800 Location_Copy (Range_Expr, Def); 801 Set_Type (Range_Expr, Def); 802 Set_Direction (Range_Expr, Dir_To); 803 if List_Len >= 1 then 804 Set_Left_Limit 805 (Range_Expr, Get_Nth_Element (Literal_List, 0)); 806 Set_Right_Limit 807 (Range_Expr, Get_Nth_Element (Literal_List, List_Len - 1)); 808 end if; 809 Set_Expr_Staticness (Range_Expr, Locally); 810 Set_Range_Constraint (Def, Range_Expr); 811 end Create_Range_Constraint_For_Enumeration_Type; 812 813 function Is_Static_Construct (Expr : Iir) return Boolean is 814 begin 815 case Get_Kind (Expr) is 816 when Iir_Kind_Aggregate => 817 return Get_Aggregate_Expand_Flag (Expr); 818 when Iir_Kinds_Literal => 819 return True; 820 when Iir_Kind_Simple_Aggregate 821 | Iir_Kind_Enumeration_Literal 822 | Iir_Kind_Character_Literal => 823 return True; 824 when Iir_Kind_Overflow_Literal => 825 -- Needs to generate an error. 826 return False; 827 when others => 828 return False; 829 end case; 830 end Is_Static_Construct; 831 832 procedure Free_Name (Node : Iir) 833 is 834 N : Iir; 835 N1 : Iir; 836 begin 837 if Node = Null_Iir then 838 return; 839 end if; 840 N := Node; 841 case Get_Kind (N) is 842 when Iir_Kind_Simple_Name 843 | Iir_Kind_Character_Literal 844 | Iir_Kind_String_Literal8 845 | Iir_Kind_Subtype_Definition => 846 Free_Iir (N); 847 when Iir_Kind_Selected_Name 848 | Iir_Kind_Parenthesis_Name 849 | Iir_Kind_Selected_By_All_Name => 850 N1 := Get_Prefix (N); 851 Free_Iir (N); 852 Free_Name (N1); 853 when Iir_Kind_Library_Declaration 854 | Iir_Kind_Package_Declaration 855 | Iir_Kind_Entity_Declaration 856 | Iir_Kind_Architecture_Body 857 | Iir_Kind_Design_Unit 858 | Iir_Kinds_Concurrent_Statement 859 | Iir_Kinds_Sequential_Statement => 860 return; 861 when others => 862 Error_Kind ("free_name", Node); 863 --Free_Iir (N); 864 end case; 865 end Free_Name; 866 867 procedure Free_Recursive_List (List : Iir_List) 868 is 869 It : List_Iterator; 870 begin 871 It := List_Iterate (List); 872 while Is_Valid (It) loop 873 Free_Recursive (Get_Element (It)); 874 Next (It); 875 end loop; 876 end Free_Recursive_List; 877 878 procedure Free_Recursive_Flist (List : Iir_Flist) 879 is 880 El : Iir; 881 begin 882 for I in Flist_First .. Flist_Last (List) loop 883 El := Get_Nth_Element (List, I); 884 Free_Recursive (El); 885 end loop; 886 end Free_Recursive_Flist; 887 888 procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) 889 is 890 N : Iir; 891 begin 892 if Node = Null_Iir then 893 return; 894 end if; 895 N := Node; 896 case Get_Kind (N) is 897 when Iir_Kind_Library_Declaration => 898 return; 899 when Iir_Kind_Simple_Name 900 | Iir_Kind_Parenthesis_Name 901 | Iir_Kind_Character_Literal => 902 null; 903 when Iir_Kind_Enumeration_Literal => 904 return; 905 when Iir_Kind_Selected_Name => 906 Free_Recursive (Get_Prefix (N)); 907 when Iir_Kind_Interface_Constant_Declaration 908 | Iir_Kind_Interface_Variable_Declaration 909 | Iir_Kind_Interface_Signal_Declaration => 910 Free_Recursive (Get_Type (N)); 911 Free_Recursive (Get_Default_Value (N)); 912 when Iir_Kind_Range_Expression => 913 Free_Recursive (Get_Left_Limit (N)); 914 Free_Recursive (Get_Right_Limit (N)); 915 when Iir_Kind_Subtype_Definition => 916 Free_Recursive (Get_Base_Type (N)); 917 when Iir_Kind_Integer_Literal => 918 null; 919 when Iir_Kind_Package_Declaration 920 | Iir_Kind_Package_Body 921 | Iir_Kind_Entity_Declaration 922 | Iir_Kind_Configuration_Declaration 923 | Iir_Kind_Context_Declaration => 924 null; 925 when Iir_Kind_File_Type_Definition 926 | Iir_Kind_Access_Type_Definition 927 | Iir_Kind_Array_Type_Definition 928 | Iir_Kind_Enumeration_Type_Definition 929 | Iir_Kind_Integer_Subtype_Definition 930 | Iir_Kind_Enumeration_Subtype_Definition 931 | Iir_Kind_Physical_Subtype_Definition => 932 return; 933 when Iir_Kind_Architecture_Body => 934 Free_Recursive (Get_Entity_Name (N)); 935 when Iir_Kind_Overload_List => 936 Free_Recursive_List (Get_Overload_List (N)); 937 if not Free_List then 938 return; 939 end if; 940 when Iir_Kind_Array_Subtype_Definition => 941 Free_Recursive_Flist (Get_Index_List (N)); 942 Free_Recursive (Get_Base_Type (N)); 943 when Iir_Kind_Entity_Aspect_Entity => 944 Free_Recursive (Get_Entity (N)); 945 Free_Recursive (Get_Architecture (N)); 946 when others => 947 Error_Kind ("free_recursive", Node); 948 end case; 949 Free_Iir (N); 950 end Free_Recursive; 951 952 function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) 953 return String 954 is 955 begin 956 return Iir_Predefined_Functions'Image (Func); 957 end Get_Predefined_Function_Name; 958 959 function Get_Callees_List_Holder (Subprg : Iir) return Iir is 960 begin 961 case Get_Kind (Subprg) is 962 when Iir_Kind_Procedure_Declaration 963 | Iir_Kind_Function_Declaration => 964 return Get_Subprogram_Body (Subprg); 965 when Iir_Kind_Sensitized_Process_Statement 966 | Iir_Kind_Process_Statement => 967 return Subprg; 968 when others => 969 Error_Kind ("get_callees_list_holder", Subprg); 970 end case; 971 end Get_Callees_List_Holder; 972 973 procedure Clear_Seen_Flag (Top : Iir) 974 is 975 Callees_List : Iir_Callees_List; 976 It : List_Iterator; 977 El: Iir; 978 begin 979 if Get_Seen_Flag (Top) then 980 Set_Seen_Flag (Top, False); 981 Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top)); 982 if Callees_List /= Null_Iir_List then 983 It := List_Iterate (Callees_List); 984 while Is_Valid (It) loop 985 El := Get_Element (It); 986 if Get_Seen_Flag (El) = False then 987 Clear_Seen_Flag (El); 988 end if; 989 Next (It); 990 end loop; 991 end if; 992 end if; 993 end Clear_Seen_Flag; 994 995 function Get_Base_Type (Atype : Iir) return Iir 996 is 997 Res : Iir; 998 begin 999 Res := Atype; 1000 loop 1001 case Get_Kind (Res) is 1002 when Iir_Kind_Access_Type_Definition 1003 | Iir_Kind_Integer_Type_Definition 1004 | Iir_Kind_Floating_Type_Definition 1005 | Iir_Kind_Enumeration_Type_Definition 1006 | Iir_Kind_Physical_Type_Definition 1007 | Iir_Kind_Array_Type_Definition 1008 | Iir_Kind_Record_Type_Definition 1009 | Iir_Kind_Protected_Type_Declaration 1010 | Iir_Kind_File_Type_Definition 1011 | Iir_Kind_Incomplete_Type_Definition 1012 | Iir_Kind_Interface_Type_Definition 1013 | Iir_Kind_Wildcard_Type_Definition 1014 | Iir_Kind_Error => 1015 return Res; 1016 when Iir_Kind_Access_Subtype_Definition 1017 | Iir_Kind_Integer_Subtype_Definition 1018 | Iir_Kind_Floating_Subtype_Definition 1019 | Iir_Kind_Enumeration_Subtype_Definition 1020 | Iir_Kind_Physical_Subtype_Definition 1021 | Iir_Kind_Array_Subtype_Definition 1022 | Iir_Kind_Record_Subtype_Definition => 1023 Res := Get_Parent_Type (Res); 1024 when others => 1025 Error_Kind ("get_base_type", Res); 1026 end case; 1027 end loop; 1028 end Get_Base_Type; 1029 1030 function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is 1031 begin 1032 return Get_Type_Declarator (Def) = Null_Iir; 1033 end Is_Anonymous_Type_Definition; 1034 1035 function Is_Anonymous_Nature_Definition (Def : Iir) return Boolean is 1036 begin 1037 return Get_Nature_Declarator (Def) = Null_Iir; 1038 end Is_Anonymous_Nature_Definition; 1039 1040 function Is_Fully_Constrained_Type (Def : Iir) return Boolean is 1041 begin 1042 return Get_Kind (Def) not in Iir_Kinds_Composite_Type_Definition 1043 or else Get_Constraint_State (Def) = Fully_Constrained; 1044 end Is_Fully_Constrained_Type; 1045 1046 function Is_Object_Fully_Constrained (Decl : Iir) return Boolean is 1047 begin 1048 -- That's true if the object type is constrained. 1049 if Is_Fully_Constrained_Type (Get_Type (Decl)) then 1050 return True; 1051 end if; 1052 1053 -- That's also true if the object is declared with a subtype attribute. 1054 if Get_Kind (Get_Subtype_Indication (Decl)) = Iir_Kind_Subtype_Attribute 1055 then 1056 return True; 1057 end if; 1058 1059 -- Otherwise this is false. 1060 return False; 1061 end Is_Object_Fully_Constrained; 1062 1063 function Is_Object_Name_Fully_Constrained (Obj : Iir) return Boolean 1064 is 1065 Base : Iir; 1066 begin 1067 -- That's true if the object type is constrained. 1068 if Flags.Flag_Relaxed_Rules 1069 or else Is_Fully_Constrained_Type (Get_Type (Obj)) 1070 then 1071 return True; 1072 end if; 1073 1074 -- That's also true if the object is declared with a subtype attribute. 1075 Base := Get_Base_Name (Obj); 1076 case Get_Kind (Base) is 1077 when Iir_Kind_Variable_Declaration 1078 | Iir_Kind_Signal_Declaration 1079 | Iir_Kind_Interface_Variable_Declaration 1080 | Iir_Kind_Interface_Signal_Declaration 1081 | Iir_Kind_Object_Alias_Declaration => 1082 if (Get_Kind (Get_Subtype_Indication (Base)) 1083 = Iir_Kind_Subtype_Attribute) 1084 then 1085 return True; 1086 end if; 1087 when Iir_Kind_Dereference 1088 | Iir_Kind_Implicit_Dereference => 1089 null; 1090 when others => 1091 Error_Kind ("is_object_name_fully_constrained", Base); 1092 end case; 1093 1094 -- Otherwise this is false. 1095 return False; 1096 end Is_Object_Name_Fully_Constrained; 1097 1098 function Strip_Denoting_Name (Name : Iir) return Iir is 1099 begin 1100 if Get_Kind (Name) in Iir_Kinds_Denoting_Name then 1101 return Get_Named_Entity (Name); 1102 else 1103 return Name; 1104 end if; 1105 end Strip_Denoting_Name; 1106 1107 function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir 1108 is 1109 Res : Iir; 1110 begin 1111 Res := Create_Iir (Iir_Kind_Simple_Name); 1112 Set_Location (Res, Loc); 1113 Set_Identifier (Res, Get_Identifier (Ref)); 1114 Set_Named_Entity (Res, Ref); 1115 Set_Base_Name (Res, Res); 1116 -- FIXME: set type and expr staticness ? 1117 return Res; 1118 end Build_Simple_Name; 1119 1120 function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir is 1121 begin 1122 return Build_Simple_Name (Ref, Get_Location (Loc)); 1123 end Build_Simple_Name; 1124 1125 function Build_Reference_Name (Name : Iir) return Iir 1126 is 1127 Res : Iir; 1128 begin 1129 pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name); 1130 1131 Res := Create_Iir (Iir_Kind_Reference_Name); 1132 Location_Copy (Res, Name); 1133 Set_Referenced_Name (Res, Name); 1134 Set_Is_Forward_Ref (Res, True); 1135 Set_Named_Entity (Res, Get_Named_Entity (Name)); 1136 return Res; 1137 end Build_Reference_Name; 1138 1139 function Strip_Reference_Name (N : Iir) return Iir is 1140 begin 1141 if Get_Kind (N) = Iir_Kind_Reference_Name then 1142 return Get_Named_Entity (N); 1143 else 1144 return N; 1145 end if; 1146 end Strip_Reference_Name; 1147 1148 function Has_Resolution_Function (Subtyp : Iir) return Iir 1149 is 1150 Ind : constant Iir := Get_Resolution_Indication (Subtyp); 1151 begin 1152 if Ind /= Null_Iir 1153 and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name 1154 then 1155 -- A resolution indication can be an array/record element resolution. 1156 return Get_Named_Entity (Ind); 1157 else 1158 return Null_Iir; 1159 end if; 1160 end Has_Resolution_Function; 1161 1162 function Is_Type_Name (Name : Iir) return Iir 1163 is 1164 Ent : Iir; 1165 begin 1166 case Get_Kind (Name) is 1167 when Iir_Kinds_Denoting_Name 1168 | Iir_Kind_Attribute_Name => 1169 Ent := Get_Named_Entity (Name); 1170 case Get_Kind (Ent) is 1171 when Iir_Kind_Type_Declaration => 1172 return Get_Type_Definition (Ent); 1173 when Iir_Kind_Subtype_Declaration 1174 | Iir_Kind_Base_Attribute 1175 | Iir_Kind_Subtype_Attribute => 1176 return Get_Type (Ent); 1177 when others => 1178 return Null_Iir; 1179 end case; 1180 when Iir_Kind_Subtype_Attribute => 1181 return Get_Type (Ent); 1182 when others => 1183 return Null_Iir; 1184 end case; 1185 end Is_Type_Name; 1186 1187 function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is 1188 begin 1189 case Get_Kind (Ind) is 1190 when Iir_Kinds_Denoting_Name => 1191 return Get_Type (Ind); 1192 when Iir_Kinds_Subtype_Definition => 1193 return Ind; 1194 when Iir_Kind_Subtype_Attribute 1195 | Iir_Kind_Across_Attribute 1196 | Iir_Kind_Through_Attribute => 1197 return Get_Type (Ind); 1198 when Iir_Kind_Error => 1199 return Ind; 1200 when others => 1201 Error_Kind ("get_type_of_subtype_indication", Ind); 1202 end case; 1203 end Get_Type_Of_Subtype_Indication; 1204 1205 function Get_Nature_Of_Subnature_Indication (Ind : Iir) return Iir is 1206 begin 1207 case Get_Kind (Ind) is 1208 when Iir_Kinds_Denoting_Name => 1209 -- Name of a nature. 1210 return Get_Nature (Get_Named_Entity (Ind)); 1211 when Iir_Kind_Array_Subnature_Definition => 1212 return Ind; 1213 when others => 1214 Error_Kind ("get_nature_of_subnature_indication", Ind); 1215 end case; 1216 end Get_Nature_Of_Subnature_Indication; 1217 1218 function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir 1219 is 1220 Index : constant Iir := Get_Nth_Element (Indexes, Idx); 1221 begin 1222 if Index = Null_Iir then 1223 return Null_Iir; 1224 else 1225 return Get_Index_Type (Index); 1226 end if; 1227 end Get_Index_Type; 1228 1229 function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir is 1230 begin 1231 return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx); 1232 end Get_Index_Type; 1233 1234 function Get_Nbr_Dimensions (Array_Type : Iir) return Natural is 1235 begin 1236 return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Type)); 1237 end Get_Nbr_Dimensions; 1238 1239 function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean 1240 is 1241 Base_Type : constant Iir := Get_Base_Type (A_Type); 1242 begin 1243 return Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition 1244 and then Get_Nbr_Dimensions (Base_Type) = 1; 1245 end Is_One_Dimensional_Array_Type; 1246 1247 function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean 1248 is 1249 Indexes : constant Iir_Flist := Get_Index_Subtype_List (Array_Type); 1250 Index : Iir; 1251 begin 1252 for I in Flist_First .. Flist_Last (Indexes) loop 1253 Index := Get_Index_Type (Indexes, I); 1254 if Get_Type_Staticness (Index) /= Locally then 1255 return False; 1256 end if; 1257 end loop; 1258 return True; 1259 end Are_Array_Indexes_Locally_Static; 1260 1261 function Are_Bounds_Locally_Static (Def : Iir) return Boolean is 1262 begin 1263 if Get_Type_Staticness (Def) = Locally then 1264 return True; 1265 end if; 1266 1267 case Iir_Kinds_Type_And_Subtype_Definition (Get_Kind (Def)) is 1268 when Iir_Kind_Array_Subtype_Definition => 1269 pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); 1270 1271 -- Indexes. 1272 if not Are_Array_Indexes_Locally_Static (Def) then 1273 return False; 1274 end if; 1275 1276 -- Element. 1277 return Are_Bounds_Locally_Static (Get_Element_Subtype (Def)); 1278 when Iir_Kind_Array_Type_Definition => 1279 return False; 1280 when Iir_Kind_Record_Subtype_Definition 1281 | Iir_Kind_Record_Type_Definition => 1282 pragma Assert (Get_Constraint_State (Def) = Fully_Constrained); 1283 1284 declare 1285 El_List : constant Iir_Flist := 1286 Get_Elements_Declaration_List (Def); 1287 El : Iir; 1288 begin 1289 for I in Flist_First .. Flist_Last (El_List) loop 1290 El := Get_Nth_Element (El_List, I); 1291 if not Are_Bounds_Locally_Static (Get_Type (El)) then 1292 return False; 1293 end if; 1294 end loop; 1295 return True; 1296 end; 1297 when Iir_Kinds_Scalar_Type_And_Subtype_Definition 1298 | Iir_Kind_Protected_Type_Declaration 1299 | Iir_Kind_Access_Type_Definition 1300 | Iir_Kind_Access_Subtype_Definition => 1301 return True; 1302 when Iir_Kind_Incomplete_Type_Definition 1303 | Iir_Kind_File_Type_Definition 1304 | Iir_Kind_Interface_Type_Definition => 1305 Error_Kind ("are_bounds_locally_static", Def); 1306 end case; 1307 end Are_Bounds_Locally_Static; 1308 1309 function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir 1310 is 1311 Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp); 1312 begin 1313 if Type_Mark_Name = Null_Iir then 1314 -- No type_mark (for array subtype created by constrained array 1315 -- definition. 1316 return Null_Iir; 1317 else 1318 return Get_Type (Get_Named_Entity (Type_Mark_Name)); 1319 end if; 1320 end Get_Denoted_Type_Mark; 1321 1322 function Get_Base_Element_Declaration (El : Iir) return Iir 1323 is 1324 Rec_Type : constant Iir := Get_Base_Type (Get_Parent (El)); 1325 Els_List : constant Iir_Flist := 1326 Get_Elements_Declaration_List (Rec_Type); 1327 begin 1328 return Get_Nth_Element 1329 (Els_List, Natural (Get_Element_Position (El))); 1330 end Get_Base_Element_Declaration; 1331 1332 procedure Append_Owned_Element_Constraint (Rec_Type : Iir; El : Iir) is 1333 begin 1334 pragma Assert (Get_Parent (El) = Rec_Type); 1335 Set_Chain (El, Get_Owned_Elements_Chain (Rec_Type)); 1336 Set_Owned_Elements_Chain (Rec_Type, El); 1337 end Append_Owned_Element_Constraint; 1338 1339 1340 function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean 1341 is 1342 Bod : constant Iir := Get_Chain (Spec); 1343 begin 1344 -- FIXME: don't directly use Subprogram_Body as it is not yet correctly 1345 -- set during instantiation. 1346 return Get_Has_Body (Spec) 1347 and then Get_Subprogram_Specification (Bod) /= Spec; 1348 end Is_Second_Subprogram_Specification; 1349 1350 function Is_Implicit_Subprogram (Spec : Iir) return Boolean is 1351 begin 1352 return Get_Kind (Spec) in Iir_Kinds_Subprogram_Declaration 1353 and then Get_Implicit_Definition (Spec) in Iir_Predefined_Implicit; 1354 end Is_Implicit_Subprogram; 1355 1356 function Is_Function_Declaration (N : Iir) return Boolean is 1357 begin 1358 return Kind_In (N, Iir_Kind_Function_Declaration, 1359 Iir_Kind_Interface_Function_Declaration); 1360 end Is_Function_Declaration; 1361 1362 function Is_Procedure_Declaration (N : Iir) return Boolean is 1363 begin 1364 return Kind_In (N, Iir_Kind_Procedure_Declaration, 1365 Iir_Kind_Interface_Procedure_Declaration); 1366 end Is_Procedure_Declaration; 1367 1368 function Is_Same_Profile (L, R: Iir) return Boolean 1369 is 1370 L1, R1 : Iir; 1371 L_Kind, R_Kind : Iir_Kind; 1372 El_L, El_R : Iir; 1373 begin 1374 L_Kind := Get_Kind (L); 1375 if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then 1376 L1 := Get_Named_Entity (Get_Name (L)); 1377 L_Kind := Get_Kind (L1); 1378 else 1379 L1 := L; 1380 end if; 1381 R_Kind := Get_Kind (R); 1382 if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then 1383 R1 := Get_Named_Entity (Get_Name (R)); 1384 R_Kind := Get_Kind (R1); 1385 else 1386 R1 := R; 1387 end if; 1388 1389 -- Check L and R are both of the same 'kind'. 1390 -- Also the return profile for functions. 1391 if L_Kind = Iir_Kind_Function_Declaration 1392 and then R_Kind = Iir_Kind_Function_Declaration 1393 then 1394 if Get_Base_Type (Get_Return_Type (L1)) /= 1395 Get_Base_Type (Get_Return_Type (R1)) 1396 then 1397 return False; 1398 end if; 1399 elsif L_Kind = Iir_Kind_Procedure_Declaration 1400 and then R_Kind = Iir_Kind_Procedure_Declaration 1401 then 1402 null; 1403 elsif L_Kind = Iir_Kind_Enumeration_Literal 1404 and then R_Kind = Iir_Kind_Enumeration_Literal 1405 then 1406 return Get_Type (L1) = Get_Type (R1); 1407 elsif L_Kind = Iir_Kind_Enumeration_Literal 1408 and then R_Kind = Iir_Kind_Function_Declaration 1409 then 1410 return Get_Interface_Declaration_Chain (R1) = Null_Iir 1411 and then Get_Base_Type (Get_Return_Type (R1)) = Get_Type (L1); 1412 elsif L_Kind = Iir_Kind_Function_Declaration 1413 and then R_Kind = Iir_Kind_Enumeration_Literal 1414 then 1415 return Get_Interface_Declaration_Chain (L1) = Null_Iir 1416 and then Get_Base_Type (Get_Return_Type (L1)) = Get_Type (R1); 1417 else 1418 -- Kind mismatch. 1419 return False; 1420 end if; 1421 1422 -- Check parameters profile. 1423 El_L := Get_Interface_Declaration_Chain (L1); 1424 El_R := Get_Interface_Declaration_Chain (R1); 1425 loop 1426 exit when El_L = Null_Iir and El_R = Null_Iir; 1427 if El_L = Null_Iir or El_R = Null_Iir then 1428 return False; 1429 end if; 1430 if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R)) 1431 then 1432 return False; 1433 end if; 1434 El_L := Get_Chain (El_L); 1435 El_R := Get_Chain (El_R); 1436 end loop; 1437 1438 return True; 1439 end Is_Same_Profile; 1440 1441 function Is_Operation_For_Type (Subprg : Iir; Atype : Iir) return Boolean 1442 is 1443 pragma Assert (Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration); 1444 Base_Type : constant Iir := Get_Base_Type (Atype); 1445 Inter : Iir; 1446 begin 1447 Inter := Get_Interface_Declaration_Chain (Subprg); 1448 while Inter /= Null_Iir loop 1449 if Get_Base_Type (Get_Type (Inter)) = Base_Type then 1450 return True; 1451 end if; 1452 Inter := Get_Chain (Inter); 1453 end loop; 1454 if Get_Kind (Subprg) = Iir_Kind_Function_Declaration 1455 and then Get_Base_Type (Get_Return_Type (Subprg)) = Base_Type 1456 then 1457 return True; 1458 end if; 1459 return False; 1460 end Is_Operation_For_Type; 1461 1462 -- From a block_specification, returns the block. 1463 function Get_Block_From_Block_Specification (Block_Spec : Iir) return Iir 1464 is 1465 Res : Iir; 1466 begin 1467 case Get_Kind (Block_Spec) is 1468 when Iir_Kind_Design_Unit => 1469 Res := Get_Library_Unit (Block_Spec); 1470 pragma Assert (Get_Kind (Res) = Iir_Kind_Architecture_Body); 1471 return Res; 1472 when Iir_Kind_Block_Statement 1473 | Iir_Kind_Architecture_Body 1474 | Iir_Kind_For_Generate_Statement 1475 | Iir_Kind_If_Generate_Statement => 1476 return Block_Spec; 1477 when Iir_Kind_Indexed_Name 1478 | Iir_Kind_Selected_Name 1479 | Iir_Kind_Slice_Name => 1480 return Get_Named_Entity (Get_Prefix (Block_Spec)); 1481 when Iir_Kind_Simple_Name => 1482 return Get_Named_Entity (Block_Spec); 1483 when Iir_Kind_Parenthesis_Name => 1484 -- An alternative label. 1485 return Get_Named_Entity (Block_Spec); 1486 when others => 1487 Error_Kind ("get_block_from_block_specification", Block_Spec); 1488 return Null_Iir; 1489 end case; 1490 end Get_Block_From_Block_Specification; 1491 1492 function Get_Entity (Decl : Iir) return Iir 1493 is 1494 Name : constant Iir := Get_Entity_Name (Decl); 1495 Res : constant Iir := Get_Named_Entity (Name); 1496 begin 1497 if Res = Vhdl.Std_Package.Error_Mark then 1498 return Null_Iir; 1499 end if; 1500 1501 pragma Assert (Res = Null_Iir 1502 or else Get_Kind (Res) = Iir_Kind_Entity_Declaration); 1503 return Res; 1504 end Get_Entity; 1505 1506 function Get_Configuration (Aspect : Iir) return Iir 1507 is 1508 Name : constant Iir := Get_Configuration_Name (Aspect); 1509 Res : constant Iir := Get_Named_Entity (Name); 1510 begin 1511 pragma Assert (Get_Kind (Res) = Iir_Kind_Configuration_Declaration); 1512 return Res; 1513 end Get_Configuration; 1514 1515 function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id 1516 is 1517 Name : constant Iir := Get_Entity_Name (Arch); 1518 begin 1519 case Get_Kind (Name) is 1520 when Iir_Kind_Simple_Name 1521 | Iir_Kind_Selected_Name => 1522 return Get_Identifier (Name); 1523 when Iir_Kind_Error => 1524 return Null_Identifier; 1525 when others => 1526 Error_Kind ("get_entity_identifier_of_architecture", Name); 1527 end case; 1528 end Get_Entity_Identifier_Of_Architecture; 1529 1530 function Is_Component_Instantiation 1531 (Inst : Iir_Component_Instantiation_Statement) return Boolean is 1532 begin 1533 case Get_Kind (Get_Instantiated_Unit (Inst)) is 1534 when Iir_Kinds_Denoting_Name => 1535 return True; 1536 when Iir_Kind_Entity_Aspect_Entity 1537 | Iir_Kind_Entity_Aspect_Configuration => 1538 return False; 1539 when others => 1540 Error_Kind ("is_component_instantiation", Inst); 1541 end case; 1542 end Is_Component_Instantiation; 1543 1544 function Is_Entity_Instantiation 1545 (Inst : Iir_Component_Instantiation_Statement) return Boolean is 1546 begin 1547 case Get_Kind (Get_Instantiated_Unit (Inst)) is 1548 when Iir_Kinds_Denoting_Name => 1549 return False; 1550 when Iir_Kind_Entity_Aspect_Entity 1551 | Iir_Kind_Entity_Aspect_Configuration => 1552 return True; 1553 when others => 1554 Error_Kind ("is_entity_instantiation", Inst); 1555 end case; 1556 end Is_Entity_Instantiation; 1557 1558 function Get_Attribute_Name_Expression (Name : Iir) return Iir 1559 is 1560 Attr_Val : constant Iir := Get_Named_Entity (Name); 1561 Attr_Spec : constant Iir := Get_Attribute_Specification (Attr_Val); 1562 Attr_Expr : constant Iir := Get_Expression (Attr_Spec); 1563 begin 1564 return Attr_Expr; 1565 end Get_Attribute_Name_Expression; 1566 1567 function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is 1568 begin 1569 if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then 1570 Error_Kind ("get_string_type_bound_type", Sub_Type); 1571 end if; 1572 return Get_Nth_Element (Get_Index_Subtype_List (Sub_Type), 0); 1573 end Get_String_Type_Bound_Type; 1574 1575 procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; 1576 Low, High : out Iir) 1577 is 1578 begin 1579 case Get_Direction (Arange) is 1580 when Dir_To => 1581 Low := Get_Left_Limit (Arange); 1582 High := Get_Right_Limit (Arange); 1583 when Dir_Downto => 1584 High := Get_Left_Limit (Arange); 1585 Low := Get_Right_Limit (Arange); 1586 end case; 1587 end Get_Low_High_Limit; 1588 1589 function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is 1590 begin 1591 case Get_Direction (Arange) is 1592 when Dir_To => 1593 return Get_Left_Limit (Arange); 1594 when Dir_Downto => 1595 return Get_Right_Limit (Arange); 1596 end case; 1597 end Get_Low_Limit; 1598 1599 function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is 1600 begin 1601 case Get_Direction (Arange) is 1602 when Dir_To => 1603 return Get_Right_Limit (Arange); 1604 when Dir_Downto => 1605 return Get_Left_Limit (Arange); 1606 end case; 1607 end Get_High_Limit; 1608 1609 function Is_Range_Attribute_Name (Expr : Iir) return Boolean 1610 is 1611 Attr : Iir; 1612 Id : Name_Id; 1613 begin 1614 if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then 1615 Attr := Get_Prefix (Expr); 1616 else 1617 Attr := Expr; 1618 end if; 1619 if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then 1620 return False; 1621 end if; 1622 Id := Get_Identifier (Attr); 1623 return Id = Name_Range or Id = Name_Reverse_Range; 1624 end Is_Range_Attribute_Name; 1625 1626 function Get_Range_From_Discrete_Range (Rng : Iir) return Iir is 1627 begin 1628 case Get_Kind (Rng) is 1629 when Iir_Kinds_Denoting_Name => 1630 return Get_Range_From_Discrete_Range (Get_Named_Entity (Rng)); 1631 when Iir_Kinds_Scalar_Subtype_Definition => 1632 return Get_Range_Constraint (Rng); 1633 when Iir_Kind_Range_Expression => 1634 return Rng; 1635 when Iir_Kinds_Range_Attribute => 1636 return Rng; 1637 when others => 1638 Error_Kind ("get_range_from_discrete_range", Rng); 1639 end case; 1640 end Get_Range_From_Discrete_Range; 1641 1642 function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) 1643 return Iir_Array_Subtype_Definition 1644 is 1645 Base_Type : constant Iir := Get_Base_Type (Arr_Type); 1646 El_Type : constant Iir := Get_Element_Subtype (Base_Type); 1647 Res : Iir_Array_Subtype_Definition; 1648 List : Iir_Flist; 1649 begin 1650 Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); 1651 Set_Location (Res, Loc); 1652 Set_Parent_Type (Res, Base_Type); 1653 Set_Element_Subtype (Res, El_Type); 1654 if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then 1655 Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type)); 1656 end if; 1657 Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); 1658 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); 1659 Set_Type_Staticness (Res, Get_Type_Staticness (El_Type)); 1660 List := Create_Iir_Flist (Get_Nbr_Dimensions (Base_Type)); 1661 Set_Index_Subtype_List (Res, List); 1662 Set_Index_Constraint_List (Res, List); 1663 return Res; 1664 end Create_Array_Subtype; 1665 1666 function Is_Subprogram_Method (Spec : Iir) return Boolean is 1667 begin 1668 case Get_Kind (Get_Parent (Spec)) is 1669 when Iir_Kind_Protected_Type_Declaration 1670 | Iir_Kind_Protected_Type_Body => 1671 return True; 1672 when others => 1673 return False; 1674 end case; 1675 end Is_Subprogram_Method; 1676 1677 function Get_Method_Type (Spec : Iir) return Iir 1678 is 1679 Parent : Iir; 1680 begin 1681 Parent := Get_Parent (Spec); 1682 case Get_Kind (Parent) is 1683 when Iir_Kind_Protected_Type_Declaration => 1684 return Parent; 1685 when Iir_Kind_Protected_Type_Body => 1686 return Get_Protected_Type_Declaration (Parent); 1687 when others => 1688 return Null_Iir; 1689 end case; 1690 end Get_Method_Type; 1691 1692 function Get_Actual_Or_Default (Assoc : Iir; Inter : Iir) return Iir is 1693 begin 1694 case Get_Kind (Assoc) is 1695 when Iir_Kind_Association_Element_By_Expression => 1696 return Get_Actual (Assoc); 1697 when Iir_Kind_Association_Element_Open => 1698 return Get_Default_Value (Inter); 1699 when others => 1700 Error_Kind ("get_actual_or_default", Assoc); 1701 end case; 1702 end Get_Actual_Or_Default; 1703 1704 function Create_Error (Orig : Iir) return Iir 1705 is 1706 Res : Iir; 1707 begin 1708 Res := Create_Iir (Iir_Kind_Error); 1709 if Orig /= Null_Iir then 1710 Set_Error_Origin (Res, Orig); 1711 Location_Copy (Res, Orig); 1712 end if; 1713 return Res; 1714 end Create_Error; 1715 1716 function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir 1717 is 1718 Res : Iir; 1719 begin 1720 Res := Create_Error (Orig); 1721 Set_Expr_Staticness (Res, None); 1722 Set_Type (Res, Atype); 1723 return Res; 1724 end Create_Error_Expr; 1725 1726 function Create_Error_Type (Orig : Iir) return Iir 1727 is 1728 Res : Iir; 1729 begin 1730 Res := Create_Error (Orig); 1731 --Set_Expr_Staticness (Res, Locally); 1732 Set_Type_Declarator (Res, Null_Iir); 1733 Set_Resolved_Flag (Res, True); 1734 Set_Signal_Type_Flag (Res, True); 1735 return Res; 1736 end Create_Error_Type; 1737 1738 function Create_Error_Name (Orig : Iir) return Iir 1739 is 1740 Res : Iir; 1741 begin 1742 Res := Create_Iir (Iir_Kind_Error); 1743 Set_Expr_Staticness (Res, None); 1744 Set_Error_Origin (Res, Orig); 1745 Location_Copy (Res, Orig); 1746 return Res; 1747 end Create_Error_Name; 1748 1749 -- Extract the entity from ASPECT. 1750 -- Note: if ASPECT is a component declaration, returns ASPECT. 1751 function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir 1752 is 1753 Inst : Iir; 1754 begin 1755 case Get_Kind (Aspect) is 1756 when Iir_Kinds_Denoting_Name => 1757 -- A component declaration. 1758 Inst := Get_Named_Entity (Aspect); 1759 pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Declaration); 1760 return Inst; 1761 when Iir_Kind_Component_Declaration => 1762 return Aspect; 1763 when Iir_Kind_Entity_Aspect_Entity => 1764 return Get_Entity (Aspect); 1765 when Iir_Kind_Entity_Aspect_Configuration => 1766 Inst := Get_Configuration (Aspect); 1767 return Get_Entity (Inst); 1768 when Iir_Kind_Entity_Aspect_Open => 1769 return Null_Iir; 1770 when others => 1771 Error_Kind ("get_entity_from_entity_aspect", Aspect); 1772 end case; 1773 end Get_Entity_From_Entity_Aspect; 1774 1775 function Get_Entity_From_Configuration (Config : Iir) return Iir 1776 is 1777 Conf_Unit : constant Iir := Get_Library_Unit (Config); 1778 Arch : constant Iir := Get_Named_Entity 1779 (Get_Block_Specification (Get_Block_Configuration (Conf_Unit))); 1780 Entity : constant Iir := Vhdl.Utils.Get_Entity (Arch); 1781 begin 1782 return Entity; 1783 end Get_Entity_From_Configuration; 1784 1785 function Is_Nested_Package (Pkg : Iir) return Boolean is 1786 begin 1787 return Get_Kind (Get_Parent (Pkg)) /= Iir_Kind_Design_Unit; 1788 end Is_Nested_Package; 1789 1790 -- LRM08 4.7 Package declarations 1791 -- If the package header is empty, the package declared by a package 1792 -- declaration is called a simple package. 1793 function Is_Simple_Package (Pkg : Iir) return Boolean is 1794 begin 1795 return Get_Package_Header (Pkg) = Null_Iir; 1796 end Is_Simple_Package; 1797 1798 -- LRM08 4.7 Package declarations 1799 -- If the package header contains a generic clause and no generic map 1800 -- aspect, the package is called an uninstantiated package. 1801 function Is_Uninstantiated_Package (Pkg : Iir) return Boolean 1802 is 1803 Header : constant Iir := Get_Package_Header (Pkg); 1804 begin 1805 return Header /= Null_Iir 1806 and then Get_Generic_Map_Aspect_Chain (Header) = Null_Iir; 1807 end Is_Uninstantiated_Package; 1808 1809 -- LRM08 4.7 Package declarations 1810 -- If the package header contains both a generic clause and a generic 1811 -- map aspect, the package is declared a generic-mapped package. 1812 function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean 1813 is 1814 Header : constant Iir := Get_Package_Header (Pkg); 1815 begin 1816 return Header /= Null_Iir 1817 and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir; 1818 end Is_Generic_Mapped_Package; 1819 1820 -- LRM08 4.2 Subprogram declarations 1821 -- If the subprogram header contains the reserved word GENERIC, a generic 1822 -- list, and no generic map aspect, the subprogram is called an 1823 -- uninstantiated subprogram. 1824 function Is_Uninstantiated_Subprogram (Subprg : Iir) return Boolean is 1825 begin 1826 return Get_Generic_Chain (Subprg) /= Null_Iir; 1827 end Is_Uninstantiated_Subprogram; 1828 1829 function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean 1830 is 1831 K : constant Iir_Kind := Get_Kind (N); 1832 begin 1833 return K = K1 or K = K2; 1834 end Kind_In; 1835 1836 procedure Set_Attribute_Parameter 1837 (Attr : Iir; N : Parameter_Index; Param : Iir) is 1838 begin 1839 case N is 1840 when 1 => 1841 Set_Parameter (Attr, Param); 1842 when 2 => 1843 Set_Parameter_2 (Attr, Param); 1844 when 3 => 1845 Set_Parameter_3 (Attr, Param); 1846 when 4 => 1847 Set_Parameter_4 (Attr, Param); 1848 end case; 1849 end Set_Attribute_Parameter; 1850 1851 function Get_Attribute_Parameter 1852 (Attr : Iir; N : Parameter_Index) return Iir is 1853 begin 1854 case N is 1855 when 1 => 1856 return Get_Parameter (Attr); 1857 when 2 => 1858 return Get_Parameter_2 (Attr); 1859 when 3 => 1860 return Get_Parameter_3 (Attr); 1861 when 4 => 1862 return Get_Parameter_4 (Attr); 1863 end case; 1864 end Get_Attribute_Parameter; 1865 1866 function Get_File_Signature_Length (Def : Iir) return Natural is 1867 begin 1868 case Get_Kind (Def) is 1869 when Iir_Kinds_Scalar_Type_And_Subtype_Definition => 1870 return 1; 1871 when Iir_Kind_Array_Type_Definition 1872 | Iir_Kind_Array_Subtype_Definition => 1873 return 2 1874 + Get_File_Signature_Length (Get_Element_Subtype (Def)); 1875 when Iir_Kind_Record_Type_Definition 1876 | Iir_Kind_Record_Subtype_Definition => 1877 declare 1878 List : constant Iir_Flist := 1879 Get_Elements_Declaration_List (Get_Base_Type (Def)); 1880 El : Iir; 1881 Res : Natural; 1882 begin 1883 Res := 2; 1884 for I in Flist_First .. Flist_Last (List) loop 1885 El := Get_Nth_Element (List, I); 1886 Res := Res + Get_File_Signature_Length (Get_Type (El)); 1887 end loop; 1888 return Res; 1889 end; 1890 when others => 1891 Error_Kind ("get_file_signature_length", Def); 1892 end case; 1893 end Get_File_Signature_Length; 1894 1895 procedure Get_File_Signature (Def : Iir; 1896 Res : in out String; 1897 Off : in out Natural) 1898 is 1899 Base_Type : constant Iir := Get_Base_Type (Def); 1900 begin 1901 case Get_Kind (Base_Type) is 1902 when Iir_Kind_Integer_Type_Definition => 1903 case Get_Scalar_Size (Base_Type) is 1904 when Scalar_32 => 1905 Res (Off) := 'i'; 1906 when Scalar_64 => 1907 Res (Off) := 'I'; 1908 when others => 1909 raise Internal_Error; 1910 end case; 1911 Off := Off + 1; 1912 when Iir_Kind_Physical_Type_Definition => 1913 case Get_Scalar_Size (Base_Type) is 1914 when Scalar_32 => 1915 Res (Off) := 'p'; 1916 when Scalar_64 => 1917 Res (Off) := 'P'; 1918 when others => 1919 raise Internal_Error; 1920 end case; 1921 Off := Off + 1; 1922 when Iir_Kind_Floating_Type_Definition => 1923 Res (Off) := 'F'; 1924 Off := Off + 1; 1925 when Iir_Kind_Enumeration_Type_Definition => 1926 if Base_Type = Std_Package.Boolean_Type_Definition then 1927 Res (Off) := 'b'; 1928 else 1929 case Get_Scalar_Size (Base_Type) is 1930 when Scalar_8 => 1931 Res (Off) := 'e'; 1932 when Scalar_32 => 1933 Res (Off) := 'E'; 1934 when others => 1935 raise Internal_Error; 1936 end case; 1937 end if; 1938 Off := Off + 1; 1939 when Iir_Kind_Array_Type_Definition 1940 | Iir_Kind_Array_Subtype_Definition => 1941 Res (Off) := '['; 1942 Off := Off + 1; 1943 Get_File_Signature (Get_Element_Subtype (Def), Res, Off); 1944 Res (Off) := ']'; 1945 Off := Off + 1; 1946 when Iir_Kind_Record_Type_Definition 1947 | Iir_Kind_Record_Subtype_Definition => 1948 declare 1949 List : constant Iir_Flist := 1950 Get_Elements_Declaration_List (Get_Base_Type (Def)); 1951 El : Iir; 1952 begin 1953 Res (Off) := '<'; 1954 Off := Off + 1; 1955 for I in Flist_First .. Flist_Last (List) loop 1956 El := Get_Nth_Element (List, I); 1957 Get_File_Signature (Get_Type (El), Res, Off); 1958 end loop; 1959 Res (Off) := '>'; 1960 Off := Off + 1; 1961 end; 1962 when others => 1963 Error_Kind ("get_file_signature", Def); 1964 end case; 1965 end Get_File_Signature; 1966 1967 function Get_HDL_Node (N : PSL_Node) return Iir is 1968 begin 1969 return Iir (PSL.Nodes.Get_HDL_Node (N)); 1970 end Get_HDL_Node; 1971 1972 procedure Set_HDL_Node (N : PSL_Node; Expr : Iir) is 1973 begin 1974 PSL.Nodes.Set_HDL_Node (N, PSL.Nodes.HDL_Node (Expr)); 1975 end Set_HDL_Node; 1976end Vhdl.Utils; 1977