1-- Canonicalization pass 2-- Copyright (C) 2002, 2003, 2004, 2005, 2008 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 Vhdl.Errors; use Vhdl.Errors; 18with Vhdl.Utils; use Vhdl.Utils; 19with Types; use Types; 20with Flags; use Flags; 21with Name_Table; 22with Vhdl.Sem; 23with Vhdl.Sem_Inst; 24with Vhdl.Sem_Specs; 25with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils; 26with PSL.Types; use PSL.Types; 27with PSL.Nodes; 28with PSL.Rewrites; 29with PSL.Build; 30with PSL.NFAs; 31with PSL.NFAs.Utils; 32with PSL.Errors; use PSL.Errors; 33with Vhdl.Canon_PSL; 34 35package body Vhdl.Canon is 36 Canon_Flag_Set_Assoc_Formals : constant Boolean := False; 37 38 -- Canonicalize the chain of declarations in Declaration_Chain of 39 -- DECL_PARENT. PARENT must be the parent of the current statements chain, 40 -- or NULL_IIR if DECL_PARENT has no corresponding current statments. 41 -- TOP is used to add dependencies (from binding indications). 42 procedure Canon_Declarations (Top : Iir_Design_Unit; 43 Decl_Parent : Iir; 44 Parent : Iir); 45 function Canon_Declaration (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir) 46 return Iir; 47 48 procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir); 49 procedure Canon_Simultaneous_Stmts (Top : Iir_Design_Unit; Chain : Iir); 50 51 -- Canonicalize an association list. 52 -- If ASSOCIATION_LIST is not null, then it is re-ordored and returned. 53 -- If ASSOCIATION_LIST is null then: 54 -- if INTERFACE_LIST is null then returns null. 55 -- if INTERFACE_LIST is not null, a default list is created. 56 function Canon_Association_Chain 57 (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) 58 return Iir; 59 60 -- Like Canon_Association_Chain but recurse on actuals. 61 function Canon_Association_Chain_And_Actuals 62 (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) 63 return Iir; 64 65 -- Like Canon_Subprogram_Call, but recurse on actuals. 66 procedure Canon_Subprogram_Call_And_Actuals (Call : Iir); 67 68 -- Canonicalize block configuration CONF. 69 -- TOP is used to added dependences to the design unit which CONF 70 -- belongs to. 71 procedure Canon_Block_Configuration (Top : Iir_Design_Unit; 72 Conf : Iir_Block_Configuration); 73 74 procedure Canon_Subtype_Indication (Def : Iir); 75 procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir); 76 77 function Canon_Conditional_Signal_Assignment 78 (Conc_Stmt : Iir; Proc : Iir; Parent : Iir; Clear : Boolean) return Iir; 79 procedure Canon_Conditional_Signal_Assignment_Expression (Stmt : Iir); 80 81 procedure Canon_Extract_Sensitivity_Aggregate 82 (Aggr : Iir; 83 Sensitivity_List : Iir_List; 84 Is_Target : Boolean; 85 Aggr_Type : Iir; 86 Dim : Natural) 87 is 88 Assoc : Iir; 89 begin 90 Assoc := Get_Association_Choices_Chain (Aggr); 91 if Get_Nbr_Elements (Get_Index_Subtype_List (Aggr_Type)) = Dim then 92 while Assoc /= Null_Iir loop 93 Canon_Extract_Sensitivity_Expression 94 (Get_Associated_Expr (Assoc), Sensitivity_List, Is_Target); 95 Assoc := Get_Chain (Assoc); 96 end loop; 97 else 98 while Assoc /= Null_Iir loop 99 Canon_Extract_Sensitivity_Aggregate 100 (Get_Associated_Expr (Assoc), Sensitivity_List, 101 Is_Target, Aggr_Type, Dim + 1); 102 Assoc := Get_Chain (Assoc); 103 end loop; 104 end if; 105 end Canon_Extract_Sensitivity_Aggregate; 106 107 procedure Canon_Extract_Sensitivity_Expression 108 (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) 109 is 110 El : Iir; 111 begin 112 if Get_Expr_Staticness (Expr) /= None then 113 return; 114 end if; 115 116 case Get_Kind (Expr) is 117 when Iir_Kind_Slice_Name => 118 if not Is_Target and then 119 Get_Name_Staticness (Expr) >= Globally 120 then 121 if Is_Signal_Object (Expr) then 122 Add_Element (Sensitivity_List, Expr); 123 end if; 124 else 125 declare 126 Suff : Iir; 127 begin 128 Canon_Extract_Sensitivity_Expression 129 (Get_Prefix (Expr), Sensitivity_List, Is_Target); 130 Suff := Get_Suffix (Expr); 131 if Get_Kind (Suff) 132 not in Iir_Kinds_Scalar_Type_And_Subtype_Definition 133 then 134 Canon_Extract_Sensitivity_Expression 135 (Suff, Sensitivity_List, False); 136 end if; 137 end; 138 end if; 139 140 when Iir_Kind_Selected_Element => 141 if not Is_Target and then 142 Get_Name_Staticness (Expr) >= Globally 143 then 144 if Is_Signal_Object (Expr) then 145 Add_Element (Sensitivity_List, Expr); 146 end if; 147 else 148 Canon_Extract_Sensitivity_Expression 149 (Get_Prefix (Expr), Sensitivity_List, Is_Target); 150 end if; 151 152 when Iir_Kind_Indexed_Name => 153 if not Is_Target 154 and then Get_Name_Staticness (Expr) >= Globally 155 then 156 if Is_Signal_Object (Expr) then 157 Add_Element (Sensitivity_List, Expr); 158 end if; 159 else 160 Canon_Extract_Sensitivity_Expression 161 (Get_Prefix (Expr), Sensitivity_List, Is_Target); 162 declare 163 Flist : constant Iir_Flist := Get_Index_List (Expr); 164 El : Iir; 165 begin 166 for I in Flist_First .. Flist_Last (Flist) loop 167 El := Get_Nth_Element (Flist, I); 168 Canon_Extract_Sensitivity_Expression 169 (El, Sensitivity_List, False); 170 end loop; 171 end; 172 end if; 173 174 when Iir_Kind_Function_Call => 175 El := Get_Parameter_Association_Chain (Expr); 176 while El /= Null_Iir loop 177 case Get_Kind (El) is 178 when Iir_Kind_Association_Element_By_Expression => 179 Canon_Extract_Sensitivity_Expression 180 (Get_Actual (El), Sensitivity_List, False); 181 when Iir_Kind_Association_Element_Open => 182 null; 183 when others => 184 Error_Kind ("canon_extract_sensitivity(call)", El); 185 end case; 186 El := Get_Chain (El); 187 end loop; 188 189 when Iir_Kind_Qualified_Expression 190 | Iir_Kind_Type_Conversion 191 | Iir_Kind_Allocator_By_Expression 192 | Iir_Kind_Parenthesis_Expression => 193 Canon_Extract_Sensitivity_Expression 194 (Get_Expression (Expr), Sensitivity_List, False); 195 196 when Iir_Kind_Allocator_By_Subtype => 197 null; 198 199 when Iir_Kind_Dereference 200 | Iir_Kind_Implicit_Dereference => 201 Canon_Extract_Sensitivity_Expression 202 (Get_Prefix (Expr), Sensitivity_List, False); 203 204 when Iir_Kind_External_Variable_Name 205 | Iir_Kind_External_Constant_Name => 206 null; 207 208 when Iir_Kinds_Monadic_Operator => 209 Canon_Extract_Sensitivity_Expression 210 (Get_Operand (Expr), Sensitivity_List, False); 211 when Iir_Kinds_Dyadic_Operator => 212 Canon_Extract_Sensitivity_Expression 213 (Get_Left (Expr), Sensitivity_List, False); 214 Canon_Extract_Sensitivity_Expression 215 (Get_Right (Expr), Sensitivity_List, False); 216 217 when Iir_Kind_Range_Expression => 218 Canon_Extract_Sensitivity_Expression 219 (Get_Left_Limit (Expr), Sensitivity_List, False); 220 Canon_Extract_Sensitivity_Expression 221 (Get_Right_Limit (Expr), Sensitivity_List, False); 222 223 when Iir_Kinds_Type_Attribute => 224 null; 225 when Iir_Kinds_Signal_Value_Attribute => 226 -- LRM 8.1 227 -- An attribute name: [...]; otherwise, apply this rule to the 228 -- prefix of the attribute name. 229 Canon_Extract_Sensitivity_Expression 230 (Get_Prefix (Expr), Sensitivity_List, False); 231 232 when Iir_Kind_Interface_Signal_Declaration 233 | Iir_Kind_Signal_Declaration 234 | Iir_Kind_Guard_Signal_Declaration 235 | Iir_Kind_Anonymous_Signal_Declaration 236 | Iir_Kinds_Signal_Attribute 237 | Iir_Kind_Above_Attribute 238 | Iir_Kind_External_Signal_Name => 239 -- LRM 8.1 240 -- A simple name that denotes a signal, add the longuest static 241 -- prefix of the name to the sensitivity set; 242 -- 243 -- An attribute name: if the designator denotes a signal 244 -- attribute, add the longuest static prefix of the name of the 245 -- implicit signal denoted by the attribute name to the 246 -- sensitivity set; [...] 247 if not Is_Target then 248 Add_Element (Sensitivity_List, Expr); 249 end if; 250 251 when Iir_Kind_Psl_Endpoint_Declaration => 252 declare 253 List : constant Iir_List := Get_PSL_Clock_Sensitivity (Expr); 254 It : List_Iterator; 255 begin 256 It := List_Iterate (List); 257 while Is_Valid (It) loop 258 Add_Element (Sensitivity_List, Get_Element (It)); 259 Next (It); 260 end loop; 261 end; 262 263 when Iir_Kind_Object_Alias_Declaration => 264 if not Is_Target and then Is_Signal_Object (Expr) then 265 Add_Element (Sensitivity_List, Expr); 266 end if; 267 268 when Iir_Kind_Constant_Declaration 269 | Iir_Kind_Interface_Constant_Declaration 270 | Iir_Kind_Iterator_Declaration 271 | Iir_Kind_Variable_Declaration 272 | Iir_Kind_Interface_Variable_Declaration 273 | Iir_Kind_File_Declaration 274 | Iir_Kinds_Quantity_Declaration => 275 null; 276 277 when Iir_Kinds_Array_Attribute => 278 -- was Iir_Kind_Left_Array_Attribute 279 -- ditto Right, Low, High, Length 280 -- add Ascending, Range and Reverse_Range... 281 null; 282 --Canon_Extract_Sensitivity 283 -- (Get_Prefix (Expr), Sensitivity_List, Is_Target); 284 285 when Iir_Kind_Value_Attribute 286 | Iir_Kind_Image_Attribute 287 | Iir_Kinds_Scalar_Type_Attribute => 288 Canon_Extract_Sensitivity_Expression 289 (Get_Parameter (Expr), Sensitivity_List, Is_Target); 290 291 when Iir_Kind_Aggregate => 292 declare 293 Aggr_Type : Iir; 294 begin 295 Aggr_Type := Get_Base_Type (Get_Type (Expr)); 296 case Get_Kind (Aggr_Type) is 297 when Iir_Kind_Array_Type_Definition => 298 Canon_Extract_Sensitivity_Aggregate 299 (Expr, Sensitivity_List, Is_Target, Aggr_Type, 1); 300 when Iir_Kind_Record_Type_Definition => 301 El := Get_Association_Choices_Chain (Expr); 302 while El /= Null_Iir loop 303 Canon_Extract_Sensitivity_Expression 304 (Get_Associated_Expr (El), Sensitivity_List, 305 Is_Target); 306 El := Get_Chain (El); 307 end loop; 308 when others => 309 Error_Kind ("canon_extract_sensitivity(aggr)", Aggr_Type); 310 end case; 311 end; 312 313 when Iir_Kind_Simple_Name 314 | Iir_Kind_Selected_Name 315 | Iir_Kind_Reference_Name => 316 Canon_Extract_Sensitivity_Expression 317 (Get_Named_Entity (Expr), Sensitivity_List, Is_Target); 318 319 when others => 320 Error_Kind ("canon_extract_sensitivity", Expr); 321 end case; 322 end Canon_Extract_Sensitivity_Expression; 323 324 procedure Canon_Extract_Sensitivity_If_Not_Null 325 (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is 326 begin 327 if Expr /= Null_Iir then 328 Canon_Extract_Sensitivity_Expression 329 (Expr, Sensitivity_List, Is_Target); 330 end if; 331 end Canon_Extract_Sensitivity_If_Not_Null; 332 333 procedure Canon_Extract_Sensitivity_Procedure_Call 334 (Sensitivity_List : Iir_List; Call : Iir) 335 is 336 Assoc : Iir; 337 Inter : Iir; 338 begin 339 Assoc := Get_Parameter_Association_Chain (Call); 340 Inter := Get_Interface_Declaration_Chain (Get_Implementation (Call)); 341 while Assoc /= Null_Iir loop 342 if (Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression) 343 and then (Get_Mode (Get_Association_Interface (Assoc, Inter)) 344 /= Iir_Out_Mode) 345 then 346 Canon_Extract_Sensitivity_Expression 347 (Get_Actual (Assoc), Sensitivity_List); 348 end if; 349 Next_Association_Interface (Assoc, Inter); 350 end loop; 351 end Canon_Extract_Sensitivity_Procedure_Call; 352 353 procedure Canon_Extract_Sensitivity_Waveform (Chain : Iir; List : Iir_List) 354 is 355 We: Iir_Waveform_Element; 356 begin 357 We := Chain; 358 while We /= Null_Iir loop 359 Canon_Extract_Sensitivity_Expression (Get_We_Value (We), List); 360 Canon_Extract_Sensitivity_If_Not_Null (Get_Time (We), List); 361 We := Get_Chain (We); 362 end loop; 363 end Canon_Extract_Sensitivity_Waveform; 364 365 procedure Canon_Extract_Sensitivity_Statement 366 (Stmt : Iir; List : Iir_List) is 367 begin 368 case Get_Kind (Stmt) is 369 when Iir_Kind_Assertion_Statement => 370 -- LRM08 11.3 371 -- * For each assertion, report, next, exit or return 372 -- statement, apply the rule of 10.2 to each expression 373 -- in the statement, and construct the union of the 374 -- resulting sets. 375 Canon_Extract_Sensitivity_Expression 376 (Get_Assertion_Condition (Stmt), List); 377 Canon_Extract_Sensitivity_If_Not_Null 378 (Get_Severity_Expression (Stmt), List); 379 Canon_Extract_Sensitivity_If_Not_Null 380 (Get_Report_Expression (Stmt), List); 381 when Iir_Kind_Report_Statement => 382 -- LRM08 11.3 383 -- See assertion_statement case. 384 Canon_Extract_Sensitivity_If_Not_Null 385 (Get_Severity_Expression (Stmt), List); 386 Canon_Extract_Sensitivity_Expression 387 (Get_Report_Expression (Stmt), List); 388 when Iir_Kind_Next_Statement 389 | Iir_Kind_Exit_Statement => 390 -- LRM08 11.3 391 -- See assertion_statement case. 392 Canon_Extract_Sensitivity_If_Not_Null 393 (Get_Condition (Stmt), List); 394 when Iir_Kind_Return_Statement => 395 -- LRM08 11.3 396 -- See assertion_statement case. 397 Canon_Extract_Sensitivity_If_Not_Null 398 (Get_Expression (Stmt), List); 399 when Iir_Kind_Variable_Assignment_Statement => 400 -- LRM08 11.3 401 -- * For each assignment statement, apply the rule of 10.2 to 402 -- each expression occuring in the assignment, including any 403 -- expressions occuring in the index names or slice names in 404 -- the target, and construct the union of the resulting sets. 405 Canon_Extract_Sensitivity_Expression 406 (Get_Target (Stmt), List, True); 407 Canon_Extract_Sensitivity_Expression 408 (Get_Expression (Stmt), List, False); 409 when Iir_Kind_Simple_Signal_Assignment_Statement => 410 -- LRM08 11.3 411 -- See variable assignment statement case. 412 Canon_Extract_Sensitivity_Expression 413 (Get_Target (Stmt), List, True); 414 Canon_Extract_Sensitivity_If_Not_Null 415 (Get_Reject_Time_Expression (Stmt), List); 416 Canon_Extract_Sensitivity_Waveform 417 (Get_Waveform_Chain (Stmt), List); 418 when Iir_Kind_Conditional_Signal_Assignment_Statement => 419 Canon_Extract_Sensitivity_Expression 420 (Get_Target (Stmt), List, True); 421 Canon_Extract_Sensitivity_If_Not_Null 422 (Get_Reject_Time_Expression (Stmt), List); 423 declare 424 Cwe : Iir; 425 begin 426 Cwe := Get_Conditional_Waveform_Chain (Stmt); 427 while Cwe /= Null_Iir loop 428 Canon_Extract_Sensitivity_If_Not_Null 429 (Get_Condition (Cwe), List); 430 Canon_Extract_Sensitivity_Waveform 431 (Get_Waveform_Chain (Cwe), List); 432 Cwe := Get_Chain (Cwe); 433 end loop; 434 end; 435 when Iir_Kind_If_Statement => 436 -- LRM08 11.3 437 -- * For each if statement, apply the rule of 10.2 to the 438 -- condition and apply this rule recursively to each 439 -- sequence of statements within the if statement, and 440 -- construct the union of the resuling sets. 441 declare 442 El1 : Iir := Stmt; 443 Cond : Iir; 444 begin 445 loop 446 Cond := Get_Condition (El1); 447 if Cond /= Null_Iir then 448 Canon_Extract_Sensitivity_Expression (Cond, List); 449 end if; 450 Canon_Extract_Sensitivity_Sequential_Statement_Chain 451 (Get_Sequential_Statement_Chain (El1), List); 452 El1 := Get_Else_Clause (El1); 453 exit when El1 = Null_Iir; 454 end loop; 455 end; 456 when Iir_Kind_Case_Statement => 457 -- LRM08 11.3 458 -- * For each case statement, apply the rule of 10.2 to the 459 -- expression and apply this rule recursively to each 460 -- sequence of statements within the case statement, and 461 -- construct the union of the resulting sets. 462 Canon_Extract_Sensitivity_Expression (Get_Expression (Stmt), List); 463 declare 464 Choice : Iir; 465 begin 466 Choice := Get_Case_Statement_Alternative_Chain (Stmt); 467 while Choice /= Null_Iir loop 468 Canon_Extract_Sensitivity_Sequential_Statement_Chain 469 (Get_Associated_Chain (Choice), List); 470 Choice := Get_Chain (Choice); 471 end loop; 472 end; 473 when Iir_Kind_While_Loop_Statement => 474 -- LRM08 11.3 475 -- * For each loop statement, apply the rule of 10.2 to each 476 -- expression in the iteration scheme, if present, and apply 477 -- this rule recursively to the sequence of statements within 478 -- the loop statement, and construct the union of the 479 -- resulting sets. 480 Canon_Extract_Sensitivity_If_Not_Null 481 (Get_Condition (Stmt), List); 482 Canon_Extract_Sensitivity_Sequential_Statement_Chain 483 (Get_Sequential_Statement_Chain (Stmt), List); 484 when Iir_Kind_For_Loop_Statement => 485 -- LRM08 11.3 486 -- See loop statement case. 487 declare 488 It : constant Iir := Get_Parameter_Specification (Stmt); 489 It_Type : constant Iir := Get_Type (It); 490 Rng : constant Iir := Get_Range_Constraint (It_Type); 491 begin 492 if Get_Kind (Rng) = Iir_Kind_Range_Expression then 493 Canon_Extract_Sensitivity_Expression (Rng, List); 494 end if; 495 end; 496 Canon_Extract_Sensitivity_Sequential_Statement_Chain 497 (Get_Sequential_Statement_Chain (Stmt), List); 498 when Iir_Kind_Null_Statement => 499 -- LRM08 11.3 500 -- ? 501 null; 502 when Iir_Kind_Procedure_Call_Statement => 503 -- LRM08 11.3 504 -- * For each procedure call statement, apply the rule of 10.2 505 -- to each actual designator (other than OPEN) associated 506 -- with each formal parameter of mode IN or INOUT, and 507 -- construct the union of the resulting sets. 508 Canon_Extract_Sensitivity_Procedure_Call 509 (List, Get_Procedure_Call (Stmt)); 510 when others => 511 Error_Kind ("canon_extract_sensitivity_statement", Stmt); 512 end case; 513 end Canon_Extract_Sensitivity_Statement; 514 515 procedure Canon_Extract_Sensitivity_Sequential_Statement_Chain 516 (Chain : Iir; List : Iir_List) 517 is 518 Stmt : Iir; 519 begin 520 Stmt := Chain; 521 while Stmt /= Null_Iir loop 522 Canon_Extract_Sensitivity_Statement (Stmt, List); 523 Stmt := Get_Chain (Stmt); 524 end loop; 525 end Canon_Extract_Sensitivity_Sequential_Statement_Chain; 526 527 procedure Canon_Extract_Sensitivity_From_Callees 528 (Callees_List : Iir_List; Sensitivity_List : Iir_List) 529 is 530 Callee : Iir; 531 Orig_Callee : Iir; 532 It : List_Iterator; 533 Bod : Iir; 534 begin 535 -- LRM08 11.3 536 -- Moreover, for each subprogram for which the process is a parent 537 -- (see 4.3), the sensitivity list includes members of the set 538 -- constructed by apply the preceding rule to the statements of the 539 -- subprogram, but excluding the members that denote formal signal 540 -- parameters or members of formal signal parameters of the subprogram 541 -- or any of its parents. 542 if Callees_List = Null_Iir_List then 543 return; 544 end if; 545 It := List_Iterate (Callees_List); 546 while Is_Valid (It) loop 547 Callee := Get_Element (It); 548 549 -- For subprograms of instantiated packages, refer to the 550 -- uninstantiated subprogram. 551 -- FIXME: not for macro-expanded packages 552 Orig_Callee := Sem_Inst.Get_Origin (Callee); 553 if Orig_Callee /= Null_Iir then 554 Callee := Orig_Callee; 555 end if; 556 557 if not Get_Seen_Flag (Callee) then 558 Set_Seen_Flag (Callee, True); 559 case Get_All_Sensitized_State (Callee) is 560 when Read_Signal => 561 Bod := Get_Subprogram_Body (Callee); 562 563 -- Extract sensitivity from signals read in the body. 564 -- FIXME: what about signals read during in declarations ? 565 Canon_Extract_Sensitivity_Sequential_Statement_Chain 566 (Get_Sequential_Statement_Chain (Bod), Sensitivity_List); 567 568 -- Extract sensitivity from subprograms called. 569 Canon_Extract_Sensitivity_From_Callees 570 (Get_Callees_List (Bod), Sensitivity_List); 571 572 when No_Signal => 573 null; 574 575 when Invalid_Signal => 576 -- Cannot be here. The error must have been detected. 577 raise Internal_Error; 578 579 when Unknown => 580 -- Must be a subprogram declared in a different design unit, 581 -- or a subprogram calling such a subprogram. 582 -- Only a package can apply to this case. 583 -- Will be checked at elaboration. 584 pragma Assert (not Flags.Flag_Elaborate); 585 null; 586 end case; 587 end if; 588 Next (It); 589 end loop; 590 end Canon_Extract_Sensitivity_From_Callees; 591 592 function Canon_Extract_Sensitivity_Process 593 (Proc : Iir_Sensitized_Process_Statement) return Iir_List 594 is 595 Res : Iir_List; 596 begin 597 Res := Create_Iir_List; 598 599 -- Signals read by statements. 600 -- FIXME: justify why signals read in declarations don't care. 601 Canon_Extract_Sensitivity_Sequential_Statement_Chain 602 (Get_Sequential_Statement_Chain (Proc), Res); 603 604 -- Signals read indirectly by subprograms called. 605 Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Proc), Res); 606 607 Set_Seen_Flag (Proc, True); 608 Clear_Seen_Flag (Proc); 609 return Res; 610 end Canon_Extract_Sensitivity_Process; 611 612 procedure Canon_Aggregate_Expression (Expr: Iir) 613 is 614 Assoc : Iir; 615 begin 616 Assoc := Get_Association_Choices_Chain (Expr); 617 while Assoc /= Null_Iir loop 618 case Get_Kind (Assoc) is 619 when Iir_Kind_Choice_By_Others 620 | Iir_Kind_Choice_By_None 621 | Iir_Kind_Choice_By_Name => 622 null; 623 when Iir_Kind_Choice_By_Expression => 624 Canon_Expression (Get_Choice_Expression (Assoc)); 625 when Iir_Kind_Choice_By_Range => 626 declare 627 Choice : constant Iir := Get_Choice_Range (Assoc); 628 begin 629 if Get_Kind (Choice) = Iir_Kind_Range_Expression then 630 Canon_Expression (Choice); 631 end if; 632 end; 633 when others => 634 Error_Kind ("canon_aggregate_expression", Assoc); 635 end case; 636 Canon_Expression (Get_Associated_Expr (Assoc)); 637 Assoc := Get_Chain (Assoc); 638 end loop; 639 end Canon_Aggregate_Expression; 640 641 -- canon on expressions, mainly for function calls. 642 procedure Canon_Expression (Expr: Iir) is 643 begin 644 if Expr = Null_Iir then 645 return; 646 end if; 647 case Get_Kind (Expr) is 648 when Iir_Kind_Range_Expression => 649 Canon_Expression (Get_Left_Limit (Expr)); 650 Canon_Expression (Get_Right_Limit (Expr)); 651 652 when Iir_Kind_Slice_Name => 653 declare 654 Suffix : Iir; 655 begin 656 Suffix := Strip_Denoting_Name (Get_Suffix (Expr)); 657 if Get_Kind (Suffix) /= Iir_Kind_Subtype_Declaration then 658 Canon_Expression (Suffix); 659 end if; 660 Canon_Expression (Get_Prefix (Expr)); 661 end; 662 663 when Iir_Kind_Indexed_Name => 664 Canon_Expression (Get_Prefix (Expr)); 665 declare 666 Flist : constant Iir_Flist := Get_Index_List (Expr); 667 El : Iir; 668 begin 669 for I in Flist_First .. Flist_Last (Flist) loop 670 El := Get_Nth_Element (Flist, I); 671 Canon_Expression (El); 672 end loop; 673 end; 674 675 when Iir_Kind_Selected_Element => 676 Canon_Expression (Get_Prefix (Expr)); 677 when Iir_Kind_Dereference 678 | Iir_Kind_Implicit_Dereference => 679 Canon_Expression (Get_Prefix (Expr)); 680 681 when Iir_Kinds_Denoting_Name => 682 Canon_Expression (Get_Named_Entity (Expr)); 683 684 when Iir_Kinds_Monadic_Operator => 685 Canon_Expression (Get_Operand (Expr)); 686 when Iir_Kinds_Dyadic_Operator => 687 Canon_Expression (Get_Left (Expr)); 688 Canon_Expression (Get_Right (Expr)); 689 690 when Iir_Kind_Function_Call => 691 Canon_Subprogram_Call_And_Actuals (Expr); 692 -- FIXME: 693 -- should canon concatenation. 694 695 when Iir_Kind_Parenthesis_Expression => 696 Canon_Expression (Get_Expression (Expr)); 697 when Iir_Kind_Type_Conversion 698 | Iir_Kind_Qualified_Expression => 699 Canon_Expression (Get_Expression (Expr)); 700 when Iir_Kind_Aggregate => 701 Canon_Aggregate_Expression (Expr); 702 when Iir_Kind_Allocator_By_Expression => 703 Canon_Expression (Get_Expression (Expr)); 704 when Iir_Kind_Allocator_By_Subtype => 705 declare 706 Ind : constant Iir := Get_Subtype_Indication (Expr); 707 begin 708 if Get_Kind (Ind) = Iir_Kind_Array_Subtype_Definition then 709 Canon_Subtype_Indication (Ind); 710 end if; 711 end; 712 713 when Iir_Kinds_Literal 714 | Iir_Kind_Simple_Aggregate 715 | Iir_Kind_Unit_Declaration => 716 null; 717 718 when Iir_Kinds_Array_Attribute => 719 -- No need to canon parameter, since it is a locally static 720 -- expression. 721 declare 722 Prefix : constant Iir := Get_Prefix (Expr); 723 begin 724 if Get_Kind (Prefix) in Iir_Kinds_Denoting_Name 725 and then (Get_Kind (Get_Named_Entity (Prefix)) 726 in Iir_Kinds_Type_Declaration) 727 then 728 -- No canon for types. 729 null; 730 else 731 Canon_Expression (Prefix); 732 end if; 733 end; 734 735 when Iir_Kinds_Type_Attribute => 736 null; 737 when Iir_Kind_Stable_Attribute 738 | Iir_Kind_Quiet_Attribute 739 | Iir_Kind_Delayed_Attribute 740 | Iir_Kind_Transaction_Attribute => 741 -- FIXME: add the default parameter ? 742 Canon_Expression (Get_Prefix (Expr)); 743 when Iir_Kind_Event_Attribute 744 | Iir_Kind_Last_Value_Attribute 745 | Iir_Kind_Active_Attribute 746 | Iir_Kind_Last_Event_Attribute 747 | Iir_Kind_Last_Active_Attribute 748 | Iir_Kind_Driving_Attribute 749 | Iir_Kind_Driving_Value_Attribute => 750 Canon_Expression (Get_Prefix (Expr)); 751 752 when Iir_Kinds_Scalar_Type_Attribute 753 | Iir_Kind_Image_Attribute 754 | Iir_Kind_Value_Attribute => 755 Canon_Expression (Get_Parameter (Expr)); 756 757 when Iir_Kind_Simple_Name_Attribute 758 | Iir_Kind_Path_Name_Attribute 759 | Iir_Kind_Instance_Name_Attribute => 760 null; 761 762 when Iir_Kind_Interface_Signal_Declaration 763 | Iir_Kind_Signal_Declaration 764 | Iir_Kind_Guard_Signal_Declaration 765 | Iir_Kind_Constant_Declaration 766 | Iir_Kind_Interface_Constant_Declaration 767 | Iir_Kind_Iterator_Declaration 768 | Iir_Kind_Variable_Declaration 769 | Iir_Kind_Interface_Variable_Declaration 770 | Iir_Kind_File_Declaration 771 | Iir_Kind_Interface_File_Declaration 772 | Iir_Kind_Object_Alias_Declaration 773 | Iir_Kind_Psl_Endpoint_Declaration => 774 null; 775 776 when Iir_Kind_Enumeration_Literal 777 | Iir_Kind_Overflow_Literal => 778 null; 779 780 when Iir_Kind_Element_Declaration => 781 null; 782 783 when Iir_Kind_Attribute_Value 784 | Iir_Kind_Attribute_Name => 785 null; 786 787 when others => 788 Error_Kind ("canon_expression", Expr); 789 null; 790 end case; 791 end Canon_Expression; 792 793 procedure Canon_Expression_If_Valid (Expr : Iir) is 794 begin 795 if Is_Valid (Expr) then 796 Canon_Expression (Expr); 797 end if; 798 end Canon_Expression_If_Valid; 799 800 procedure Canon_PSL_Expression (Expr : PSL_Node) 801 is 802 use PSL.Nodes; 803 begin 804 case Get_Kind (Expr) is 805 when N_HDL_Expr 806 | N_HDL_Bool => 807 Canon_Expression (Get_HDL_Node (Expr)); 808 when N_True | N_EOS => 809 null; 810 when N_Not_Bool => 811 Canon_PSL_Expression (Get_Boolean (Expr)); 812 when N_And_Bool 813 | N_Or_Bool => 814 Canon_PSL_Expression (Get_Left (Expr)); 815 Canon_PSL_Expression (Get_Right (Expr)); 816 when others => 817 Error_Kind ("canon_psl_expression", Expr); 818 end case; 819 end Canon_PSL_Expression; 820 821 procedure Canon_Discrete_Range (Rng : Iir) is 822 begin 823 case Get_Kind (Rng) is 824 when Iir_Kind_Integer_Subtype_Definition 825 | Iir_Kind_Enumeration_Subtype_Definition => 826 Canon_Expression (Get_Range_Constraint (Rng)); 827 when Iir_Kind_Enumeration_Type_Definition => 828 null; 829 when others => 830 Error_Kind ("canon_discrete_range", Rng); 831 end case; 832 end Canon_Discrete_Range; 833 834 -- Extract sensitivity of WAVEFORM. 835 procedure Extract_Waveform_Sensitivity 836 (Waveform : Iir; Sensitivity_List: Iir_List) 837 is 838 We : Iir_Waveform_Element; 839 begin 840 We := Waveform; 841 while We /= Null_Iir loop 842 Canon_Extract_Sensitivity_Expression 843 (Get_We_Value (We), Sensitivity_List, False); 844 We := Get_Chain (We); 845 end loop; 846 end Extract_Waveform_Sensitivity; 847 848 -- Canon expression of WAVEFORM. 849 procedure Canon_Waveform_Expression (Waveform : Iir) 850 is 851 We : Iir_Waveform_Element; 852 begin 853 if Get_Kind (Waveform) = Iir_Kind_Unaffected_Waveform then 854 pragma Assert (Get_Chain (Waveform) = Null_Iir); 855 return; 856 end if; 857 858 We := Waveform; 859 while We /= Null_Iir loop 860 Canon_Expression (Get_We_Value (We)); 861 if Get_Time (We) /= Null_Iir then 862 Canon_Expression (Get_Time (We)); 863 end if; 864 We := Get_Chain (We); 865 end loop; 866 end Canon_Waveform_Expression; 867 868 -- Names associations by position, 869 -- reorder associations by name, 870 -- create omitted association, 871 function Canon_Association_Chain 872 (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) 873 return Iir 874 is 875 -- The canon list of association. 876 N_Chain, Last : Iir; 877 Inter : Iir; 878 Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; 879 Formal : Iir; 880 Assoc_Chain : Iir; 881 882 Found : Boolean; 883 begin 884 if not Canon_Flag_Associations then 885 return Association_Chain; 886 end if; 887 888 -- No argument, so return now. 889 if Interface_Chain = Null_Iir then 890 pragma Assert (Association_Chain = Null_Iir); 891 return Null_Iir; 892 end if; 893 894 Chain_Init (N_Chain, Last); 895 Assoc_Chain := Association_Chain; 896 897 -- Reorder the list of association in the interface order. 898 -- Add missing associations. 899 Inter := Interface_Chain; 900 while Inter /= Null_Iir loop 901 -- Search associations with INTERFACE. 902 Found := False; 903 Assoc_El := Assoc_Chain; 904 Prev_Assoc_El := Null_Iir; 905 while Assoc_El /= Null_Iir loop 906 Next_Assoc_El := Get_Chain (Assoc_El); 907 908 Formal := Get_Formal (Assoc_El); 909 if Formal = Null_Iir then 910 Formal := Inter; 911 if Canon_Flag_Set_Assoc_Formals then 912 Set_Formal (Assoc_El, Inter); 913 end if; 914 else 915 Formal := Get_Interface_Of_Formal (Formal); 916 end if; 917 918 if Formal = Inter then 919 920 -- Remove ASSOC_EL from ASSOC_CHAIN 921 if Prev_Assoc_El /= Null_Iir then 922 Set_Chain (Prev_Assoc_El, Next_Assoc_El); 923 else 924 Assoc_Chain := Next_Assoc_El; 925 end if; 926 927 -- Append ASSOC_EL in N_CHAIN. 928 Set_Chain (Assoc_El, Null_Iir); 929 Chain_Append (N_Chain, Last, Assoc_El); 930 931 case Get_Kind (Assoc_El) is 932 when Iir_Kind_Association_Element_Open => 933 goto Done; 934 when Iir_Kind_Association_Element_By_Expression => 935 if Get_Whole_Association_Flag (Assoc_El) then 936 goto Done; 937 end if; 938 when Iir_Kind_Association_Element_By_Individual => 939 Found := True; 940 when Iir_Kind_Association_Element_Package 941 | Iir_Kind_Association_Element_Type 942 | Iir_Kind_Association_Element_Subprogram 943 | Iir_Kind_Association_Element_Terminal => 944 goto Done; 945 when others => 946 Error_Kind ("canon_association_chain", Assoc_El); 947 end case; 948 elsif Found then 949 -- No more associations. 950 goto Done; 951 else 952 Prev_Assoc_El := Assoc_El; 953 end if; 954 Assoc_El := Next_Assoc_El; 955 end loop; 956 if Found then 957 goto Done; 958 end if; 959 960 -- No association, use default expr. 961 Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open); 962 Set_Artificial_Flag (Assoc_El, True); 963 Set_Whole_Association_Flag (Assoc_El, True); 964 Location_Copy (Assoc_El, Loc); 965 966 if Canon_Flag_Set_Assoc_Formals then 967 Set_Formal (Assoc_El, Inter); 968 end if; 969 970 Chain_Append (N_Chain, Last, Assoc_El); 971 972 << Done >> null; 973 Inter := Get_Chain (Inter); 974 end loop; 975 pragma Assert (Assoc_Chain = Null_Iir); 976 977 return N_Chain; 978 end Canon_Association_Chain; 979 980 procedure Canon_Association_Chain_Actuals (Association_Chain : Iir) 981 is 982 Assoc_El : Iir; 983 begin 984 -- Canon actuals. 985 Assoc_El := Association_Chain; 986 while Assoc_El /= Null_Iir loop 987 if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_By_Expression 988 then 989 Canon_Expression (Get_Actual (Assoc_El)); 990 end if; 991 Assoc_El := Get_Chain (Assoc_El); 992 end loop; 993 end Canon_Association_Chain_Actuals; 994 995 function Canon_Association_Chain_And_Actuals 996 (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) 997 return Iir 998 is 999 Res : Iir; 1000 begin 1001 Res := Canon_Association_Chain (Interface_Chain, Association_Chain, Loc); 1002 if Canon_Flag_Expressions then 1003 Canon_Association_Chain_Actuals (Res); 1004 end if; 1005 return Res; 1006 end Canon_Association_Chain_And_Actuals; 1007 1008 procedure Canon_Subprogram_Call (Call : Iir) 1009 is 1010 Imp : constant Iir := Get_Implementation (Call); 1011 Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp); 1012 Assoc_Chain : Iir; 1013 begin 1014 Assoc_Chain := Get_Parameter_Association_Chain (Call); 1015 Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call); 1016 Set_Parameter_Association_Chain (Call, Assoc_Chain); 1017 end Canon_Subprogram_Call; 1018 1019 procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is 1020 begin 1021 Canon_Subprogram_Call (Call); 1022 if Canon_Flag_Expressions then 1023 Canon_Association_Chain_Actuals 1024 (Get_Parameter_Association_Chain (Call)); 1025 end if; 1026 end Canon_Subprogram_Call_And_Actuals; 1027 1028 -- Create a default association list for INTERFACE_LIST. 1029 -- The default is a list of interfaces associated with open. 1030 function Canon_Default_Association_Chain (Interface_Chain : Iir) 1031 return Iir 1032 is 1033 Res : Iir; 1034 Last : Iir; 1035 Assoc, El : Iir; 1036 begin 1037 if not Canon_Flag_Associations then 1038 return Null_Iir; 1039 end if; 1040 1041 El := Interface_Chain; 1042 Chain_Init (Res, Last); 1043 while El /= Null_Iir loop 1044 Assoc := Create_Iir (Iir_Kind_Association_Element_Open); 1045 Set_Whole_Association_Flag (Assoc, True); 1046 Set_Artificial_Flag (Assoc, True); 1047 if Canon_Flag_Set_Assoc_Formals then 1048 Set_Formal (Assoc, El); 1049 end if; 1050 Location_Copy (Assoc, El); 1051 Chain_Append (Res, Last, Assoc); 1052 El := Get_Chain (El); 1053 end loop; 1054 return Res; 1055 end Canon_Default_Association_Chain; 1056 1057 function Canon_Conditional_Variable_Assignment_Statement (Stmt : Iir) 1058 return Iir 1059 is 1060 Target : constant Iir := Get_Target (Stmt); 1061 Cond_Expr : Iir; 1062 Expr : Iir; 1063 Asgn : Iir; 1064 Res : Iir; 1065 El, N_El : Iir; 1066 begin 1067 Cond_Expr := Get_Conditional_Expression_Chain (Stmt); 1068 Res := Create_Iir (Iir_Kind_If_Statement); 1069 Set_Label (Res, Get_Label (Stmt)); 1070 Set_Suspend_Flag (Res, False); 1071 El := Res; 1072 1073 loop 1074 -- Fill if/elsif statement. 1075 Set_Parent (El, Get_Parent (Stmt)); 1076 Location_Copy (El, Cond_Expr); 1077 Set_Condition (El, Get_Condition (Cond_Expr)); 1078 1079 -- Create simple variable assignment. 1080 Asgn := Create_Iir (Iir_Kind_Variable_Assignment_Statement); 1081 Location_Copy (Asgn, Cond_Expr); 1082 Set_Parent (Asgn, Res); 1083 Set_Target (Asgn, Target); 1084 Expr := Get_Expression (Cond_Expr); 1085 if Canon_Flag_Expressions then 1086 Canon_Expression (Expr); 1087 end if; 1088 Set_Expression (Asgn, Expr); 1089 1090 Set_Sequential_Statement_Chain (El, Asgn); 1091 1092 -- Next condition. 1093 Cond_Expr := Get_Chain (Cond_Expr); 1094 exit when Cond_Expr = Null_Iir; 1095 1096 N_El := Create_Iir (Iir_Kind_Elsif); 1097 Set_Else_Clause (El, N_El); 1098 El := N_El; 1099 end loop; 1100 1101 return Res; 1102 end Canon_Conditional_Variable_Assignment_Statement; 1103 1104 function Canon_Conditional_Signal_Assignment_Statement (Stmt : Iir) 1105 return Iir is 1106 begin 1107 return Canon_Conditional_Signal_Assignment 1108 (Stmt, Null_Iir, Get_Parent (Stmt), False); 1109 end Canon_Conditional_Signal_Assignment_Statement; 1110 1111 -- Inner loop if any; used to canonicalize exit/next statement. 1112 Cur_Loop : Iir; 1113 1114 function Canon_Sequential_Stmts (First : Iir) return Iir 1115 is 1116 Stmt: Iir; 1117 N_Stmt : Iir; 1118 Res, Last : Iir; 1119 begin 1120 Chain_Init (Res, Last); 1121 1122 Stmt := First; 1123 while Stmt /= Null_Iir loop 1124 1125 -- Keep the same statement by default. 1126 N_Stmt := Stmt; 1127 1128 case Get_Kind (Stmt) is 1129 when Iir_Kind_If_Statement => 1130 declare 1131 Cond: Iir; 1132 Clause: Iir; 1133 Stmts : Iir; 1134 begin 1135 Clause := Stmt; 1136 while Clause /= Null_Iir loop 1137 Cond := Get_Condition (Clause); 1138 Canon_Expression_If_Valid (Cond); 1139 Stmts := Get_Sequential_Statement_Chain (Clause); 1140 Stmts := Canon_Sequential_Stmts (Stmts); 1141 Set_Sequential_Statement_Chain (Clause, Stmts); 1142 Clause := Get_Else_Clause (Clause); 1143 end loop; 1144 end; 1145 1146 when Iir_Kind_Simple_Signal_Assignment_Statement => 1147 Canon_Expression (Get_Target (Stmt)); 1148 Canon_Waveform_Expression (Get_Waveform_Chain (Stmt)); 1149 1150 when Iir_Kind_Conditional_Signal_Assignment_Statement => 1151 Canon_Conditional_Signal_Assignment_Expression (Stmt); 1152 N_Stmt := Canon_Conditional_Signal_Assignment_Statement (Stmt); 1153 1154 when Iir_Kind_Variable_Assignment_Statement => 1155 Canon_Expression (Get_Target (Stmt)); 1156 Canon_Expression (Get_Expression (Stmt)); 1157 1158 when Iir_Kind_Conditional_Variable_Assignment_Statement => 1159 N_Stmt := 1160 Canon_Conditional_Variable_Assignment_Statement (Stmt); 1161 1162 when Iir_Kind_Wait_Statement => 1163 declare 1164 List : Iir_List; 1165 Expr : Iir; 1166 begin 1167 Canon_Expression_If_Valid (Get_Timeout_Clause (Stmt)); 1168 Expr := Get_Condition_Clause (Stmt); 1169 Canon_Expression_If_Valid (Expr); 1170 List := Get_Sensitivity_List (Stmt); 1171 if List = Null_Iir_List and then Expr /= Null_Iir then 1172 List := Create_Iir_List; 1173 Canon_Extract_Sensitivity_Expression (Expr, List, False); 1174 Set_Sensitivity_List (Stmt, List); 1175 end if; 1176 end; 1177 1178 when Iir_Kind_Case_Statement => 1179 Canon_Expression (Get_Expression (Stmt)); 1180 declare 1181 Choice: Iir; 1182 Stmts : Iir; 1183 begin 1184 Choice := Get_Case_Statement_Alternative_Chain (Stmt); 1185 while Choice /= Null_Iir loop 1186 -- FIXME: canon choice expr. 1187 Stmts := Get_Associated_Chain (Choice); 1188 Stmts := Canon_Sequential_Stmts (Stmts); 1189 Set_Associated_Chain (Choice, Stmts); 1190 Choice := Get_Chain (Choice); 1191 end loop; 1192 end; 1193 1194 when Iir_Kind_Assertion_Statement 1195 | Iir_Kind_Report_Statement => 1196 if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then 1197 Canon_Expression (Get_Assertion_Condition (Stmt)); 1198 end if; 1199 Canon_Expression_If_Valid (Get_Report_Expression (Stmt)); 1200 Canon_Expression_If_Valid (Get_Severity_Expression (Stmt)); 1201 1202 when Iir_Kind_For_Loop_Statement => 1203 declare 1204 Prev_Loop : constant Iir := Cur_Loop; 1205 Stmts : Iir; 1206 begin 1207 -- FIXME: decl. 1208 Cur_Loop := Stmt; 1209 if Canon_Flag_Expressions then 1210 Canon_Discrete_Range 1211 (Get_Type (Get_Parameter_Specification (Stmt))); 1212 end if; 1213 Stmts := Get_Sequential_Statement_Chain (Stmt); 1214 Stmts := Canon_Sequential_Stmts (Stmts); 1215 Set_Sequential_Statement_Chain (Stmt, Stmts); 1216 Cur_Loop := Prev_Loop; 1217 end; 1218 1219 when Iir_Kind_While_Loop_Statement => 1220 declare 1221 Stmts : Iir; 1222 Prev_Loop : Iir; 1223 begin 1224 Canon_Expression_If_Valid (Get_Condition (Stmt)); 1225 Prev_Loop := Cur_Loop; 1226 Cur_Loop := Stmt; 1227 Stmts := Get_Sequential_Statement_Chain (Stmt); 1228 Stmts := Canon_Sequential_Stmts (Stmts); 1229 Set_Sequential_Statement_Chain (Stmt, Stmts); 1230 Cur_Loop := Prev_Loop; 1231 end; 1232 1233 when Iir_Kind_Next_Statement 1234 | Iir_Kind_Exit_Statement => 1235 declare 1236 Loop_Label : Iir; 1237 begin 1238 Canon_Expression_If_Valid (Get_Condition (Stmt)); 1239 Loop_Label := Get_Loop_Label (Stmt); 1240 if Loop_Label = Null_Iir then 1241 Set_Loop_Label (Stmt, Build_Simple_Name (Cur_Loop, Stmt)); 1242 end if; 1243 end; 1244 1245 when Iir_Kind_Procedure_Call_Statement => 1246 Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt)); 1247 1248 when Iir_Kind_Null_Statement => 1249 null; 1250 1251 when Iir_Kind_Return_Statement => 1252 Canon_Expression (Get_Expression (Stmt)); 1253 1254 when others => 1255 Error_Kind ("canon_sequential_stmts", Stmt); 1256 end case; 1257 1258 Chain_Append (Res, Last, N_Stmt); 1259 1260 Stmt := Get_Chain (Stmt); 1261 end loop; 1262 1263 return Res; 1264 end Canon_Sequential_Stmts; 1265 1266 -- Create a statement transform from concurrent_signal_assignment 1267 -- statement STMT (either selected or conditional). 1268 -- waveform transformation is not done. 1269 -- PROC is the process created. 1270 -- PARENT is the place where signal assignment must be placed. This may 1271 -- be PROC, or an 'if' statement if the assignment is guarded. 1272 -- See LRM93 9.5 1273 procedure Canon_Concurrent_Signal_Assignment 1274 (Stmt: Iir; 1275 Proc: out Iir_Sensitized_Process_Statement; 1276 Chain : out Iir) 1277 is 1278 If_Stmt: Iir; 1279 Sensitivity_List : Iir_List; 1280 begin 1281 Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); 1282 Location_Copy (Proc, Stmt); 1283 Set_Parent (Proc, Get_Parent (Stmt)); 1284 Set_Chain (Proc, Get_Chain (Stmt)); 1285 Sensitivity_List := Create_Iir_List; 1286 Set_Sensitivity_List (Proc, Sensitivity_List); 1287 Set_Is_Ref (Proc, True); 1288 Set_Process_Origin (Proc, Stmt); 1289 1290 -- LRM93 9.5 1291 -- 1. If a label appears on the concurrent signal assignment, then the 1292 -- same label appears on the process statement. 1293 Set_Label (Proc, Get_Label (Stmt)); 1294 1295 -- LRM93 9.5 1296 -- 2. The equivalent process statement is a postponed process if and 1297 -- only if the current signal assignment statement includes the 1298 -- reserved word POSTPONED. 1299 Set_Postponed_Flag (Proc, Get_Postponed_Flag (Proc)); 1300 1301 Canon_Extract_Sensitivity_Expression 1302 (Get_Target (Stmt), Sensitivity_List, True); 1303 1304 if Get_Guard (Stmt) /= Null_Iir then 1305 -- LRM93 9.1 1306 -- If the option guarded appears in the concurrent signal assignment 1307 -- statement, then the concurrent signal assignment is called a 1308 -- guarded assignment. 1309 -- If the concurrent signal assignement statement is a guarded 1310 -- assignment and the target of the concurrent signal assignment is 1311 -- a guarded target, then the statement transform is as follow: 1312 -- if GUARD then 1313 -- signal_transform 1314 -- else 1315 -- disconnect_statements 1316 -- end if; 1317 -- Otherwise, if the concurrent signal assignment statement is a 1318 -- guarded assignement, but the target if the concurrent signal 1319 -- assignment is not a guarded target, the then statement transform 1320 -- is as follows: 1321 -- if GUARD then signal_transform end if; 1322 If_Stmt := Create_Iir (Iir_Kind_If_Statement); 1323 Set_Parent (If_Stmt, Proc); 1324 Set_Sequential_Statement_Chain (Proc, If_Stmt); 1325 Location_Copy (If_Stmt, Stmt); 1326 Canon_Extract_Sensitivity_Expression 1327 (Get_Guard (Stmt), Sensitivity_List, False); 1328 Set_Condition (If_Stmt, Get_Guard (Stmt)); 1329 Set_Is_Ref (If_Stmt, True); 1330 Chain := If_Stmt; 1331 1332 declare 1333 Target : Iir; 1334 Else_Clause : Iir_Elsif; 1335 Dis_Stmt : Iir_Signal_Assignment_Statement; 1336 begin 1337 Target := Get_Target (Stmt); 1338 if Get_Guarded_Target_State (Stmt) = True then 1339 -- The target is a guarded target. 1340 -- create the disconnection statement. 1341 Else_Clause := Create_Iir (Iir_Kind_Elsif); 1342 Location_Copy (Else_Clause, Stmt); 1343 Set_Else_Clause (If_Stmt, Else_Clause); 1344 Dis_Stmt := 1345 Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); 1346 Location_Copy (Dis_Stmt, Stmt); 1347 Set_Parent (Dis_Stmt, If_Stmt); 1348 Set_Target (Dis_Stmt, Target); 1349 Set_Is_Ref (Dis_Stmt, True); 1350 Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt); 1351 -- XX 1352 Set_Waveform_Chain (Dis_Stmt, Null_Iir); 1353 end if; 1354 end; 1355 else 1356 -- LRM93 9.1 1357 -- Finally, if the concurrent signal assignment statement is not a 1358 -- guarded assignment, and the traget of the concurrent signal 1359 -- assignment is not a guarded target, then the statement transform 1360 -- is as follows: 1361 -- signal_transform 1362 Chain := Proc; 1363 end if; 1364 end Canon_Concurrent_Signal_Assignment; 1365 1366 function Canon_Concurrent_Procedure_Call (Conc_Stmt : Iir) 1367 return Iir_Sensitized_Process_Statement 1368 is 1369 Call : constant Iir_Procedure_Call := Get_Procedure_Call (Conc_Stmt); 1370 Imp : constant Iir := Get_Implementation (Call); 1371 Proc : Iir_Sensitized_Process_Statement; 1372 Call_Stmt : Iir_Procedure_Call_Statement; 1373 Wait_Stmt : Iir_Wait_Statement; 1374 Sensitivity_List : Iir_List; 1375 Is_Sensitized : Boolean; 1376 begin 1377 -- Optimization: the process is a sensitized process only if the 1378 -- procedure is known not to have wait statement. This is possible only 1379 -- when generating code at once for the whole design, otherwise this 1380 -- may create discrepencies in translate structures due to states. 1381 Is_Sensitized := 1382 (Get_Wait_State (Imp) = False) and Flags.Flag_Whole_Analyze; 1383 1384 -- LRM93 9.3 1385 -- The equivalent process statement has also no sensitivity list, an 1386 -- empty declarative part, and a statement part that consists of a 1387 -- procedure call statement followed by a wait statement. 1388 if Is_Sensitized then 1389 Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); 1390 else 1391 Proc := Create_Iir (Iir_Kind_Process_Statement); 1392 end if; 1393 Location_Copy (Proc, Conc_Stmt); 1394 Set_Parent (Proc, Get_Parent (Conc_Stmt)); 1395 Set_Chain (Proc, Get_Chain (Conc_Stmt)); 1396 Set_Process_Origin (Proc, Conc_Stmt); 1397 Set_Procedure_Call (Conc_Stmt, Null_Iir); 1398 1399 -- LRM93 9.3 1400 -- The equivalent process statement has a label if and only if the 1401 -- concurrent procedure call statement has a label; if the equivalent 1402 -- process statement has a label, it is the same as that of the 1403 -- concurrent procedure call statement. 1404 Set_Label (Proc, Get_Label (Conc_Stmt)); 1405 1406 -- LRM93 9.3 1407 -- The equivalent process statement is a postponed process if and only 1408 -- if the concurrent procedure call statement includes the reserved 1409 -- word POSTPONED. 1410 Set_Postponed_Flag (Proc, Get_Postponed_Flag (Conc_Stmt)); 1411 1412 Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); 1413 Set_Sequential_Statement_Chain (Proc, Call_Stmt); 1414 Location_Copy (Call_Stmt, Conc_Stmt); 1415 Set_Parent (Call_Stmt, Proc); 1416 Set_Procedure_Call (Call_Stmt, Call); 1417 1418 -- LRM93 9.3 1419 -- If there exists a name that denotes a signal in the actual part of 1420 -- any association element in the concurrent procedure call statement, 1421 -- and that actual is associated with a formal parameter of mode IN or 1422 -- INOUT, then the equivalent process statement includes a final wait 1423 -- statement with a sensitivity clause that is constructed by taking 1424 -- the union of the sets constructed by applying th rule of Section 8.1 1425 -- to each actual part associated with a formal parameter. 1426 Sensitivity_List := Create_Iir_List; 1427 Canon_Extract_Sensitivity_Procedure_Call (Sensitivity_List, Call); 1428 if Is_Sensitized then 1429 Set_Sensitivity_List (Proc, Sensitivity_List); 1430 Set_Is_Ref (Proc, True); 1431 else 1432 Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); 1433 Location_Copy (Wait_Stmt, Conc_Stmt); 1434 Set_Parent (Wait_Stmt, Proc); 1435 Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); 1436 Set_Is_Ref (Wait_Stmt, True); 1437 Set_Chain (Call_Stmt, Wait_Stmt); 1438 end if; 1439 return Proc; 1440 end Canon_Concurrent_Procedure_Call; 1441 1442 -- Return a statement from a waveform. 1443 function Canon_Wave_Transform (Orig_Stmt : Iir; 1444 Waveform_Chain : Iir_Waveform_Element; 1445 Proc : Iir; 1446 Is_First : Boolean) 1447 return Iir 1448 is 1449 Stmt : Iir; 1450 Sensitivity_List : Iir_List; 1451 begin 1452 if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then 1453 -- LRM 9.5.1 Conditionnal Signal Assignment 1454 -- If the waveform is of the form: 1455 -- UNAFFECTED 1456 -- then the wave transform in the corresponding process statement 1457 -- is of the form: 1458 -- NULL; 1459 -- In this example, the final NULL causes the driver to be unchanged, 1460 -- rather than disconnected. 1461 -- (This is the null statement not a null waveform element). 1462 Stmt := Create_Iir (Iir_Kind_Null_Statement); 1463 else 1464 -- LRM 9.5.1 Conditionnal Signal Assignment 1465 -- If the waveform is of the form: 1466 -- waveform_element1, waveform_element1, ..., waveform_elementN 1467 -- then the wave transform in the corresponding process statement is 1468 -- of the form: 1469 -- target <= [ delay_mechanism ] waveform_element1, 1470 -- waveform_element2, ..., waveform_elementN; 1471 Stmt := Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); 1472 Set_Target (Stmt, Get_Target (Orig_Stmt)); 1473 if not Is_First then 1474 Set_Is_Ref (Stmt, True); 1475 end if; 1476 if Proc /= Null_Iir then 1477 Sensitivity_List := Get_Sensitivity_List (Proc); 1478 Extract_Waveform_Sensitivity (Waveform_Chain, Sensitivity_List); 1479 end if; 1480 Set_Waveform_Chain (Stmt, Waveform_Chain); 1481 Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt)); 1482 Set_Reject_Time_Expression 1483 (Stmt, Get_Reject_Time_Expression (Orig_Stmt)); 1484 Set_Reject_Time_Expression (Orig_Stmt, Null_Iir); 1485 end if; 1486 Location_Copy (Stmt, Orig_Stmt); 1487 return Stmt; 1488 end Canon_Wave_Transform; 1489 1490 -- Create signal_transform for a concurrent simple signal assignment. 1491 procedure Canon_Concurrent_Simple_Signal_Assignment 1492 (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) 1493 is 1494 Stmt : Iir; 1495 begin 1496 Stmt := Canon_Wave_Transform 1497 (Conc_Stmt, Get_Waveform_Chain (Conc_Stmt), Proc, True); 1498 Set_Waveform_Chain (Conc_Stmt, Null_Iir); 1499 Set_Target (Conc_Stmt, Null_Iir); 1500 Set_Parent (Stmt, Parent); 1501 Set_Sequential_Statement_Chain (Parent, Stmt); 1502 end Canon_Concurrent_Simple_Signal_Assignment; 1503 1504 procedure Canon_Conditional_Signal_Assignment_Expression (Stmt : Iir) 1505 is 1506 Cond_Wf : Iir_Conditional_Waveform; 1507 begin 1508 Cond_Wf := Get_Conditional_Waveform_Chain (Stmt); 1509 while Cond_Wf /= Null_Iir loop 1510 Canon_Expression_If_Valid (Get_Condition (Cond_Wf)); 1511 Canon_Waveform_Expression (Get_Waveform_Chain (Cond_Wf)); 1512 1513 Cond_Wf := Get_Chain (Cond_Wf); 1514 end loop; 1515 end Canon_Conditional_Signal_Assignment_Expression; 1516 1517 -- Create signal_transform for a concurrent conditional signal assignment. 1518 function Canon_Conditional_Signal_Assignment 1519 (Conc_Stmt : Iir; Proc : Iir; Parent : Iir; Clear : Boolean) return Iir 1520 is 1521 Expr : Iir; 1522 Stmt : Iir; 1523 Res1 : Iir; 1524 Last_Res : Iir; 1525 Wf : Iir; 1526 Cond_Wf : Iir_Conditional_Waveform; 1527 Cond_Wf_Chain : Iir_Conditional_Waveform; 1528 begin 1529 Cond_Wf_Chain := Get_Conditional_Waveform_Chain (Conc_Stmt); 1530 Stmt := Null_Iir; 1531 Cond_Wf := Cond_Wf_Chain; 1532 Last_Res := Null_Iir; 1533 1534 while Cond_Wf /= Null_Iir loop 1535 Expr := Get_Condition (Cond_Wf); 1536 1537 -- Canon waveform. 1538 Wf := Get_Waveform_Chain (Cond_Wf); 1539 Wf := Canon_Wave_Transform 1540 (Conc_Stmt, Wf, Proc, False); -- Cond_Wf = Cond_Wf_Chain); 1541 1542 if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then 1543 -- A conditional assignment that is in fact a simple one. Usual 1544 -- case for concurrent signal assignment in vhdl 93. 1545 pragma Assert (Get_Chain (Cond_Wf) = Null_Iir); 1546 1547 Set_Parent (Wf, Parent); 1548 Res1 := Wf; 1549 Stmt := Res1; 1550 else 1551 -- A real conditional signal assignment. 1552 1553 -- Canon condition (if any). 1554 if Expr /= Null_Iir then 1555 if Proc /= Null_Iir then 1556 Canon_Extract_Sensitivity_Expression 1557 (Expr, Get_Sensitivity_List (Proc), False); 1558 end if; 1559 end if; 1560 if Stmt = Null_Iir then 1561 Res1 := Create_Iir (Iir_Kind_If_Statement); 1562 Set_Parent (Res1, Parent); 1563 Stmt := Res1; 1564 else 1565 Res1 := Create_Iir (Iir_Kind_Elsif); 1566 Set_Else_Clause (Last_Res, Res1); 1567 end if; 1568 Location_Copy (Res1, Cond_Wf); 1569 Set_Condition (Res1, Expr); 1570 Set_Sequential_Statement_Chain (Res1, Wf); 1571 Set_Parent (Wf, Stmt); 1572 Last_Res := Res1; 1573 end if; 1574 1575 if Clear then 1576 Set_Condition (Cond_Wf, Null_Iir); 1577 Set_Waveform_Chain (Cond_Wf, Null_Iir); 1578 end if; 1579 1580 Cond_Wf := Get_Chain (Cond_Wf); 1581 end loop; 1582 1583 return Stmt; 1584 end Canon_Conditional_Signal_Assignment; 1585 1586 -- Create signal_transform for a concurrent conditional signal assignment. 1587 procedure Canon_Concurrent_Conditional_Signal_Assignment 1588 (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) 1589 is 1590 Stmt : Iir; 1591 begin 1592 Stmt := Canon_Conditional_Signal_Assignment 1593 (Conc_Stmt, Proc, Parent, True); 1594 Set_Sequential_Statement_Chain (Parent, Stmt); 1595 end Canon_Concurrent_Conditional_Signal_Assignment; 1596 1597 procedure Canon_Selected_Signal_Assignment_Expression (Stmt : Iir) 1598 is 1599 Selected_Waveform : Iir; 1600 Waveform : Iir; 1601 begin 1602 Canon_Expression (Get_Expression (Stmt)); 1603 1604 Selected_Waveform := Get_Selected_Waveform_Chain (Stmt); 1605 while Selected_Waveform /= Null_Iir loop 1606 Waveform := Get_Associated_Chain (Selected_Waveform); 1607 if Waveform /= Null_Iir then 1608 Canon_Waveform_Expression (Waveform); 1609 end if; 1610 Selected_Waveform := Get_Chain (Selected_Waveform); 1611 end loop; 1612 end Canon_Selected_Signal_Assignment_Expression; 1613 1614 procedure Canon_Concurrent_Selected_Signal_Assignment 1615 (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) 1616 is 1617 Sensitivity_List : constant Iir_List := Get_Sensitivity_List (Proc); 1618 Expr : constant Iir := Get_Expression (Conc_Stmt); 1619 Selected_Waveform_Chain : constant Iir := 1620 Get_Selected_Waveform_Chain (Conc_Stmt); 1621 Target : constant Iir := Get_Target (Conc_Stmt); 1622 Reject_Time : constant Iir := Get_Reject_Time_Expression (Conc_Stmt); 1623 Selected_Waveform : Iir; 1624 Case_Stmt: Iir_Case_Statement; 1625 Stmt : Iir; 1626 Waveform : Iir; 1627 begin 1628 Canon_Extract_Sensitivity_Expression (Expr, Sensitivity_List, False); 1629 1630 if Vhdl_Std < Vhdl_08 then 1631 Case_Stmt := Create_Iir (Iir_Kind_Case_Statement); 1632 Set_Parent (Case_Stmt, Parent); 1633 Set_Sequential_Statement_Chain (Parent, Case_Stmt); 1634 Location_Copy (Case_Stmt, Conc_Stmt); 1635 1636 Set_Expression (Case_Stmt, Expr); 1637 1638 Set_Case_Statement_Alternative_Chain 1639 (Case_Stmt, Selected_Waveform_Chain); 1640 1641 Selected_Waveform := Selected_Waveform_Chain; 1642 while Selected_Waveform /= Null_Iir loop 1643 Set_Parent (Selected_Waveform, Case_Stmt); 1644 Waveform := Get_Associated_Chain (Selected_Waveform); 1645 if Waveform /= Null_Iir then 1646 Stmt := Canon_Wave_Transform 1647 (Conc_Stmt, Waveform, Proc, 1648 Selected_Waveform = Selected_Waveform_Chain); 1649 Set_Parent (Stmt, Case_Stmt); 1650 Set_Associated_Chain (Selected_Waveform, Stmt); 1651 end if; 1652 Selected_Waveform := Get_Chain (Selected_Waveform); 1653 end loop; 1654 else 1655 Stmt := Create_Iir (Iir_Kind_Selected_Waveform_Assignment_Statement); 1656 Set_Parent (Stmt, Parent); 1657 Set_Sequential_Statement_Chain (Parent, Stmt); 1658 Location_Copy (Stmt, Conc_Stmt); 1659 1660 Set_Expression (Stmt, Expr); 1661 1662 Set_Target (Stmt, Target); 1663 Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Conc_Stmt)); 1664 Set_Reject_Time_Expression (Stmt, Reject_Time); 1665 1666 Set_Selected_Waveform_Chain (Stmt, Selected_Waveform_Chain); 1667 Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); 1668 Selected_Waveform := Selected_Waveform_Chain; 1669 while Selected_Waveform /= Null_Iir loop 1670 Waveform := Get_Associated_Chain (Selected_Waveform); 1671 Set_Parent (Selected_Waveform, Stmt); 1672 if Waveform /= Null_Iir then 1673 Extract_Waveform_Sensitivity (Waveform, Sensitivity_List); 1674 end if; 1675 Selected_Waveform := Get_Chain (Selected_Waveform); 1676 end loop; 1677 end if; 1678 1679 -- Transfer ownership. 1680 Set_Expression (Conc_Stmt, Null_Iir); 1681 Set_Target (Conc_Stmt, Null_Iir); 1682 Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); 1683 Set_Reject_Time_Expression (Conc_Stmt, Null_Iir); 1684 end Canon_Concurrent_Selected_Signal_Assignment; 1685 1686 procedure Canon_Generate_Statement_Body 1687 (Top : Iir_Design_Unit; Bod : Iir) is 1688 begin 1689 Canon_Declarations (Top, Bod, Bod); 1690 Canon_Concurrent_Stmts (Top, Bod); 1691 end Canon_Generate_Statement_Body; 1692 1693 -- Return TRUE iff NFA has an edge with an EOS. 1694 -- If so, we need to create a finalizer. 1695 function Psl_Need_Finalizer (Nfa : PSL_NFA) return Boolean 1696 is 1697 use PSL.NFAs; 1698 S : NFA_State; 1699 E : NFA_Edge; 1700 begin 1701 S := Get_Final_State (Nfa); 1702 E := Get_First_Dest_Edge (S); 1703 while E /= No_Edge loop 1704 if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then 1705 return True; 1706 end if; 1707 E := Get_Next_Dest_Edge (E); 1708 end loop; 1709 return False; 1710 end Psl_Need_Finalizer; 1711 1712 -- Size the NFA and extract clock sensitivity. 1713 procedure Canon_Psl_Clocked_NFA (Stmt : Iir) 1714 is 1715 Fa : constant PSL_NFA := Get_PSL_NFA (Stmt); 1716 Num : Natural; 1717 List : Iir_List; 1718 begin 1719 PSL.NFAs.Labelize_States (Fa, Num); 1720 Set_PSL_Nbr_States (Stmt, Int32 (Num)); 1721 1722 Set_PSL_EOS_Flag (Stmt, Psl_Need_Finalizer (Fa)); 1723 1724 List := Create_Iir_List; 1725 Canon_PSL.Canon_Extract_Sensitivity (Get_PSL_Clock (Stmt), List); 1726 Set_PSL_Clock_Sensitivity (Stmt, List); 1727 end Canon_Psl_Clocked_NFA; 1728 1729 procedure Canon_Psl_Property_Directive (Stmt : Iir) 1730 is 1731 Prop : PSL_Node; 1732 Fa : PSL_NFA; 1733 begin 1734 Prop := Get_Psl_Property (Stmt); 1735 Prop := PSL.Rewrites.Rewrite_Property (Prop); 1736 Set_Psl_Property (Stmt, Prop); 1737 1738 -- Generate the NFA. 1739 Fa := PSL.Build.Build_FA (Prop); 1740 Set_PSL_NFA (Stmt, Fa); 1741 1742 Canon_Psl_Clocked_NFA (Stmt); 1743 if Canon_Flag_Expressions then 1744 Canon_PSL_Expression (Get_PSL_Clock (Stmt)); 1745 end if; 1746 end Canon_Psl_Property_Directive; 1747 1748 procedure Canon_Psl_Sequence_Directive (Stmt : Iir) 1749 is 1750 Seq : PSL_Node; 1751 Fa : PSL_NFA; 1752 begin 1753 Seq := Get_Psl_Sequence (Stmt); 1754 Seq := PSL.Rewrites.Rewrite_SERE (Seq); 1755 Set_Psl_Sequence (Stmt, Seq); 1756 1757 -- Generate the NFA. 1758 Fa := PSL.Build.Build_SERE_FA (Seq); 1759 1760 -- IEEE1850-2005 PSL 7.1.6 1761 -- cover {r} is semantically equivalent to cover {[*]; r}. That is, 1762 -- there is an implicit [*] starting the sequence. 1763 if Get_Kind (Stmt) = Iir_Kind_Psl_Cover_Directive then 1764 PSL.NFAs.Utils.Set_Init_Loop (Fa); 1765 end if; 1766 Set_PSL_NFA (Stmt, Fa); 1767 1768 Canon_Psl_Clocked_NFA (Stmt); 1769 if Canon_Flag_Expressions then 1770 Canon_PSL_Expression (Get_PSL_Clock (Stmt)); 1771 end if; 1772 end Canon_Psl_Sequence_Directive; 1773 1774 procedure Canon_Psl_Assert_Directive (Stmt : Iir) is 1775 begin 1776 Canon_Psl_Property_Directive (Stmt); 1777 if Canon_Flag_Expressions then 1778 Canon_Expression (Get_Report_Expression (Stmt)); 1779 end if; 1780 end Canon_Psl_Assert_Directive; 1781 1782 procedure Canon_Psl_Cover_Directive (Stmt : Iir) is 1783 begin 1784 Canon_Psl_Sequence_Directive (Stmt); 1785 if Canon_Flag_Expressions then 1786 Canon_Expression (Get_Report_Expression (Stmt)); 1787 end if; 1788 end Canon_Psl_Cover_Directive; 1789 1790 procedure Canon_If_Case_Generate_Statement_Body 1791 (Bod : Iir; Alt_Num : in out Natural; Top : Iir_Design_Unit) is 1792 begin 1793 if Canon_Flag_Add_Labels 1794 and then Get_Alternative_Label (Bod) = Null_Identifier 1795 then 1796 declare 1797 Str : String := Natural'Image (Alt_Num); 1798 begin 1799 -- Note: the label starts with a capitalized 1800 -- letter, to avoid any clash with user's 1801 -- identifiers. 1802 Str (1) := 'B'; 1803 Set_Alternative_Label (Bod, Name_Table.Get_Identifier (Str)); 1804 end; 1805 end if; 1806 1807 Canon_Generate_Statement_Body (Top, Bod); 1808 Alt_Num := Alt_Num + 1; 1809 end Canon_If_Case_Generate_Statement_Body; 1810 1811 function Canon_Concurrent_Assertion_Statement (Stmt : Iir) return Iir 1812 is 1813 Proc : Iir; 1814 Asrt : Iir; 1815 Expr : Iir; 1816 Sensitivity_List : Iir_List; 1817 begin 1818 -- Create a new entry. 1819 Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); 1820 Location_Copy (Proc, Stmt); 1821 Set_Parent (Proc, Get_Parent (Stmt)); 1822 Set_Chain (Proc, Get_Chain (Stmt)); 1823 Set_Process_Origin (Proc, Stmt); 1824 1825 -- LRM93 9.4 1826 -- The equivalent process statement has a label if and only if the 1827 -- current assertion statement has a label; if the equivalent process 1828 -- statement has a label; it is the same as that of the concurrent 1829 -- assertion statement. 1830 Set_Label (Proc, Get_Label (Stmt)); 1831 1832 -- LRM93 9.4 1833 -- The equivalent process statement is a postponed process if and only 1834 -- if the current assertion statement includes the reserved word 1835 -- POSTPONED. 1836 Set_Postponed_Flag (Proc, Get_Postponed_Flag (Stmt)); 1837 1838 Asrt := Create_Iir (Iir_Kind_Assertion_Statement); 1839 Set_Sequential_Statement_Chain (Proc, Asrt); 1840 Set_Parent (Asrt, Proc); 1841 Location_Copy (Asrt, Stmt); 1842 Sensitivity_List := Create_Iir_List; 1843 Set_Sensitivity_List (Proc, Sensitivity_List); 1844 Set_Is_Ref (Proc, True); 1845 1846 -- Expand the expression, fill the sensitivity list, 1847 Expr := Get_Assertion_Condition (Stmt); 1848 Canon_Extract_Sensitivity_Expression (Expr, Sensitivity_List, False); 1849 Set_Assertion_Condition (Asrt, Expr); 1850 Set_Assertion_Condition (Stmt, Null_Iir); 1851 1852 Expr := Get_Report_Expression (Stmt); 1853 Set_Report_Expression (Asrt, Expr); 1854 Set_Report_Expression (Stmt, Null_Iir); 1855 1856 Expr := Get_Severity_Expression (Stmt); 1857 Set_Severity_Expression (Asrt, Expr); 1858 Set_Severity_Expression (Stmt, Null_Iir); 1859 1860 return Proc; 1861 end Canon_Concurrent_Assertion_Statement; 1862 1863 function Canon_Concurrent_Break_Statement (Stmt : Iir) return Iir 1864 is 1865 Proc : Iir; 1866 Brk : Iir; 1867 Sensitivity_List : Iir_List; 1868 Cond : Iir; 1869 begin 1870 -- Create a new entry. 1871 Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); 1872 Location_Copy (Proc, Stmt); 1873 Set_Parent (Proc, Get_Parent (Stmt)); 1874 Set_Chain (Proc, Get_Chain (Stmt)); 1875 Set_Process_Origin (Proc, Stmt); 1876 1877 -- AMS-LRM17 11.9 Concurrent break statement 1878 -- The equivalent process statement has a label if and only if the 1879 -- concurrent break statement has a label; if the equivalent process 1880 -- statement has a label, it is the same as that of the concurrent 1881 -- break statement. 1882 Set_Label (Proc, Get_Label (Stmt)); 1883 1884 -- AMS-LRM17 11.9 Concurrent break statement 1885 -- The equivalent process statement does not include the reserved word 1886 -- postponed, [...] 1887 Set_Postponed_Flag (Proc, False); 1888 1889 Brk := Create_Iir (Iir_Kind_Break_Statement); 1890 Set_Sequential_Statement_Chain (Proc, Brk); 1891 Set_Parent (Brk, Proc); 1892 Location_Copy (Brk, Stmt); 1893 1894 Cond := Get_Condition (Stmt); 1895 Set_Break_Element (Brk, Get_Break_Element (Stmt)); 1896 Set_Break_Element (Stmt, Null_Iir); 1897 Set_Condition (Brk, Cond); 1898 Set_Condition (Stmt, Null_Iir); 1899 1900 -- AMS-LRM17 11.9 Concurrent break statement 1901 -- If the concurrent break statement has a sensitivity clause, then 1902 -- the wait statement of the equivalent process statement contains the 1903 -- same sensitivity clause; otherwise, if a name that denotes a signal 1904 -- appears in the Boolean expression that defines the condition of the 1905 -- break, then the wait statement includes a sensitivity clause that is 1906 -- constructed by applying the rule of 10.2 to that expression; 1907 -- otherwise the wait statement contains no sensitivity clause. The 1908 -- wait statement does not contain a condition clause of a timeout 1909 -- clause. 1910 Sensitivity_List := Get_Sensitivity_List (Stmt); 1911 if Sensitivity_List = Null_Iir_List and then Cond /= Null_Iir then 1912 Sensitivity_List := Create_Iir_List; 1913 Canon_Extract_Sensitivity_Expression (Cond, Sensitivity_List, False); 1914 end if; 1915 Set_Sensitivity_List (Proc, Sensitivity_List); 1916 Set_Is_Ref (Proc, True); 1917 1918 return Proc; 1919 end Canon_Concurrent_Break_Statement; 1920 1921 procedure Canon_Concurrent_Label (Stmt : Iir; Proc_Num : in out Natural) is 1922 begin 1923 -- Add a label if required. 1924 if Canon_Flag_Add_Labels then 1925 case Get_Kind (Stmt) is 1926 when Iir_Kind_Psl_Declaration 1927 | Iir_Kind_Psl_Endpoint_Declaration => 1928 null; 1929 when others => 1930 if Get_Label (Stmt) = Null_Identifier then 1931 declare 1932 Str : String := Natural'Image (Proc_Num); 1933 begin 1934 -- Note: the label starts with a capitalized letter, 1935 -- to avoid any clash with user's identifiers. 1936 Str (1) := 'P'; 1937 Set_Label (Stmt, Name_Table.Get_Identifier (Str)); 1938 end; 1939 Proc_Num := Proc_Num + 1; 1940 end if; 1941 end case; 1942 end if; 1943 end Canon_Concurrent_Label; 1944 1945 procedure Canon_Concurrent_Statement 1946 (Stmt : in out Iir; Top : Iir_Design_Unit) 1947 is 1948 Sub_Chain : Iir; 1949 Proc : Iir; 1950 begin 1951 case Get_Kind (Stmt) is 1952 when Iir_Kind_Concurrent_Simple_Signal_Assignment => 1953 if Canon_Flag_Expressions then 1954 Canon_Expression (Get_Target (Stmt)); 1955 Canon_Waveform_Expression (Get_Waveform_Chain (Stmt)); 1956 end if; 1957 1958 if Canon_Flag_Concurrent_Stmts then 1959 Canon_Concurrent_Signal_Assignment (Stmt, Proc, Sub_Chain); 1960 Canon_Concurrent_Simple_Signal_Assignment 1961 (Stmt, Proc, Sub_Chain); 1962 Stmt := Proc; 1963 end if; 1964 1965 when Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1966 if Canon_Flag_Expressions then 1967 Canon_Expression (Get_Target (Stmt)); 1968 Canon_Conditional_Signal_Assignment_Expression (Stmt); 1969 end if; 1970 1971 if Canon_Flag_Concurrent_Stmts then 1972 Canon_Concurrent_Signal_Assignment (Stmt, Proc, Sub_Chain); 1973 Canon_Concurrent_Conditional_Signal_Assignment 1974 (Stmt, Proc, Sub_Chain); 1975 Stmt := Proc; 1976 end if; 1977 1978 when Iir_Kind_Concurrent_Selected_Signal_Assignment => 1979 if Canon_Flag_Expressions then 1980 Canon_Expression (Get_Target (Stmt)); 1981 Canon_Selected_Signal_Assignment_Expression (Stmt); 1982 end if; 1983 1984 if Canon_Flag_Concurrent_Stmts then 1985 Canon_Concurrent_Signal_Assignment (Stmt, Proc, Sub_Chain); 1986 Canon_Concurrent_Selected_Signal_Assignment 1987 (Stmt, Proc, Sub_Chain); 1988 Stmt := Proc; 1989 end if; 1990 1991 when Iir_Kind_Concurrent_Assertion_Statement => 1992 if Canon_Flag_Expressions then 1993 Canon_Expression (Get_Assertion_Condition (Stmt)); 1994 Canon_Expression_If_Valid (Get_Report_Expression (Stmt)); 1995 Canon_Expression_If_Valid (Get_Severity_Expression (Stmt)); 1996 end if; 1997 1998 if Canon_Flag_Concurrent_Stmts then 1999 Stmt := Canon_Concurrent_Assertion_Statement (Stmt); 2000 end if; 2001 2002 when Iir_Kind_Concurrent_Break_Statement => 2003 if Canon_Flag_Expressions then 2004 Canon_Expression_If_Valid (Get_Condition (Stmt)); 2005 end if; 2006 if Canon_Flag_Concurrent_Stmts then 2007 Stmt := Canon_Concurrent_Break_Statement (Stmt); 2008 end if; 2009 2010 when Iir_Kind_Concurrent_Procedure_Call_Statement => 2011 declare 2012 Call : constant Iir_Procedure_Call := 2013 Get_Procedure_Call (Stmt); 2014 Imp : constant Iir := Get_Implementation (Call); 2015 Assoc_Chain : Iir; 2016 begin 2017 Assoc_Chain := Canon_Association_Chain_And_Actuals 2018 (Get_Interface_Declaration_Chain (Imp), 2019 Get_Parameter_Association_Chain (Call), 2020 Call); 2021 Set_Parameter_Association_Chain (Call, Assoc_Chain); 2022 end; 2023 2024 if Canon_Flag_Concurrent_Stmts then 2025 Stmt := Canon_Concurrent_Procedure_Call (Stmt); 2026 end if; 2027 2028 when Iir_Kind_Sensitized_Process_Statement 2029 | Iir_Kind_Process_Statement => 2030 Canon_Declarations (Top, Stmt, Null_Iir); 2031 if Canon_Flag_Sequentials_Stmts then 2032 declare 2033 Stmts : Iir; 2034 begin 2035 Stmts := Get_Sequential_Statement_Chain (Stmt); 2036 Stmts := Canon_Sequential_Stmts (Stmts); 2037 Set_Sequential_Statement_Chain (Stmt, Stmts); 2038 end; 2039 end if; 2040 if Canon_Flag_All_Sensitivity 2041 and then Canon_Flag_Sequentials_Stmts 2042 and then Get_Kind (Stmt) = Iir_Kind_Sensitized_Process_Statement 2043 and then Get_Sensitivity_List (Stmt) = Iir_List_All 2044 then 2045 Set_Sensitivity_List 2046 (Stmt, Canon_Extract_Sensitivity_Process (Stmt)); 2047 end if; 2048 2049 when Iir_Kind_Component_Instantiation_Statement => 2050 declare 2051 Inst : Iir; 2052 Assoc_Chain : Iir; 2053 begin 2054 Inst := Get_Instantiated_Unit (Stmt); 2055 Inst := Get_Entity_From_Entity_Aspect (Inst); 2056 Assoc_Chain := Canon_Association_Chain_And_Actuals 2057 (Get_Generic_Chain (Inst), 2058 Get_Generic_Map_Aspect_Chain (Stmt), 2059 Stmt); 2060 Set_Generic_Map_Aspect_Chain (Stmt, Assoc_Chain); 2061 2062 Assoc_Chain := Canon_Association_Chain_And_Actuals 2063 (Get_Port_Chain (Inst), 2064 Get_Port_Map_Aspect_Chain (Stmt), 2065 Stmt); 2066 Set_Port_Map_Aspect_Chain (Stmt, Assoc_Chain); 2067 end; 2068 2069 when Iir_Kind_Block_Statement => 2070 declare 2071 Header : constant Iir_Block_Header := Get_Block_Header (Stmt); 2072 Guard : constant Iir_Guard_Signal_Declaration := 2073 Get_Guard_Decl (Stmt); 2074 Chain : Iir; 2075 Expr : Iir; 2076 begin 2077 if Guard /= Null_Iir then 2078 Expr := Get_Guard_Expression (Guard); 2079 Set_Guard_Sensitivity_List (Guard, Create_Iir_List); 2080 Canon_Extract_Sensitivity_Expression 2081 (Expr, Get_Guard_Sensitivity_List (Guard), False); 2082 if Canon_Flag_Expressions then 2083 Canon_Expression (Stmt); 2084 end if; 2085 end if; 2086 if Header /= Null_Iir then 2087 -- Generics. 2088 Chain := Get_Generic_Map_Aspect_Chain (Header); 2089 if Chain /= Null_Iir then 2090 Chain := Canon_Association_Chain_And_Actuals 2091 (Get_Generic_Chain (Header), Chain, Chain); 2092 else 2093 Chain := Canon_Default_Association_Chain 2094 (Get_Generic_Chain (Header)); 2095 end if; 2096 Set_Generic_Map_Aspect_Chain (Header, Chain); 2097 2098 -- Ports. 2099 Chain := Get_Port_Map_Aspect_Chain (Header); 2100 if Chain /= Null_Iir then 2101 Chain := Canon_Association_Chain_And_Actuals 2102 (Get_Port_Chain (Header), Chain, Chain); 2103 else 2104 Chain := Canon_Default_Association_Chain 2105 (Get_Port_Chain (Header)); 2106 end if; 2107 Set_Port_Map_Aspect_Chain (Header, Chain); 2108 end if; 2109 Canon_Declarations (Top, Stmt, Stmt); 2110 Canon_Concurrent_Stmts (Top, Stmt); 2111 end; 2112 2113 when Iir_Kind_If_Generate_Statement => 2114 declare 2115 Clause : Iir; 2116 Alt_Num : Natural; 2117 begin 2118 Clause := Stmt; 2119 Alt_Num := 1; 2120 while Clause /= Null_Iir loop 2121 if Canon_Flag_Expressions then 2122 Canon_Expression_If_Valid (Get_Condition (Stmt)); 2123 end if; 2124 2125 Canon_If_Case_Generate_Statement_Body 2126 (Get_Generate_Statement_Body (Clause), Alt_Num, Top); 2127 2128 Clause := Get_Generate_Else_Clause (Clause); 2129 end loop; 2130 end; 2131 2132 when Iir_Kind_Case_Generate_Statement => 2133 declare 2134 Alt : Iir; 2135 Alt_Num : Natural; 2136 begin 2137 Alt_Num := 1; 2138 if Canon_Flag_Expressions then 2139 Canon_Expression (Get_Expression (Stmt)); 2140 end if; 2141 Alt := Get_Case_Statement_Alternative_Chain (Stmt); 2142 while Alt /= Null_Iir loop 2143 if not Get_Same_Alternative_Flag (Alt) then 2144 Canon_If_Case_Generate_Statement_Body 2145 (Get_Associated_Block (Alt), Alt_Num, Top); 2146 end if; 2147 2148 Alt := Get_Chain (Alt); 2149 end loop; 2150 end; 2151 2152 when Iir_Kind_For_Generate_Statement => 2153 declare 2154 Decl : constant Iir := Get_Parameter_Specification (Stmt); 2155 New_Decl : Iir; 2156 begin 2157 New_Decl := Canon_Declaration (Top, Decl, Null_Iir); 2158 pragma Assert (New_Decl = Decl); 2159 2160 Canon_Generate_Statement_Body 2161 (Top, Get_Generate_Statement_Body (Stmt)); 2162 end; 2163 2164 when Iir_Kind_Psl_Assert_Directive => 2165 Canon_Psl_Assert_Directive (Stmt); 2166 when Iir_Kind_Psl_Assume_Directive => 2167 Canon_Psl_Property_Directive (Stmt); 2168 when Iir_Kind_Psl_Cover_Directive => 2169 Canon_Psl_Cover_Directive (Stmt); 2170 when Iir_Kind_Psl_Restrict_Directive => 2171 Canon_Psl_Sequence_Directive (Stmt); 2172 2173 when Iir_Kind_Psl_Default_Clock => 2174 null; 2175 when Iir_Kind_Psl_Declaration => 2176 declare 2177 use PSL.Nodes; 2178 Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); 2179 Prop : PSL_Node; 2180 Fa : PSL_NFA; 2181 begin 2182 case Get_Kind (Decl) is 2183 when N_Property_Declaration => 2184 Prop := Get_Property (Decl); 2185 Prop := PSL.Rewrites.Rewrite_Property (Prop); 2186 Set_Property (Decl, Prop); 2187 if Get_Parameter_List (Decl) = Null_PSL_Node then 2188 -- Generate the NFA. 2189 Fa := PSL.Build.Build_FA (Prop); 2190 Set_PSL_NFA (Stmt, Fa); 2191 end if; 2192 when N_Sequence_Declaration 2193 | N_Endpoint_Declaration => 2194 Prop := Get_Sequence (Decl); 2195 Prop := PSL.Rewrites.Rewrite_SERE (Prop); 2196 Set_Sequence (Decl, Prop); 2197 when others => 2198 Error_Kind ("canon psl_declaration", Decl); 2199 end case; 2200 end; 2201 when Iir_Kind_Psl_Endpoint_Declaration => 2202 declare 2203 use PSL.Nodes; 2204 Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); 2205 Seq : PSL_Node; 2206 Fa : PSL_NFA; 2207 begin 2208 pragma Assert (Get_Parameter_List (Decl) = Null_PSL_Node); 2209 Seq := Get_Sequence (Decl); 2210 Seq := PSL.Rewrites.Rewrite_SERE (Seq); 2211 Set_Sequence (Decl, Seq); 2212 -- Generate the NFA. 2213 Fa := PSL.Build.Build_SERE_FA (Seq); 2214 Set_PSL_NFA (Stmt, Fa); 2215 Canon_Psl_Clocked_NFA (Stmt); 2216 end; 2217 2218 when Iir_Kind_Simple_Simultaneous_Statement => 2219 if Canon_Flag_Expressions then 2220 Canon_Expression (Get_Simultaneous_Left (Stmt)); 2221 Canon_Expression (Get_Simultaneous_Right (Stmt)); 2222 end if; 2223 when Iir_Kind_Simultaneous_If_Statement => 2224 declare 2225 Clause : Iir; 2226 begin 2227 Clause := Stmt; 2228 while Clause /= Null_Iir loop 2229 if Canon_Flag_Expressions then 2230 Canon_Expression_If_Valid (Get_Condition (Clause)); 2231 end if; 2232 Canon_Simultaneous_Stmts 2233 (Top, Get_Simultaneous_Statement_Chain (Clause)); 2234 Clause := Get_Else_Clause (Clause); 2235 end loop; 2236 end; 2237 when Iir_Kind_Simultaneous_Case_Statement => 2238 declare 2239 Alt : Iir; 2240 begin 2241 if Canon_Flag_Expressions then 2242 Canon_Expression (Get_Expression (Stmt)); 2243 end if; 2244 Alt := Get_Case_Statement_Alternative_Chain (Stmt); 2245 while Alt /= Null_Iir loop 2246 if not Get_Same_Alternative_Flag (Alt) then 2247 Canon_Simultaneous_Stmts 2248 (Top, Get_Associated_Block (Alt)); 2249 end if; 2250 Alt := Get_Chain (Alt); 2251 end loop; 2252 end; 2253 when Iir_Kind_Simultaneous_Procedural_Statement => 2254 Canon_Declarations (Top, Stmt, Null_Iir); 2255 if Canon_Flag_Sequentials_Stmts then 2256 declare 2257 Stmts : Iir; 2258 begin 2259 Stmts := Get_Sequential_Statement_Chain (Stmt); 2260 Stmts := Canon_Sequential_Stmts (Stmts); 2261 Set_Sequential_Statement_Chain (Stmt, Stmts); 2262 end; 2263 end if; 2264 when Iir_Kind_Simultaneous_Null_Statement => 2265 null; 2266 2267 when others => 2268 Error_Kind ("canon_concurrent_statement", Stmt); 2269 end case; 2270 end Canon_Concurrent_Statement; 2271 2272 procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir) 2273 is 2274 -- Current element in the chain of concurrent statements. 2275 Stmt : Iir; 2276 Prev_Stmt : Iir; 2277 2278 Proc_Num : Natural := 0; 2279 begin 2280 Prev_Stmt := Null_Iir; 2281 Stmt := Get_Concurrent_Statement_Chain (Parent); 2282 while Stmt /= Null_Iir loop 2283 Canon_Concurrent_Label (Stmt, Proc_Num); 2284 2285 Canon_Concurrent_Statement (Stmt, Top); 2286 2287 -- STMT may have been changed. 2288 if Prev_Stmt = Null_Iir then 2289 Set_Concurrent_Statement_Chain (Parent, Stmt); 2290 else 2291 Set_Chain (Prev_Stmt, Stmt); 2292 end if; 2293 Prev_Stmt := Stmt; 2294 Stmt := Get_Chain (Stmt); 2295 end loop; 2296 end Canon_Concurrent_Stmts; 2297 2298 procedure Canon_Simultaneous_Stmts (Top : Iir_Design_Unit; Chain : Iir) 2299 is 2300 Stmt : Iir; 2301 Prev_Stmt : Iir; 2302 Proc_Num : Natural := 0; 2303 begin 2304 Stmt := Chain; 2305 while Stmt /= Null_Iir loop 2306 Canon_Concurrent_Label (Stmt, Proc_Num); 2307 2308 Prev_Stmt := Stmt; 2309 Canon_Concurrent_Statement (Stmt, Top); 2310 pragma Assert (Stmt = Prev_Stmt); 2311 2312 Stmt := Get_Chain (Stmt); 2313 end loop; 2314 end Canon_Simultaneous_Stmts; 2315 2316-- procedure Canon_Binding_Indication 2317-- (Component: Iir; Binding : Iir_Binding_Indication) 2318-- is 2319-- List : Iir_Association_List; 2320-- begin 2321-- if Binding = Null_Iir then 2322-- return; 2323-- end if; 2324-- List := Get_Generic_Map_Aspect_List (Binding); 2325-- List := Canon_Association_List (Get_Generic_List (Component), List); 2326-- Set_Generic_Map_Aspect_List (Binding, List); 2327-- List := Get_Port_Map_Aspect_List (Binding); 2328-- List := Canon_Association_List (Get_Port_List (Component), List); 2329-- Set_Port_Map_Aspect_List (Binding, List); 2330-- end Canon_Binding_Indication; 2331 2332 procedure Add_Binding_Indication_Dependence (Top : Iir_Design_Unit; 2333 Binding : Iir) 2334 is 2335 Aspect : Iir; 2336 begin 2337 if Binding = Null_Iir then 2338 return; 2339 end if; 2340 Aspect := Get_Entity_Aspect (Binding); 2341 if Aspect = Null_Iir then 2342 return; 2343 end if; 2344 case Get_Kind (Aspect) is 2345 when Iir_Kind_Entity_Aspect_Entity => 2346 if Get_Architecture (Aspect) /= Null_Iir then 2347 Add_Dependence (Top, Aspect); 2348 else 2349 Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect))); 2350 end if; 2351 when Iir_Kind_Entity_Aspect_Configuration => 2352 Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect))); 2353 when Iir_Kind_Entity_Aspect_Open => 2354 null; 2355 when others => 2356 Error_Kind ("add_binding_indication_dependence", Aspect); 2357 end case; 2358 end Add_Binding_Indication_Dependence; 2359 2360 -- Canon the component_configuration or configuration_specification CFG. 2361 -- TOP is used to add dependences. 2362 procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir) 2363 is 2364 -- True iff CFG is a component_configuration. 2365 -- False iff CFG is a configuration_specification. 2366 Is_Config : constant Boolean := 2367 Get_Kind (Cfg) = Iir_Kind_Component_Configuration; 2368 2369 Bind : Iir; 2370 Comp : Iir; 2371 Instances : Iir_Flist; 2372 Entity_Aspect : Iir; 2373 Block : Iir_Block_Configuration; 2374 Map_Chain : Iir; 2375 Entity : Iir; 2376 begin 2377 Bind := Get_Binding_Indication (Cfg); 2378 if Bind = Null_Iir then 2379 -- Add a default binding indication 2380 -- Extract a component instantiation 2381 Instances := Get_Instantiation_List (Cfg); 2382 -- Designator_all and designator_others must have been replaced 2383 -- by a list during canon. 2384 pragma Assert (Instances not in Iir_Flists_All_Others); 2385 Bind := Get_Default_Binding_Indication 2386 (Get_Named_Entity (Get_Nth_Element (Instances, 0))); 2387 if Bind = Null_Iir then 2388 -- Component is not bound. 2389 return; 2390 end if; 2391 Set_Binding_Indication (Cfg, Bind); 2392 Set_Is_Ref (Cfg, True); 2393 Add_Binding_Indication_Dependence (Top, Bind); 2394 if Is_Config then 2395 Entity_Aspect := Get_Entity_Aspect (Bind); 2396 Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); 2397 Sem_Specs.Sem_Check_Missing_Generic_Association 2398 (Get_Generic_Chain (Entity), 2399 Get_Generic_Map_Aspect_Chain (Bind), 2400 Null_Iir, 2401 Cfg); 2402 end if; 2403 return; 2404 else 2405 Entity_Aspect := Get_Entity_Aspect (Bind); 2406 if Entity_Aspect = Null_Iir then 2407 Entity_Aspect := Get_Default_Entity_Aspect (Bind); 2408 Set_Entity_Aspect (Bind, Entity_Aspect); 2409 end if; 2410 if Entity_Aspect /= Null_Iir then 2411 Add_Binding_Indication_Dependence (Top, Bind); 2412 Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); 2413 Comp := Get_Named_Entity (Get_Component_Name (Cfg)); 2414 2415 -- Canon generic map 2416 Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); 2417 if Map_Chain = Null_Iir then 2418 if Is_Config and then Is_Valid (Entity) then 2419 Map_Chain := Sem_Specs.Create_Default_Map_Aspect 2420 (Comp, Entity, Sem_Specs.Map_Generic, Bind); 2421 end if; 2422 else 2423 Map_Chain := Canon_Association_Chain 2424 (Get_Generic_Chain (Entity), Map_Chain, Map_Chain); 2425 end if; 2426 Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); 2427 2428 -- Canon port map 2429 Map_Chain := Get_Port_Map_Aspect_Chain (Bind); 2430 if Map_Chain = Null_Iir then 2431 if Is_Config and then Is_Valid (Entity) then 2432 Map_Chain := Sem_Specs.Create_Default_Map_Aspect 2433 (Comp, Entity, Sem_Specs.Map_Port, Bind); 2434 end if; 2435 else 2436 Map_Chain := Canon_Association_Chain 2437 (Get_Port_Chain (Entity), Map_Chain, Map_Chain); 2438 end if; 2439 Set_Port_Map_Aspect_Chain (Bind, Map_Chain); 2440 2441 if Is_Config then 2442 Block := Get_Block_Configuration (Cfg); 2443 if Block /= Null_Iir then 2444 -- If there is no architecture_identifier in the binding, 2445 -- set it from the block_configuration. 2446 if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity 2447 and then Get_Architecture (Entity_Aspect) = Null_Iir 2448 then 2449 Entity := Get_Entity (Entity_Aspect); 2450 pragma Assert 2451 (Get_Kind (Entity) = Iir_Kind_Entity_Declaration); 2452 Set_Architecture 2453 (Entity_Aspect, 2454 Build_Reference_Name 2455 (Get_Block_Specification (Block))); 2456 end if; 2457 Canon_Block_Configuration (Top, Block); 2458 end if; 2459 end if; 2460 end if; 2461 end if; 2462 end Canon_Component_Configuration; 2463 2464 -- Create the 'final' binding indication in case of incremental binding. 2465 procedure Canon_Incremental_Binding 2466 (Conf_Spec : Iir_Configuration_Specification; 2467 Comp_Conf : Iir_Component_Configuration; 2468 Parent : Iir) 2469 is 2470 -- Merge associations from FIRST_CHAIN and SEC_CHAIN. 2471 function Merge_Association_Chain 2472 (Inter_Chain : Iir; First_Chain : Iir; Sec_Chain : Iir) return Iir 2473 is 2474 -- Result (chain). 2475 First, Last : Iir; 2476 2477 -- Copy an association and append new elements to FIRST/LAST. In 2478 -- case of individual associations, all associations for the 2479 -- interface are copied. 2480 procedure Copy_Association 2481 (Assoc : in out Iir; Inter : in out Iir; Copy_Inter : Iir) 2482 is 2483 El : Iir; 2484 Formal : Iir; 2485 begin 2486 loop 2487 El := Create_Iir (Get_Kind (Assoc)); 2488 Location_Copy (El, Assoc); 2489 2490 -- Copy formal. 2491 -- Special case: formal comes from a default binding 2492 -- indication. In that case Is_Forward_Ref is set, which makes 2493 -- it non-copiable by Sem_Inst. 2494 Formal := Get_Formal (Assoc); 2495 if Is_Valid (Formal) then 2496 if Get_Kind (Formal) = Iir_Kind_Simple_Name 2497 and then Get_Is_Forward_Ref (Formal) 2498 then 2499 Formal := Build_Simple_Name 2500 (Get_Named_Entity (Formal), Formal); 2501 else 2502 Formal := Sem_Inst.Copy_Tree (Formal); 2503 end if; 2504 Set_Formal (El, Formal); 2505 else 2506 Formal := Inter; 2507 end if; 2508 Set_Whole_Association_Flag 2509 (El, Get_Whole_Association_Flag (Assoc)); 2510 2511 case Get_Kind (Assoc) is 2512 when Iir_Kind_Association_Element_Open => 2513 null; 2514 when Iir_Kind_Association_Element_By_Expression => 2515 Set_Actual (El, Sem_Inst.Copy_Tree (Get_Actual (Assoc))); 2516 Set_Actual_Conversion 2517 (El, 2518 Sem_Inst.Copy_Tree (Get_Actual_Conversion (Assoc))); 2519 Set_Formal_Conversion 2520 (El, 2521 Sem_Inst.Copy_Tree (Get_Formal_Conversion (Assoc))); 2522 Set_Collapse_Signal_Flag 2523 (Assoc, 2524 Sem.Can_Collapse_Signals (Assoc, Formal)); 2525 when Iir_Kind_Association_Element_By_Individual => 2526 Set_Actual_Type (El, Get_Actual_Type (Assoc)); 2527 when others => 2528 Error_Kind ("copy_association", Assoc); 2529 end case; 2530 2531 Chain_Append (First, Last, El); 2532 Next_Association_Interface (Assoc, Inter); 2533 exit when Assoc = Null_Iir; 2534 exit when 2535 Get_Association_Interface (Assoc, Inter) /= Copy_Inter; 2536 end loop; 2537 end Copy_Association; 2538 2539 procedure Advance 2540 (Assoc : in out Iir; Inter : in out Iir; Skip_Inter : Iir) is 2541 begin 2542 loop 2543 Next_Association_Interface (Assoc, Inter); 2544 exit when Assoc = Null_Iir; 2545 exit when 2546 Get_Association_Interface (Assoc, Inter) /= Skip_Inter; 2547 end loop; 2548 end Advance; 2549 2550 Inter : Iir; 2551 F_El : Iir; 2552 F_Inter : Iir; 2553 S_El : Iir; 2554 S_Inter : Iir; 2555 begin 2556 F_El := First_Chain; 2557 F_Inter := Inter_Chain; 2558 Chain_Init (First, Last); 2559 Inter := Inter_Chain; 2560 while Inter /= Null_Iir loop 2561 -- Consistency check. 2562 pragma Assert (Get_Association_Interface (F_El, F_Inter) = Inter); 2563 2564 -- Find the association in the second chain. 2565 S_El := Find_First_Association_For_Interface 2566 (Sec_Chain, Inter_Chain, Inter); 2567 2568 if S_El /= Null_Iir 2569 and then Get_Kind (S_El) /= Iir_Kind_Association_Element_Open 2570 then 2571 -- Exists and not open: use it. 2572 S_Inter := Inter; 2573 Copy_Association (S_El, S_Inter, Inter); 2574 Advance (F_El, F_Inter, Inter); 2575 else 2576 -- Does not exist: use the one from first chain. 2577 Copy_Association (F_El, F_Inter, Inter); 2578 end if; 2579 Inter := Get_Chain (Inter); 2580 end loop; 2581 return First; 2582 end Merge_Association_Chain; 2583 2584 Comp_Name : constant Iir := Get_Component_Name (Conf_Spec); 2585 Comp : constant Iir := Get_Named_Entity (Comp_Name); 2586 Cs_Binding : constant Iir := Get_Binding_Indication (Conf_Spec); 2587 Cc_Binding : constant Iir := Get_Binding_Indication (Comp_Conf); 2588 Res : Iir_Component_Configuration; 2589 Cs_Chain : Iir; 2590 Res_Binding : Iir_Binding_Indication; 2591 Entity : Iir; 2592 Instance_List : Iir_List; 2593 Conf_Instance_List : Iir_Flist; 2594 Instance : Iir; 2595 Instance_Name : Iir; 2596 N_Nbr : Natural; 2597 begin 2598 -- Create the new component configuration 2599 Res := Create_Iir (Iir_Kind_Component_Configuration); 2600 Location_Copy (Res, Comp_Conf); 2601 Set_Parent (Res, Parent); 2602 Set_Component_Name (Res, Build_Reference_Name (Comp_Name)); 2603 2604 Res_Binding := Create_Iir (Iir_Kind_Binding_Indication); 2605 Location_Copy (Res_Binding, Res); 2606 Set_Binding_Indication (Res, Res_Binding); 2607 2608 Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding)); 2609 2610 -- Merge generic map aspect. 2611 Cs_Chain := Get_Generic_Map_Aspect_Chain (Cs_Binding); 2612 if Cs_Chain = Null_Iir then 2613 Cs_Chain := Sem_Specs.Create_Default_Map_Aspect 2614 (Comp, Entity, Sem_Specs.Map_Generic, Cs_Binding); 2615 end if; 2616 Set_Generic_Map_Aspect_Chain 2617 (Res_Binding, 2618 Merge_Association_Chain (Get_Generic_Chain (Entity), 2619 Cs_Chain, 2620 Get_Generic_Map_Aspect_Chain (Cc_Binding))); 2621 2622 -- Merge port map aspect. 2623 Cs_Chain := Get_Port_Map_Aspect_Chain (Cs_Binding); 2624 if Cs_Chain = Null_Iir then 2625 Cs_Chain := Sem_Specs.Create_Default_Map_Aspect 2626 (Comp, Entity, Sem_Specs.Map_Port, Cs_Binding); 2627 end if; 2628 Set_Port_Map_Aspect_Chain 2629 (Res_Binding, 2630 Merge_Association_Chain (Get_Port_Chain (Entity), 2631 Cs_Chain, 2632 Get_Port_Map_Aspect_Chain (Cc_Binding))); 2633 2634 -- Set entity aspect. 2635 Set_Entity_Aspect 2636 (Res_Binding, Sem_Inst.Copy_Tree (Get_Entity_Aspect (Cs_Binding))); 2637 2638 -- Create list of instances: 2639 -- * keep common instances 2640 -- replace component_configuration of them 2641 -- remove them in the instance list of COMP_CONF 2642 Instance_List := Create_Iir_List; 2643 Conf_Instance_List := Get_Instantiation_List (Comp_Conf); 2644 N_Nbr := 0; 2645 for I in Flist_First .. Flist_Last (Conf_Instance_List) loop 2646 Instance_Name := Get_Nth_Element (Conf_Instance_List, I); 2647 Instance := Get_Named_Entity (Instance_Name); 2648 if Get_Component_Configuration (Instance) = Conf_Spec then 2649 -- The incremental binding applies to this instance. 2650 Set_Component_Configuration (Instance, Res); 2651 Append_Element (Instance_List, Instance_Name); 2652 else 2653 Set_Nth_Element (Conf_Instance_List, N_Nbr, Instance_Name); 2654 N_Nbr := N_Nbr + 1; 2655 end if; 2656 end loop; 2657 Set_Instantiation_List (Comp_Conf, 2658 Truncate_Flist (Conf_Instance_List, N_Nbr)); 2659 Set_Instantiation_List (Res, List_To_Flist (Instance_List)); 2660 2661 -- Insert RES. 2662 Set_Chain (Res, Get_Chain (Comp_Conf)); 2663 Set_Chain (Comp_Conf, Res); 2664 end Canon_Incremental_Binding; 2665 2666 procedure Canon_Component_Specification_All_Others 2667 (Conf : Iir; Parent : Iir; Spec : Iir_Flist; List : Iir_List; Comp : Iir) 2668 is 2669 El : Iir; 2670 Comp_Conf : Iir; 2671 Inst : Iir; 2672 begin 2673 El := Get_Concurrent_Statement_Chain (Parent); 2674 while El /= Null_Iir loop 2675 -- Handle only component instantiation of COMP. 2676 if Get_Kind (El) = Iir_Kind_Component_Instantiation_Statement 2677 and then Is_Component_Instantiation (El) 2678 and then Get_Named_Entity (Get_Instantiated_Unit (El)) = Comp 2679 then 2680 Comp_Conf := Get_Component_Configuration (El); 2681 if Comp_Conf = Null_Iir then 2682 -- The component is not yet configured. 2683 Inst := Build_Simple_Name (El, El); 2684 Set_Is_Forward_Ref (Inst, True); 2685 Append_Element (List, Inst); 2686 Set_Component_Configuration (El, Conf); 2687 else 2688 -- The component is already configured. 2689 -- Handle incremental configuration. 2690 if Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification 2691 and then Spec = Iir_Flist_All 2692 then 2693 -- FIXME: handle incremental configuration. 2694 raise Internal_Error; 2695 end if; 2696 -- Several component configuration for an instance. 2697 -- Must have been caught by sem. 2698 pragma Assert (Spec = Iir_Flist_Others); 2699 end if; 2700 end if; 2701 El := Get_Chain (El); 2702 end loop; 2703 end Canon_Component_Specification_All_Others; 2704 2705 procedure Canon_Component_Specification_List 2706 (Conf : Iir; Parent : Iir; Spec : Iir_Flist) 2707 is 2708 El : Iir; 2709 Comp_Conf : Iir; 2710 begin 2711 -- Already has a designator list. 2712 for I in Flist_First .. Flist_Last (Spec) loop 2713 El := Get_Nth_Element (Spec, I); 2714 El := Get_Named_Entity (El); 2715 Comp_Conf := Get_Component_Configuration (El); 2716 if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then 2717 pragma Assert 2718 (Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification); 2719 pragma Assert 2720 (Get_Kind (Conf) = Iir_Kind_Component_Configuration); 2721 Canon_Incremental_Binding (Comp_Conf, Conf, Parent); 2722 else 2723 Set_Component_Configuration (El, Conf); 2724 end if; 2725 end loop; 2726 end Canon_Component_Specification_List; 2727 2728 -- PARENT is the parent for the chain of concurrent statements. 2729 procedure Canon_Component_Specification (Conf : Iir; Parent : Iir) 2730 is 2731 Spec : constant Iir_Flist := Get_Instantiation_List (Conf); 2732 List : Iir_List; 2733 begin 2734 if Spec in Iir_Flists_All_Others then 2735 List := Create_Iir_List; 2736 Canon_Component_Specification_All_Others 2737 (Conf, Parent, Spec, List, 2738 Get_Named_Entity (Get_Component_Name (Conf))); 2739 Set_Instantiation_List (Conf, List_To_Flist (List)); 2740 else 2741 -- Has Already a designator list. 2742 Canon_Component_Specification_List (Conf, Parent, Spec); 2743 end if; 2744 end Canon_Component_Specification; 2745 2746 -- Replace ALL/OTHERS with the explicit list of signals. 2747 procedure Canon_Disconnection_Specification 2748 (Dis : Iir_Disconnection_Specification) 2749 is 2750 Signal_List : Iir_Flist; 2751 Force : Boolean; 2752 El : Iir; 2753 N_List : Iir_List; 2754 Dis_Type : Iir; 2755 begin 2756 if Canon_Flag_Expressions then 2757 Canon_Expression (Get_Expression (Dis)); 2758 end if; 2759 2760 if Canon_Flag_Specification_Lists then 2761 Signal_List := Get_Signal_List (Dis); 2762 if Signal_List = Iir_Flist_All then 2763 Force := True; 2764 elsif Signal_List = Iir_Flist_Others then 2765 Force := False; 2766 else 2767 -- User list: nothing to do. 2768 return; 2769 end if; 2770 2771 Dis_Type := Get_Type (Get_Type_Mark (Dis)); 2772 N_List := Create_Iir_List; 2773 Set_Is_Ref (Dis, True); 2774 El := Get_Declaration_Chain (Get_Parent (Dis)); 2775 while El /= Null_Iir loop 2776 if Get_Kind (El) = Iir_Kind_Signal_Declaration 2777 and then Get_Type (El) = Dis_Type 2778 and then Get_Guarded_Signal_Flag (El) 2779 then 2780 if not Get_Has_Disconnect_Flag (El) then 2781 Set_Has_Disconnect_Flag (El, True); 2782 Append_Element (N_List, El); 2783 else 2784 if Force then 2785 raise Internal_Error; 2786 end if; 2787 end if; 2788 end if; 2789 El := Get_Chain (El); 2790 end loop; 2791 Set_Signal_List (Dis, List_To_Flist (N_List)); 2792 end if; 2793 end Canon_Disconnection_Specification; 2794 2795 -- Replace ALL/OTHERS with the explicit list of signals. 2796 procedure Canon_Step_Limit_Specification (Limit : Iir) 2797 is 2798 Quantity_List : Iir_Flist; 2799 Force : Boolean; 2800 El : Iir; 2801 N_List : Iir_List; 2802 Quan_Type : Iir; 2803 begin 2804 if Canon_Flag_Expressions then 2805 Canon_Expression (Get_Expression (Limit)); 2806 end if; 2807 2808 if Canon_Flag_Specification_Lists then 2809 Quantity_List := Get_Quantity_List (Limit); 2810 if Quantity_List = Iir_Flist_All then 2811 Force := True; 2812 elsif Quantity_List = Iir_Flist_Others then 2813 Force := False; 2814 else 2815 -- User list: nothing to do. 2816 return; 2817 end if; 2818 2819 pragma Unreferenced (Force); 2820 2821 Quan_Type := Get_Type (Get_Type_Mark (Limit)); 2822 N_List := Create_Iir_List; 2823 Set_Is_Ref (Limit, True); 2824 El := Get_Declaration_Chain (Get_Parent (Limit)); 2825 while El /= Null_Iir loop 2826 if Get_Kind (El) in Iir_Kinds_Quantity_Declaration 2827 and then Get_Type (El) = Quan_Type 2828 then 2829 raise Internal_Error; 2830 end if; 2831 El := Get_Chain (El); 2832 end loop; 2833 Set_Quantity_List (Limit, List_To_Flist (N_List)); 2834 end if; 2835 end Canon_Step_Limit_Specification; 2836 2837 procedure Canon_Subtype_Indication (Def : Iir) is 2838 begin 2839 case Get_Kind (Def) is 2840 when Iir_Kind_Array_Subtype_Definition => 2841 declare 2842 Indexes : constant Iir_Flist := Get_Index_Subtype_List (Def); 2843 Index : Iir; 2844 begin 2845 for I in Flist_First .. Flist_Last (Indexes) loop 2846 Index := Get_Index_Type (Indexes, I); 2847 Canon_Subtype_Indication_If_Anonymous (Index); 2848 end loop; 2849 end; 2850 when Iir_Kind_Integer_Subtype_Definition 2851 | Iir_Kind_Floating_Subtype_Definition 2852 | Iir_Kind_Enumeration_Subtype_Definition 2853 | Iir_Kind_Physical_Subtype_Definition => 2854 declare 2855 Rng : constant Iir := Get_Range_Constraint (Def); 2856 begin 2857 if Get_Kind (Rng) = Iir_Kind_Range_Expression then 2858 Canon_Expression (Rng); 2859 end if; 2860 end; 2861 when Iir_Kind_Record_Subtype_Definition 2862 | Iir_Kind_Record_Type_Definition => 2863 null; 2864 when Iir_Kind_Access_Subtype_Definition => 2865 null; 2866 when others => 2867 Error_Kind ("canon_subtype_indication", Def); 2868 end case; 2869 end Canon_Subtype_Indication; 2870 2871 procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir) is 2872 begin 2873 if Is_Anonymous_Type_Definition (Def) then 2874 Canon_Subtype_Indication (Def); 2875 end if; 2876 end Canon_Subtype_Indication_If_Anonymous; 2877 2878 -- Return the new package declaration (if any). 2879 function Canon_Package_Instantiation_Declaration (Decl : Iir) return Iir 2880 is 2881 Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Decl); 2882 Bod : Iir; 2883 begin 2884 -- Canon map aspect. 2885 Set_Generic_Map_Aspect_Chain 2886 (Decl, 2887 Canon_Association_Chain_And_Actuals 2888 (Get_Generic_Chain (Decl), 2889 Get_Generic_Map_Aspect_Chain (Decl), Decl)); 2890 2891 -- Generate the body now. 2892 -- Note: according to the LRM, if the instantiation occurs within a 2893 -- package, the body of the instance should be appended to the package 2894 -- body. 2895 -- FIXME: generate only if generating code for this unit. 2896 if Get_Macro_Expanded_Flag (Pkg) 2897 and then Get_Need_Body (Pkg) 2898 then 2899 Bod := Sem_Inst.Instantiate_Package_Body (Decl); 2900 Set_Parent (Bod, Get_Parent (Decl)); 2901 Set_Instance_Package_Body (Decl, Bod); 2902 end if; 2903 2904 return Decl; 2905 end Canon_Package_Instantiation_Declaration; 2906 2907 function Canon_Declaration (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir) 2908 return Iir 2909 is 2910 Stmts : Iir; 2911 begin 2912 case Get_Kind (Decl) is 2913 when Iir_Kind_Procedure_Body 2914 | Iir_Kind_Function_Body => 2915 Canon_Declarations (Top, Decl, Null_Iir); 2916 if Canon_Flag_Sequentials_Stmts then 2917 Stmts := Get_Sequential_Statement_Chain (Decl); 2918 Stmts := Canon_Sequential_Stmts (Stmts); 2919 Set_Sequential_Statement_Chain (Decl, Stmts); 2920 end if; 2921 2922 when Iir_Kind_Procedure_Declaration 2923 | Iir_Kind_Function_Declaration => 2924 null; 2925 when Iir_Kind_Function_Instantiation_Declaration 2926 | Iir_Kind_Procedure_Instantiation_Declaration => 2927 -- Canon map aspect. 2928 Set_Generic_Map_Aspect_Chain 2929 (Decl, 2930 Canon_Association_Chain_And_Actuals 2931 (Get_Generic_Chain (Decl), 2932 Get_Generic_Map_Aspect_Chain (Decl), Decl)); 2933 2934 when Iir_Kind_Type_Declaration => 2935 declare 2936 Def : Iir; 2937 begin 2938 Def := Get_Type_Definition (Decl); 2939 if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then 2940 Canon_Declarations (Decl, Def, Null_Iir); 2941 end if; 2942 end; 2943 2944 when Iir_Kind_Anonymous_Type_Declaration 2945 | Iir_Kind_Subtype_Declaration => 2946 null; 2947 2948 when Iir_Kind_Protected_Type_Body => 2949 Canon_Declarations (Top, Decl, Null_Iir); 2950 2951 when Iir_Kind_Variable_Declaration 2952 | Iir_Kind_Signal_Declaration 2953 | Iir_Kind_Constant_Declaration => 2954 if Canon_Flag_Expressions then 2955 Canon_Subtype_Indication_If_Anonymous (Get_Type (Decl)); 2956 Canon_Expression (Get_Default_Value (Decl)); 2957 end if; 2958 2959 when Iir_Kind_Anonymous_Signal_Declaration => 2960 if Canon_Flag_Expressions then 2961 Canon_Expression (Get_Expression (Decl)); 2962 end if; 2963 -- Create a signal assignment. 2964 if Canon_Flag_Inertial_Associations then 2965 declare 2966 Parent : constant Node := Get_Parent (Decl); 2967 Asgn : Iir; 2968 We : Iir; 2969 Name : Iir; 2970 begin 2971 Asgn := Create_Iir 2972 (Iir_Kind_Concurrent_Simple_Signal_Assignment); 2973 Location_Copy (Asgn, Decl); 2974 Set_Parent (Asgn, Parent); 2975 2976 Name := Create_Iir (Iir_Kind_Reference_Name); 2977 Location_Copy (Name, Decl); 2978 Set_Referenced_Name (Name, Decl); 2979 Set_Named_Entity (Name, Decl); 2980 Set_Type (Name, Get_Type (Decl)); 2981 Set_Expr_Staticness (Name, None); 2982 2983 Set_Target (Asgn, Name); 2984 Set_Delay_Mechanism (Asgn, Iir_Inertial_Delay); 2985 2986 We := Create_Iir (Iir_Kind_Waveform_Element); 2987 Location_Copy (We, Decl); 2988 Set_We_Value (We, Get_Expression (Decl)); 2989 Set_Expression (Decl, Null_Iir); 2990 2991 Set_Waveform_Chain (Asgn, We); 2992 2993 -- Prepend. 2994 Set_Chain (Asgn, Get_Concurrent_Statement_Chain (Parent)); 2995 Set_Concurrent_Statement_Chain (Parent, Asgn); 2996 end; 2997 end if; 2998 2999 when Iir_Kind_Iterator_Declaration => 3000 null; 3001 3002 when Iir_Kind_Object_Alias_Declaration => 3003 null; 3004 when Iir_Kind_Non_Object_Alias_Declaration => 3005 null; 3006 3007 when Iir_Kind_File_Declaration => 3008 -- FIXME 3009 null; 3010 3011 when Iir_Kind_Attribute_Declaration => 3012 null; 3013 when Iir_Kind_Attribute_Specification => 3014 if Canon_Flag_Expressions then 3015 Canon_Expression (Get_Expression (Decl)); 3016 end if; 3017 when Iir_Kind_Disconnection_Specification => 3018 Canon_Disconnection_Specification (Decl); 3019 when Iir_Kind_Step_Limit_Specification => 3020 Canon_Step_Limit_Specification (Decl); 3021 3022 when Iir_Kind_Group_Template_Declaration => 3023 null; 3024 when Iir_Kind_Group_Declaration => 3025 null; 3026 3027 when Iir_Kind_Use_Clause => 3028 null; 3029 3030 when Iir_Kind_Component_Declaration => 3031 null; 3032 3033 when Iir_Kind_Configuration_Specification => 3034 if Canon_Flag_Configurations then 3035 Canon_Component_Specification (Decl, Parent); 3036 Canon_Component_Configuration (Top, Decl); 3037 end if; 3038 3039 when Iir_Kind_Package_Declaration => 3040 Canon_Declarations (Top, Decl, Parent); 3041 when Iir_Kind_Package_Body => 3042 Canon_Declarations (Top, Decl, Parent); 3043 3044 when Iir_Kind_Package_Instantiation_Declaration => 3045 return Canon_Package_Instantiation_Declaration (Decl); 3046 3047 when Iir_Kind_Signal_Attribute_Declaration => 3048 null; 3049 3050 when Iir_Kind_Nature_Declaration 3051 | Iir_Kind_Subnature_Declaration => 3052 null; 3053 when Iir_Kind_Terminal_Declaration => 3054 null; 3055 when Iir_Kinds_Quantity_Declaration => 3056 null; 3057 3058 when Iir_Kind_Psl_Default_Clock => 3059 null; 3060 3061 when others => 3062 Error_Kind ("canon_declaration", Decl); 3063 end case; 3064 return Decl; 3065 end Canon_Declaration; 3066 3067 procedure Canon_Declarations (Top : Iir_Design_Unit; 3068 Decl_Parent : Iir; 3069 Parent : Iir) 3070 is 3071 Decl : Iir; 3072 Prev_Decl : Iir; 3073 New_Decl : Iir; 3074 Anon_Label : Natural; 3075 begin 3076 if Parent /= Null_Iir then 3077 Clear_Instantiation_Configuration (Parent); 3078 end if; 3079 3080 Anon_Label := 0; 3081 3082 Decl := Get_Declaration_Chain (Decl_Parent); 3083 Prev_Decl := Null_Iir; 3084 while Decl /= Null_Iir loop 3085 -- Give a name to anonymous signals. 3086 -- Ideally it should be done in Canon_Declaration, but we need 3087 -- a counter for all the declarations. 3088 if Get_Kind (Decl) = Iir_Kind_Anonymous_Signal_Declaration then 3089 declare 3090 Str : String := "ANONYMOUS" & Natural'Image (Anon_Label); 3091 begin 3092 -- Note: the label starts with a capitalized 3093 -- letter, to avoid any clash with user's 3094 -- identifiers. 3095 Str (10) := '_'; 3096 Set_Identifier (Decl, Name_Table.Get_Identifier (Str)); 3097 Anon_Label := Anon_Label + 1; 3098 end; 3099 end if; 3100 3101 New_Decl := Canon_Declaration (Top, Decl, Parent); 3102 3103 if New_Decl /= Decl then 3104 -- Replace declaration 3105 if Prev_Decl = Null_Iir then 3106 Set_Declaration_Chain (Decl_Parent, New_Decl); 3107 else 3108 Set_Chain (Prev_Decl, New_Decl); 3109 end if; 3110 end if; 3111 3112 Prev_Decl := New_Decl; 3113 Decl := Get_Chain (New_Decl); 3114 end loop; 3115 end Canon_Declarations; 3116 3117 -- Append for FIRST_ITEM/LAST_ITEM the default block or component 3118 -- configuration for statement EL (unless there is already a configuration 3119 -- for it). 3120 -- Always clear the association to the configuration for the statement. 3121 procedure Canon_Block_Configuration_Statement 3122 (El : Iir; Blk : Iir; Parent : Iir; First_Item, Last_Item : in out Iir) 3123 is 3124 procedure Create_Default_Block_Configuration (Targ : Iir) 3125 is 3126 Res : Iir; 3127 Spec : Iir; 3128 begin 3129 Res := Create_Iir (Iir_Kind_Block_Configuration); 3130 Location_Copy (Res, Targ); 3131 Set_Parent (Res, Parent); 3132 if True then 3133 -- For debugging. Display as user block configuration. 3134 Spec := Build_Simple_Name (Targ, Targ); 3135 else 3136 -- To reduce size, it is possible to refer directly to the block 3137 -- itself, without using a name. 3138 Spec := El; 3139 end if; 3140 Set_Block_Specification (Res, Spec); 3141 Chain_Append (First_Item, Last_Item, Res); 3142 end Create_Default_Block_Configuration; 3143 begin 3144 case Get_Kind (El) is 3145 when Iir_Kind_Component_Instantiation_Statement => 3146 declare 3147 Comp_Conf : Iir; 3148 Res : Iir_Component_Configuration; 3149 Designator_List : Iir_List; 3150 Inst_List : Iir_Flist; 3151 Inst : Iir; 3152 Inst_Name : Iir; 3153 begin 3154 Comp_Conf := Get_Component_Configuration (El); 3155 if Comp_Conf = Null_Iir then 3156 if Is_Component_Instantiation (El) then 3157 -- Create a component configuration. 3158 -- FIXME: should merge all these default configuration 3159 -- of the same component. 3160 Res := Create_Iir (Iir_Kind_Component_Configuration); 3161 Location_Copy (Res, El); 3162 Set_Parent (Res, Parent); 3163 Set_Component_Name 3164 (Res, 3165 Build_Reference_Name (Get_Instantiated_Unit (El))); 3166 Designator_List := Create_Iir_List; 3167 Append_Element 3168 (Designator_List, Build_Simple_Name (El, El)); 3169 Set_Instantiation_List 3170 (Res, List_To_Flist (Designator_List)); 3171 Chain_Append (First_Item, Last_Item, Res); 3172 end if; 3173 elsif Get_Kind (Comp_Conf) 3174 = Iir_Kind_Configuration_Specification 3175 then 3176 -- Create component configuration 3177 Res := Create_Iir (Iir_Kind_Component_Configuration); 3178 Location_Copy (Res, Comp_Conf); 3179 Set_Parent (Res, Parent); 3180 Set_Component_Name 3181 (Res, 3182 Build_Reference_Name (Get_Component_Name (Comp_Conf))); 3183 -- Keep in the designator list only the non-incrementally 3184 -- bound instances, and only the instances in the current 3185 -- statements parts (vhdl-87 generate issue). 3186 Inst_List := Get_Instantiation_List (Comp_Conf); 3187 Designator_List := Create_Iir_List; 3188 for I in Flist_First .. Flist_Last (Inst_List) loop 3189 Inst_Name := Get_Nth_Element (Inst_List, I); 3190 Inst := Get_Named_Entity (Inst_Name); 3191 if Get_Component_Configuration (Inst) = Comp_Conf 3192 and then Get_Parent (Inst) = Blk 3193 then 3194 Set_Component_Configuration (Inst, Res); 3195 Append_Element (Designator_List, 3196 Build_Reference_Name (Inst_Name)); 3197 end if; 3198 end loop; 3199 Set_Instantiation_List 3200 (Res, List_To_Flist (Designator_List)); 3201 Set_Binding_Indication 3202 (Res, Get_Binding_Indication (Comp_Conf)); 3203 Set_Is_Ref (Res, True); 3204 Chain_Append (First_Item, Last_Item, Res); 3205 end if; 3206 Set_Component_Configuration (El, Null_Iir); 3207 end; 3208 when Iir_Kind_Block_Statement => 3209 if Get_Block_Block_Configuration (El) = Null_Iir then 3210 Create_Default_Block_Configuration (El); 3211 end if; 3212 when Iir_Kind_If_Generate_Statement => 3213 declare 3214 Clause : Iir; 3215 Bod : Iir; 3216 Blk_Config : Iir_Block_Configuration; 3217 begin 3218 Clause := El; 3219 while Clause /= Null_Iir loop 3220 Bod := Get_Generate_Statement_Body (Clause); 3221 Blk_Config := Get_Generate_Block_Configuration (Bod); 3222 if Blk_Config = Null_Iir then 3223 Create_Default_Block_Configuration (Bod); 3224 end if; 3225 Set_Generate_Block_Configuration (Bod, Null_Iir); 3226 Clause := Get_Generate_Else_Clause (Clause); 3227 end loop; 3228 end; 3229 when Iir_Kind_Case_Generate_Statement => 3230 declare 3231 Alt : Iir; 3232 Bod : Iir; 3233 Blk_Config : Iir_Block_Configuration; 3234 begin 3235 Alt := Get_Case_Statement_Alternative_Chain (El); 3236 while Alt /= Null_Iir loop 3237 if not Get_Same_Alternative_Flag (Alt) then 3238 Bod := Get_Associated_Block (Alt); 3239 Blk_Config := Get_Generate_Block_Configuration (Bod); 3240 if Blk_Config = Null_Iir then 3241 Create_Default_Block_Configuration (Bod); 3242 end if; 3243 Set_Generate_Block_Configuration (Bod, Null_Iir); 3244 end if; 3245 Alt := Get_Chain (Alt); 3246 end loop; 3247 end; 3248 when Iir_Kind_For_Generate_Statement => 3249 declare 3250 Bod : constant Iir := Get_Generate_Statement_Body (El); 3251 Blk_Config : constant Iir_Block_Configuration := 3252 Get_Generate_Block_Configuration (Bod); 3253 Res : Iir_Block_Configuration; 3254 Blk_Spec : Iir; 3255 begin 3256 if Blk_Config = Null_Iir then 3257 Create_Default_Block_Configuration (Bod); 3258 else 3259 Blk_Spec := Strip_Denoting_Name 3260 (Get_Block_Specification (Blk_Config)); 3261 if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement_Body 3262 then 3263 -- There are generate specification with range or 3264 -- expression. Create a default block configuration 3265 -- for the (possible) non-covered values. 3266 Res := Create_Iir (Iir_Kind_Block_Configuration); 3267 Location_Copy (Res, El); 3268 Set_Parent (Res, Parent); 3269 Blk_Spec := Create_Iir (Iir_Kind_Indexed_Name); 3270 Location_Copy (Blk_Spec, Res); 3271 Set_Index_List (Blk_Spec, Iir_Flist_Others); 3272 Set_Base_Name (Blk_Spec, El); 3273 Set_Prefix (Blk_Spec, Build_Simple_Name (Bod, Res)); 3274 Set_Block_Specification (Res, Blk_Spec); 3275 Chain_Append (First_Item, Last_Item, Res); 3276 end if; 3277 end if; 3278 Set_Generate_Block_Configuration (Bod, Null_Iir); 3279 end; 3280 3281 when Iir_Kinds_Simple_Concurrent_Statement 3282 | Iir_Kind_Psl_Default_Clock 3283 | Iir_Kind_Psl_Declaration 3284 | Iir_Kind_Psl_Endpoint_Declaration 3285 | Iir_Kind_Simple_Simultaneous_Statement => 3286 null; 3287 3288 when others => 3289 Error_Kind ("canon_block_configuration(3)", El); 3290 end case; 3291 end Canon_Block_Configuration_Statement; 3292 3293 procedure Canon_Block_Configuration (Top : Iir_Design_Unit; 3294 Conf : Iir_Block_Configuration) 3295 is 3296 -- use Iir_Chains.Configuration_Item_Chain_Handling; 3297 Spec : constant Iir := Get_Block_Specification (Conf); 3298 Blk : constant Iir := Get_Block_From_Block_Specification (Spec); 3299 Stmts : constant Iir := Get_Concurrent_Statement_Chain (Blk); 3300 El : Iir; 3301 Sub_Blk : Iir; 3302 First_Item, Last_Item : Iir; 3303 3304 begin 3305 -- Note: the only allowed declarations are use clauses, which are not 3306 -- canonicalized. 3307 3308 -- FIXME: handle indexed/sliced name? 3309 3310 Clear_Instantiation_Configuration (Blk); 3311 3312 -- 1) Configure instantiations with configuration specifications. 3313 -- TODO: merge. 3314 El := Get_Declaration_Chain (Blk); 3315 while El /= Null_Iir loop 3316 if Get_Kind (El) = Iir_Kind_Configuration_Specification then 3317 -- Already canonicalized during canon of block declarations. 3318 -- But need to set configuration on instantiations. 3319 Canon_Component_Specification (El, Blk); 3320 end if; 3321 El := Get_Chain (El); 3322 end loop; 3323 3324 -- 2) Configure instantations with component configurations, 3325 -- and map block configurations with block/generate statements. 3326 First_Item := Get_Configuration_Item_Chain (Conf); 3327 El := First_Item; 3328 while El /= Null_Iir loop 3329 case Get_Kind (El) is 3330 when Iir_Kind_Configuration_Specification => 3331 raise Internal_Error; 3332 when Iir_Kind_Component_Configuration => 3333 Canon_Component_Specification (El, Blk); 3334 when Iir_Kind_Block_Configuration => 3335 Sub_Blk := Get_Block_From_Block_Specification 3336 (Get_Block_Specification (El)); 3337 case Get_Kind (Sub_Blk) is 3338 when Iir_Kind_Block_Statement => 3339 Set_Block_Block_Configuration (Sub_Blk, El); 3340 when Iir_Kind_Indexed_Name 3341 | Iir_Kind_Slice_Name => 3342 Sub_Blk := Strip_Denoting_Name (Get_Prefix (Sub_Blk)); 3343 Set_Prev_Block_Configuration 3344 (El, Get_Generate_Block_Configuration (Sub_Blk)); 3345 Set_Generate_Block_Configuration (Sub_Blk, El); 3346 when Iir_Kind_Parenthesis_Name => 3347 Sub_Blk := Get_Named_Entity (Sub_Blk); 3348 Set_Prev_Block_Configuration 3349 (El, Get_Generate_Block_Configuration (Sub_Blk)); 3350 Set_Generate_Block_Configuration (Sub_Blk, El); 3351 when Iir_Kind_Generate_Statement_Body => 3352 Set_Generate_Block_Configuration (Sub_Blk, El); 3353 when others => 3354 Error_Kind ("canon_block_configuration(0)", Sub_Blk); 3355 end case; 3356 when others => 3357 Error_Kind ("canon_block_configuration(1)", El); 3358 end case; 3359 Last_Item := El; 3360 El := Get_Chain (El); 3361 end loop; 3362 3363 -- 3) Add default component configuration for unspecified component 3364 -- instantiation statements, 3365 -- Add default block configuration for unconfigured block statements. 3366 El := Stmts; 3367 while El /= Null_Iir loop 3368 Canon_Block_Configuration_Statement 3369 (El, Blk, Conf, First_Item, Last_Item); 3370 El := Get_Chain (El); 3371 end loop; 3372 Set_Configuration_Item_Chain (Conf, First_Item); 3373 3374 -- 4) Canon component configuration and block configuration (recursion). 3375 El := First_Item; 3376 while El /= Null_Iir loop 3377 case Get_Kind (El) is 3378 when Iir_Kind_Block_Configuration => 3379 Canon_Block_Configuration (Top, El); 3380 when Iir_Kind_Component_Configuration => 3381 Canon_Component_Configuration (Top, El); 3382 when others => 3383 Error_Kind ("canon_block_configuration", El); 3384 end case; 3385 El := Get_Chain (El); 3386 end loop; 3387 end Canon_Block_Configuration; 3388 3389 procedure Canon_Interface_List (Chain : Iir) 3390 is 3391 Inter : Iir; 3392 begin 3393 if Canon_Flag_Expressions then 3394 Inter := Chain; 3395 while Inter /= Null_Iir loop 3396 Canon_Subtype_Indication_If_Anonymous (Get_Type (Inter)); 3397 Canon_Expression (Get_Default_Value (Inter)); 3398 Inter := Get_Chain (Inter); 3399 end loop; 3400 end if; 3401 end Canon_Interface_List; 3402 3403 procedure Canon_Psl_Verification_Unit (Unit : Iir_Design_Unit) 3404 is 3405 Decl : constant Iir := Get_Library_Unit (Unit); 3406 Item : Iir; 3407 Prev_Item : Iir; 3408 Blk_Cfg : Iir; 3409 First_Conf : Iir; 3410 Last_Conf : Iir; 3411 Proc_Num : Natural := 0; 3412 begin 3413 Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration); 3414 Set_Location (Blk_Cfg, Get_Location (Unit)); 3415 Set_Parent (Blk_Cfg, Unit); 3416 Set_Block_Specification (Blk_Cfg, Build_Simple_Name (Decl, Blk_Cfg)); 3417 Set_Verification_Block_Configuration (Decl, Blk_Cfg); 3418 3419 First_Conf := Null_Iir; 3420 Last_Conf := Null_Iir; 3421 3422 Prev_Item := Null_Iir; 3423 Item := Get_Vunit_Item_Chain (Decl); 3424 while Item /= Null_Iir loop 3425 case Get_Kind (Item) is 3426 when Iir_Kind_Psl_Default_Clock => 3427 null; 3428 when Iir_Kind_Psl_Assert_Directive => 3429 Canon_Psl_Assert_Directive (Item); 3430 when Iir_Kind_Psl_Assume_Directive => 3431 Canon_Psl_Property_Directive (Item); 3432 when Iir_Kind_Psl_Restrict_Directive => 3433 Canon_Psl_Sequence_Directive (Item); 3434 when Iir_Kind_Psl_Cover_Directive => 3435 Canon_Psl_Cover_Directive (Item); 3436 when Iir_Kind_Signal_Declaration 3437 | Iir_Kind_Function_Declaration 3438 | Iir_Kind_Procedure_Declaration 3439 | Iir_Kind_Function_Body 3440 | Iir_Kind_Procedure_Body 3441 | Iir_Kind_Attribute_Declaration 3442 | Iir_Kind_Attribute_Specification => 3443 Item := Canon_Declaration (Unit, Item, Null_Iir); 3444 when Iir_Kinds_Concurrent_Signal_Assignment 3445 | Iir_Kinds_Process_Statement 3446 | Iir_Kinds_Generate_Statement 3447 | Iir_Kind_Block_Statement 3448 | Iir_Kind_Concurrent_Procedure_Call_Statement 3449 | Iir_Kind_Component_Instantiation_Statement => 3450 Canon_Concurrent_Label (Item, Proc_Num); 3451 Canon_Concurrent_Statement (Item, Unit); 3452 Canon_Block_Configuration_Statement 3453 (Item, Unit, Unit, First_Conf, Last_Conf); 3454 when others => 3455 Error_Kind ("canon_psl_verification_unit", Item); 3456 end case; 3457 3458 if Prev_Item = Null_Iir then 3459 Set_Vunit_Item_Chain (Decl, Item); 3460 else 3461 Set_Chain (Prev_Item, Item); 3462 end if; 3463 Prev_Item := Item; 3464 Item := Get_Chain (Item); 3465 end loop; 3466 3467 Set_Configuration_Item_Chain (Blk_Cfg, First_Conf); 3468 end Canon_Psl_Verification_Unit; 3469 3470 procedure Canonicalize (Unit: Iir_Design_Unit) 3471 is 3472 El: Iir; 3473 begin 3474 if False then 3475 -- Canon context clauses. 3476 -- This code is not executed since context clauses are already 3477 -- canonicalized. 3478 El := Get_Context_Items (Unit); 3479 while El /= Null_Iir loop 3480 case Get_Kind (El) is 3481 when Iir_Kind_Use_Clause 3482 | Iir_Kind_Library_Clause 3483 | Iir_Kind_Context_Reference => 3484 null; 3485 when others => 3486 Error_Kind ("canonicalize1", El); 3487 end case; 3488 El := Get_Chain (El); 3489 end loop; 3490 end if; 3491 3492 El := Get_Library_Unit (Unit); 3493 case Iir_Kinds_Library_Unit (Get_Kind (El)) is 3494 when Iir_Kind_Entity_Declaration => 3495 Canon_Interface_List (Get_Generic_Chain (El)); 3496 Canon_Interface_List (Get_Port_Chain (El)); 3497 Canon_Declarations (Unit, El, El); 3498 Canon_Concurrent_Stmts (Unit, El); 3499 when Iir_Kind_Architecture_Body => 3500 Canon_Declarations (Unit, El, El); 3501 Canon_Concurrent_Stmts (Unit, El); 3502 when Iir_Kind_Package_Declaration => 3503 Canon_Declarations (Unit, El, Null_Iir); 3504 when Iir_Kind_Package_Body => 3505 Canon_Declarations (Unit, El, Null_Iir); 3506 when Iir_Kind_Configuration_Declaration => 3507 Canon_Declarations (Unit, El, Null_Iir); 3508 if Canon_Flag_Configurations then 3509 Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); 3510 end if; 3511 when Iir_Kind_Package_Instantiation_Declaration => 3512 El := Canon_Package_Instantiation_Declaration (El); 3513 Set_Library_Unit (Unit, El); 3514 when Iir_Kind_Context_Declaration => 3515 null; 3516 when Iir_Kind_Vunit_Declaration => 3517 Canon_Psl_Verification_Unit (Unit); 3518 when Iir_Kind_Vmode_Declaration 3519 | Iir_Kind_Vprop_Declaration => 3520 null; 3521 end case; 3522 end Canonicalize; 3523 3524-- -- Create a default component configuration for component instantiation 3525-- -- statement INST. 3526-- function Create_Default_Component_Configuration 3527-- (Inst : Iir_Component_Instantiation_Statement; 3528-- Parent : Iir; 3529-- Config_Unit : Iir_Design_Unit) 3530-- return Iir_Component_Configuration 3531-- is 3532-- Res : Iir_Component_Configuration; 3533-- Designator : Iir; 3534-- Comp : Iir_Component_Declaration; 3535-- Bind : Iir; 3536-- Aspect : Iir; 3537-- begin 3538-- Bind := Get_Default_Binding_Indication (Inst); 3539 3540-- if Bind = Null_Iir then 3541-- -- Component is not bound. 3542-- return Null_Iir; 3543-- end if; 3544 3545-- Res := Create_Iir (Iir_Kind_Component_Configuration); 3546-- Location_Copy (Res, Inst); 3547-- Set_Parent (Res, Parent); 3548-- Comp := Get_Instantiated_Unit (Inst); 3549 3550-- Set_Component_Name (Res, Comp); 3551-- -- Create the instantiation list with only one element: INST. 3552-- Designator := Create_Iir (Iir_Kind_Designator_List); 3553-- Append_Element (Designator, Inst); 3554-- Set_Instantiation_List (Res, Designator); 3555 3556-- Set_Binding_Indication (Res, Bind); 3557-- Aspect := Get_Entity_Aspect (Bind); 3558-- case Get_Kind (Aspect) is 3559-- when Iir_Kind_Entity_Aspect_Entity => 3560-- Add_Dependence (Config_Unit, Get_Entity (Aspect)); 3561-- if Get_Architecture (Aspect) /= Null_Iir then 3562-- raise Internal_Error; 3563-- end if; 3564-- when others => 3565-- Error_Kind ("Create_Default_Component_Configuration", Aspect); 3566-- end case; 3567 3568-- return Res; 3569-- end Create_Default_Component_Configuration; 3570 3571 -- Create a default configuration declaration for architecture ARCH. 3572 function Create_Default_Configuration_Declaration 3573 (Arch : Iir_Architecture_Body) return Iir_Design_Unit 3574 is 3575 Loc : constant Location_Type := Get_Location (Arch); 3576 Config : Iir_Configuration_Declaration; 3577 Res : Iir_Design_Unit; 3578 Blk_Cfg : Iir_Block_Configuration; 3579 begin 3580 Res := Create_Iir (Iir_Kind_Design_Unit); 3581 Set_Location (Res, Loc); 3582 Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch))); 3583 Set_Date_State (Res, Date_Analyze); 3584 Set_Date (Res, Date_Uptodate); 3585 3586 Config := Create_Iir (Iir_Kind_Configuration_Declaration); 3587 Set_Location (Config, Loc); 3588 Set_Library_Unit (Res, Config); 3589 Set_Design_Unit (Config, Res); 3590 Set_Entity_Name (Config, Get_Entity_Name (Arch)); 3591 Set_Dependence_List (Res, Create_Iir_List); 3592 Add_Dependence (Res, Get_Design_Unit (Get_Entity (Config))); 3593 Add_Dependence (Res, Get_Design_Unit (Arch)); 3594 3595 Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration); 3596 Set_Location (Blk_Cfg, Loc); 3597 Set_Parent (Blk_Cfg, Config); 3598 Set_Block_Specification (Blk_Cfg, Build_Simple_Name (Arch, Blk_Cfg)); 3599 Set_Block_Configuration (Config, Blk_Cfg); 3600 3601 Canon_Block_Configuration (Res, Blk_Cfg); 3602 3603 return Res; 3604 end Create_Default_Configuration_Declaration; 3605 3606end Vhdl.Canon; 3607