1-- Semantic analysis. 2-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16with Vhdl.Evaluation; use Vhdl.Evaluation; 17with Errorout; use Errorout; 18with Vhdl.Errors; use Vhdl.Errors; 19with Flags; use Flags; 20with Types; use Types; 21with Vhdl.Utils; use Vhdl.Utils; 22with Vhdl.Parse; 23with Std_Names; 24with Vhdl.Sem_Names; use Vhdl.Sem_Names; 25with Vhdl.Sem_Types; 26with Vhdl.Sem_Decls; 27with Vhdl.Std_Package; 28with Vhdl.Sem_Scopes; 29with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils; 30with Vhdl.Xrefs; 31 32package body Vhdl.Sem_Assocs is 33 function Rewrite_Non_Object_Association (Assoc : Iir; Inter : Iir) 34 return Iir 35 is 36 N_Assoc : Iir; 37 Actual : Iir; 38 begin 39 Actual := Get_Actual (Assoc); 40 case Get_Kind (Inter) is 41 when Iir_Kind_Interface_Package_Declaration => 42 N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package); 43 when Iir_Kind_Interface_Type_Declaration => 44 N_Assoc := Create_Iir (Iir_Kind_Association_Element_Type); 45 if Get_Kind (Actual) = Iir_Kind_Parenthesis_Name then 46 -- Convert parenthesis name to array subtype. 47 declare 48 N_Actual : Iir; 49 Sub_Assoc : Iir; 50 Indexes : Iir_List; 51 Old : Iir; 52 begin 53 N_Actual := Create_Iir (Iir_Kind_Array_Subtype_Definition); 54 Location_Copy (N_Actual, Actual); 55 Set_Subtype_Type_Mark (N_Actual, Get_Prefix (Actual)); 56 Sub_Assoc := Get_Association_Chain (Actual); 57 Indexes := Create_Iir_List; 58 while Is_Valid (Sub_Assoc) loop 59 if Get_Kind (Sub_Assoc) 60 /= Iir_Kind_Association_Element_By_Expression 61 then 62 Error_Msg_Sem 63 (+Sub_Assoc, "index constraint must be a range"); 64 else 65 if Get_Formal (Sub_Assoc) /= Null_Iir then 66 Error_Msg_Sem 67 (+Sub_Assoc, "formal part not allowed"); 68 end if; 69 Append_Element (Indexes, Get_Actual (Sub_Assoc)); 70 end if; 71 Old := Sub_Assoc; 72 Sub_Assoc := Get_Chain (Sub_Assoc); 73 Free_Iir (Old); 74 end loop; 75 Old := Actual; 76 Free_Iir (Old); 77 Set_Index_Constraint_List 78 (N_Actual, List_To_Flist (Indexes)); 79 Actual := N_Actual; 80 end; 81 end if; 82 when Iir_Kinds_Interface_Subprogram_Declaration => 83 N_Assoc := Create_Iir (Iir_Kind_Association_Element_Subprogram); 84 if Get_Kind (Actual) = Iir_Kind_String_Literal8 then 85 Actual := Vhdl.Parse.String_To_Operator_Symbol (Actual); 86 end if; 87 when Iir_Kind_Interface_Terminal_Declaration => 88 N_Assoc := Create_Iir (Iir_Kind_Association_Element_Terminal); 89 when others => 90 Error_Kind ("rewrite_non_object_association", Inter); 91 end case; 92 Location_Copy (N_Assoc, Assoc); 93 Set_Formal (N_Assoc, Get_Formal (Assoc)); 94 Set_Actual (N_Assoc, Actual); 95 Set_Chain (N_Assoc, Get_Chain (Assoc)); 96 Set_Whole_Association_Flag (N_Assoc, True); 97 Free_Iir (Assoc); 98 return N_Assoc; 99 end Rewrite_Non_Object_Association; 100 101 function Extract_Non_Object_Association 102 (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir 103 is 104 Inter : Iir; 105 Assoc : Iir; 106 -- N_Assoc : Iir; 107 Prev_Assoc : Iir; 108 Formal : Iir; 109 Res : Iir; 110 begin 111 Inter := Inter_Chain; 112 Assoc := Assoc_Chain; 113 Prev_Assoc := Null_Iir; 114 Res := Null_Iir; 115 116 -- Common case: only objects in interfaces. 117 while Is_Valid (Inter) loop 118 exit when Get_Kind (Inter) 119 not in Iir_Kinds_Interface_Object_Declaration; 120 Inter := Get_Chain (Inter); 121 end loop; 122 if Is_Null (Inter) then 123 -- Only interface object, nothing to to. 124 return Assoc_Chain; 125 end if; 126 127 Inter := Inter_Chain; 128 loop 129 -- Don't try to detect errors. 130 if Is_Null (Assoc) then 131 return Res; 132 end if; 133 134 Formal := Get_Formal (Assoc); 135 if Formal = Null_Iir then 136 -- Positional association. 137 138 if Inter = Null_Iir then 139 -- But after a named one. Be silent on that error. 140 null; 141 elsif Get_Kind (Inter) 142 not in Iir_Kinds_Interface_Object_Declaration 143 then 144 Assoc := Rewrite_Non_Object_Association (Assoc, Inter); 145 end if; 146 else 147 if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol) 148 then 149 -- A candidate. Search the corresponding interface. 150 Inter := Find_Name_In_Chain 151 (Inter_Chain, Get_Identifier (Formal)); 152 if Inter /= Null_Iir 153 and then 154 Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration 155 then 156 Assoc := Rewrite_Non_Object_Association (Assoc, Inter); 157 end if; 158 end if; 159 160 -- No more association by position. 161 Inter := Null_Iir; 162 end if; 163 164 if Prev_Assoc = Null_Iir then 165 Res := Assoc; 166 else 167 Set_Chain (Prev_Assoc, Assoc); 168 end if; 169 Prev_Assoc := Assoc; 170 Assoc := Get_Chain (Assoc); 171 if Is_Valid (Inter) then 172 Inter := Get_Chain (Inter); 173 end if; 174 end loop; 175 end Extract_Non_Object_Association; 176 177 -- Analyze all arguments of ASSOC_CHAIN 178 -- Return TRUE if no error. 179 function Sem_Actual_Of_Association_Chain (Assoc_Chain : Iir) 180 return Boolean 181 is 182 Has_Named : Boolean; 183 Ok : Boolean; 184 Assoc : Iir; 185 Res : Iir; 186 Formal : Iir; 187 begin 188 -- Analyze all arguments. 189 -- OK is false if there is an error during semantic of one of the 190 -- argument, but continue analyze. 191 Has_Named := False; 192 Ok := True; 193 Assoc := Assoc_Chain; 194 while Assoc /= Null_Iir loop 195 Formal := Get_Formal (Assoc); 196 if Formal /= Null_Iir then 197 Has_Named := True; 198 -- FIXME: check FORMAL is well composed. 199 elsif Has_Named then 200 -- FIXME: do the check in parser. 201 Error_Msg_Sem (+Assoc, "positional argument after named argument"); 202 Ok := False; 203 end if; 204 if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then 205 Res := Sem_Expression_Ov (Get_Actual (Assoc), Null_Iir); 206 if Res = Null_Iir then 207 Ok := False; 208 else 209 Set_Actual (Assoc, Res); 210 end if; 211 end if; 212 Assoc := Get_Chain (Assoc); 213 end loop; 214 return Ok; 215 end Sem_Actual_Of_Association_Chain; 216 217 procedure Check_Parameter_Association_Restriction 218 (Inter : Iir; Base_Actual : Iir; Loc : Iir) is 219 begin 220 case Iir_Parameter_Modes (Get_Mode (Inter)) is 221 when Iir_In_Mode => 222 if Can_Interface_Be_Read (Base_Actual) then 223 return; 224 end if; 225 when Iir_Out_Mode => 226 if Can_Interface_Be_Updated (Base_Actual) then 227 return; 228 end if; 229 when Iir_Inout_Mode => 230 if Can_Interface_Be_Read (Base_Actual) 231 and then Can_Interface_Be_Updated (Base_Actual) 232 then 233 return; 234 end if; 235 end case; 236 Error_Msg_Sem 237 (+Loc, "cannot associate an " & Get_Mode_Name (Get_Mode (Base_Actual)) 238 & " object with " & Get_Mode_Name (Get_Mode (Inter)) & " %n", 239 +Inter); 240 end Check_Parameter_Association_Restriction; 241 242 procedure Check_Subprogram_Associations 243 (Inter_Chain : Iir; Assoc_Chain : Iir) 244 is 245 Assoc : Iir; 246 Formal_Inter : Iir; 247 Actual : Iir; 248 Prefix : Iir; 249 Object : Iir; 250 Inter : Iir; 251 begin 252 Assoc := Assoc_Chain; 253 Inter := Inter_Chain; 254 while Assoc /= Null_Iir loop 255 Formal_Inter := Get_Association_Interface (Assoc, Inter); 256 case Get_Kind (Assoc) is 257 when Iir_Kind_Association_Element_Open => 258 if Get_Default_Value (Formal_Inter) = Null_Iir then 259 Error_Msg_Sem 260 (+Assoc, "no parameter for %n", +Formal_Inter); 261 end if; 262 when Iir_Kind_Association_Element_By_Expression => 263 Actual := Get_Actual (Assoc); 264 Object := Name_To_Object (Actual); 265 if Object /= Null_Iir then 266 Prefix := Get_Object_Prefix (Object); 267 else 268 Prefix := Actual; 269 end if; 270 271 case Get_Kind (Formal_Inter) is 272 when Iir_Kind_Interface_Signal_Declaration => 273 -- LRM93 2.1.1 274 -- In a subprogram call, the actual designator 275 -- associated with a formal parameter of class 276 -- signal must be a signal. 277 case Get_Kind (Prefix) is 278 when Iir_Kind_Interface_Signal_Declaration 279 | Iir_Kind_Signal_Declaration 280 | Iir_Kind_Guard_Signal_Declaration 281 | Iir_Kinds_Signal_Attribute => 282 -- LRM93 2.1.1.2 283 -- If an actual signal is associated with 284 -- a signal parameter of any mode, the actual 285 -- must be denoted by a static signal name. 286 if Get_Name_Staticness (Object) < Globally then 287 Error_Msg_Sem 288 (+Actual, 289 "actual signal must be a static name"); 290 else 291 -- Inherit has_active_flag. 292 Set_Has_Active_Flag 293 (Prefix, Get_Has_Active_Flag (Formal_Inter)); 294 end if; 295 when others => 296 Error_Msg_Sem 297 (+Assoc, 298 "signal parameter requires a signal expression"); 299 end case; 300 301 case Get_Kind (Prefix) is 302 when Iir_Kind_Interface_Signal_Declaration => 303 Check_Parameter_Association_Restriction 304 (Formal_Inter, Prefix, Assoc); 305 when Iir_Kind_Guard_Signal_Declaration => 306 if Get_Mode (Formal_Inter) /= Iir_In_Mode then 307 Error_Msg_Sem 308 (+Assoc, 309 "cannot associate a guard signal with " 310 & Get_Mode_Name (Get_Mode (Formal_Inter)) 311 & " %n", +Formal_Inter); 312 end if; 313 when Iir_Kinds_Signal_Attribute => 314 if Get_Mode (Formal_Inter) /= Iir_In_Mode then 315 Error_Msg_Sem 316 (+Assoc, 317 "cannot associate a signal attribute with " 318 & Get_Mode_Name (Get_Mode (Formal_Inter)) 319 & " %n", +Formal_Inter); 320 end if; 321 when others => 322 null; 323 end case; 324 325 -- LRM 2.1.1.2 Signal parameters 326 -- It is an error if a conversion function or type 327 -- conversion appears in either the formal part or the 328 -- actual part of an association element that associates 329 -- an actual signal with a formal signal parameter. 330 if Get_Actual_Conversion (Assoc) /= Null_Iir 331 or Get_Formal_Conversion (Assoc) /= Null_Iir 332 then 333 Error_Msg_Sem 334 (+Assoc, 335 "conversion are not allowed for signal parameters"); 336 end if; 337 when Iir_Kind_Interface_Variable_Declaration => 338 -- LRM93 2.1.1 339 -- The actual designator associated with a formal of 340 -- class variable must be a variable. 341 case Get_Kind (Prefix) is 342 when Iir_Kind_Interface_Variable_Declaration => 343 Check_Parameter_Association_Restriction 344 (Formal_Inter, Prefix, Assoc); 345 when Iir_Kind_Variable_Declaration 346 | Iir_Kind_Dereference 347 | Iir_Kind_Implicit_Dereference => 348 null; 349 when Iir_Kind_Interface_File_Declaration 350 | Iir_Kind_File_Declaration => 351 -- LRM87 4.3.1.4 352 -- Such an object is a member of the variable 353 -- class of objects; 354 if Flags.Vhdl_Std >= Vhdl_93 355 and then not Flags.Flag_Relaxed_Files87 356 then 357 Error_Msg_Sem 358 (+Assoc, "variable parameter cannot be a " 359 & "file (vhdl93)"); 360 end if; 361 when others => 362 Error_Msg_Sem 363 (+Assoc, "variable parameter must be a variable"); 364 end case; 365 when Iir_Kind_Interface_File_Declaration => 366 -- LRM93 2.1.1 367 -- The actual designator associated with a formal 368 -- of class file must be a file. 369 case Get_Kind (Prefix) is 370 when Iir_Kind_Interface_File_Declaration 371 | Iir_Kind_File_Declaration => 372 null; 373 when Iir_Kind_Variable_Declaration 374 | Iir_Kind_Interface_Variable_Declaration => 375 if Flags.Vhdl_Std >= Vhdl_93 376 and then not Flags.Flag_Relaxed_Files87 377 then 378 Error_Msg_Sem 379 (+Assoc, 380 "file parameter must be a file (vhdl93)"); 381 end if; 382 when others => 383 Error_Msg_Sem 384 (+Assoc, "file parameter must be a file"); 385 end case; 386 387 -- LRM 2.1.1.3 File parameters 388 -- It is an error if an association element associates 389 -- an actual with a formal parameter of a file type and 390 -- that association element contains a conversion 391 -- function or type conversion. 392 if Get_Actual_Conversion (Assoc) /= Null_Iir 393 or Get_Formal_Conversion (Assoc) /= Null_Iir 394 then 395 Error_Msg_Sem (+Assoc, "conversion are not allowed " 396 & "for file parameters"); 397 end if; 398 when Iir_Kind_Interface_Constant_Declaration => 399 -- LRM93 2.1.1 400 -- The actual designator associated with a formal of 401 -- class constant must be an expression. 402 -- GHDL: unless this is in a formal_part. 403 if not Get_In_Formal_Flag (Assoc) then 404 Check_Read (Actual); 405 end if; 406 when others => 407 Error_Kind 408 ("check_subprogram_association(3)", Formal_Inter); 409 end case; 410 411 case Get_Kind (Prefix) is 412 when Iir_Kind_Signal_Declaration 413 | Iir_Kind_Variable_Declaration => 414 Set_Use_Flag (Prefix, True); 415 when others => 416 null; 417 end case; 418 419 when Iir_Kind_Association_Element_By_Individual => 420 null; 421 when others => 422 Error_Kind ("check_subprogram_associations", Assoc); 423 end case; 424 Next_Association_Interface (Assoc, Inter); 425 end loop; 426 end Check_Subprogram_Associations; 427 428 -- Assocs_Right_Map (FORMAL_MODE, ACTUAL_MODE) is true iff it is allowed 429 -- to associate a formal port of mode FORMAL_MODE with an actual port of 430 -- mode ACTUAL_MODE. 431 subtype Iir_Known_Mode is Iir_Mode range Iir_Linkage_Mode .. Iir_In_Mode; 432 type Assocs_Right_Map is array (Iir_Known_Mode, Iir_Known_Mode) of Boolean; 433 434 -- LRM93 1.1.1.2 Ports 435 Vhdl93_Assocs_Map : constant Assocs_Right_Map := 436 (Iir_In_Mode => 437 (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 438 others => False), 439 Iir_Out_Mode => 440 (Iir_Out_Mode | Iir_Inout_Mode => True, 441 others => False), 442 Iir_Inout_Mode => 443 (Iir_Inout_Mode => True, 444 others => False), 445 Iir_Buffer_Mode => 446 (Iir_Buffer_Mode => True, others => False), 447 Iir_Linkage_Mode => 448 (others => True)); 449 450 -- LRM02 1.1.1.2 Ports 451 Vhdl02_Assocs_Map : constant Assocs_Right_Map := 452 (Iir_In_Mode => 453 (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 454 others => False), 455 Iir_Out_Mode => 456 (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 457 others => False), 458 Iir_Inout_Mode => 459 (Iir_Inout_Mode | Iir_Buffer_Mode => True, 460 others => False), 461 Iir_Buffer_Mode => 462 (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 463 others => False), 464 Iir_Linkage_Mode => 465 (others => True)); 466 467 -- LRM08 6.5.6.3 Port clauses 468 Vhdl08_Assocs_Map : constant Assocs_Right_Map := 469 (Iir_In_Mode => 470 (Iir_In_Mode | Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 471 others => False), 472 Iir_Out_Mode => 473 (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 474 others => False), 475 Iir_Inout_Mode => 476 (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 477 others => False), 478 Iir_Buffer_Mode => 479 (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True, 480 others => False), 481 Iir_Linkage_Mode => (others => True)); 482 483 -- Check for restrictions in LRM 1.1.1.2 484 -- Return FALSE in case of error. 485 function Check_Port_Association_Mode_Restrictions 486 (Formal : Iir_Interface_Signal_Declaration; 487 Actual : Iir_Interface_Signal_Declaration; 488 Assoc : Iir) 489 return Boolean 490 is 491 Fmode : constant Iir_Mode := Get_Mode (Formal); 492 Amode : constant Iir_Mode := Get_Mode (Actual); 493 begin 494 pragma Assert (Fmode /= Iir_Unknown_Mode); 495 pragma Assert (Amode /= Iir_Unknown_Mode); 496 497 case Flags.Vhdl_Std is 498 when Vhdl_87 | Vhdl_93 | Vhdl_00 => 499 if Vhdl93_Assocs_Map (Fmode, Amode) then 500 return True; 501 end if; 502 when Vhdl_02 => 503 if Vhdl02_Assocs_Map (Fmode, Amode) then 504 return True; 505 end if; 506 when Vhdl_08 => 507 if Vhdl08_Assocs_Map (Fmode, Amode) then 508 return True; 509 end if; 510 end case; 511 512 if Assoc /= Null_Iir then 513 Error_Msg_Sem 514 (+Assoc, "cannot associate " & Get_Mode_Name (Fmode) & " %n" 515 & " with actual port of mode " 516 & Get_Mode_Name (Amode), +Formal); 517 end if; 518 return False; 519 end Check_Port_Association_Mode_Restrictions; 520 521 -- Check restrictions of LRM02 12.2.4 522 procedure Check_Port_Association_Bounds_Restrictions 523 (Formal : Iir; Actual : Iir; Assoc : Iir) 524 is 525 Inter : constant Iir := Get_Object_Prefix (Formal, False); 526 527 function Is_Scalar_Type_Compatible (Src : Iir; Dest : Iir) 528 return Boolean 529 is 530 Src_Range : Iir; 531 Dst_Range : Iir; 532 begin 533 if Get_Kind (Src) not in Iir_Kinds_Scalar_Type_And_Subtype_Definition 534 then 535 return True; 536 end if; 537 538 Src_Range := Get_Range_Constraint (Src); 539 Dst_Range := Get_Range_Constraint (Dest); 540 if Get_Expr_Staticness (Src_Range) /= Locally 541 or else Get_Expr_Staticness (Dst_Range) /= Locally 542 then 543 return True; 544 end if; 545 546 -- FIXME: non-static bounds have to be checked at run-time 547 -- (during elaboration). 548 549 -- In vhdl08, the subtypes must be compatible. Use the that rule 550 -- for relaxed rules. 551 if Vhdl_Std >= Vhdl_08 552 or else Flag_Relaxed_Rules 553 then 554 return Eval_Is_Range_In_Bound (Src, Dest, True); 555 end if; 556 557 -- Prior vhdl08, the subtypes must be identical. 558 if not Eval_Is_Eq (Get_Left_Limit (Src_Range), 559 Get_Left_Limit (Dst_Range)) 560 or else not Eval_Is_Eq (Get_Right_Limit (Src_Range), 561 Get_Right_Limit (Dst_Range)) 562 or else Get_Direction (Src_Range) /= Get_Direction (Dst_Range) 563 then 564 return False; 565 end if; 566 567 return True; 568 end Is_Scalar_Type_Compatible; 569 570 procedure Error_Msg 571 is 572 Id : Msgid_Type; 573 Orig : Report_Origin; 574 begin 575 if Flag_Elaborate then 576 Id := Msgid_Error; 577 Orig := Elaboration; 578 else 579 Id := Warnid_Port_Bounds; 580 Orig := Semantic; 581 end if; 582 Report_Msg 583 (Id, Orig, +Assoc, 584 "bounds or direction of actual don't match with %n", 585 (1 => +Inter)); 586 end Error_Msg; 587 588 Ftype : constant Iir := Get_Type (Formal); 589 Atype : constant Iir := Get_Type (Actual); 590 F_Conv : constant Iir := Get_Formal_Conversion (Assoc); 591 A_Conv : constant Iir := Get_Actual_Conversion (Assoc); 592 F2a_Type : Iir; 593 A2f_Type : Iir; 594 begin 595 -- LRM02 12.2.4 The port map aspect 596 -- If an actual signal is associated with a port of any mode, and if 597 -- the type of the formal is a scalar type, then it is an error if 598 -- (after applying any conversion function or type conversion 599 -- expression present in the actual part) the bounds and direction of 600 -- the subtype denoted by the subtype indication of the formal are not 601 -- identical to the bounds and direction of the subtype denoted by the 602 -- subtype indication of the actual. 603 604 -- LRM08 14.3.5 Port map aspect 605 -- If an actual signal is associated with a port of mode IN or INOUT, 606 -- and if the type of the formal is a scalar type, then it is an error 607 -- if (after applying any conversion function or type conversion 608 -- expression present in the actual part) the subtype of the actual is 609 -- not compatible with the subtype of the formal. [...] 610 -- 611 -- Similarly, if an actual signal is associated with a port of mode 612 -- OUT, INOUT, or BUFFER, and the type of the actual is a scalar type, 613 -- then it is an error if (after applying any conversion function or 614 -- type conversion expression present in the formal part) the subtype 615 -- or the formal is not compatible with the subtype of the actual. 616 if Is_Valid (F_Conv) then 617 F2a_Type := Get_Type (F_Conv); 618 else 619 F2a_Type := Ftype; 620 end if; 621 if Is_Valid (A_Conv) then 622 A2f_Type := Get_Type (A_Conv); 623 else 624 A2f_Type := Atype; 625 end if; 626 if Get_Mode (Inter) in Iir_In_Modes 627 and then not Is_Scalar_Type_Compatible (A2f_Type, Ftype) 628 then 629 Error_Msg; 630 end if; 631 if Get_Mode (Inter) in Iir_Out_Modes 632 and then not Is_Scalar_Type_Compatible (F2a_Type, Atype) 633 then 634 Error_Msg; 635 end if; 636 end Check_Port_Association_Bounds_Restrictions; 637 638 -- Handle indexed name 639 -- FORMAL is the formal name to be handled. 640 -- BASE_ASSOC is an association_by_individual in which the formal will be 641 -- inserted. 642 procedure Add_Individual_Assoc_Indexed_Name 643 (Choice : out Iir; Base_Assoc : Iir; Formal : Iir) 644 is 645 Index_List : constant Iir_Flist := Get_Index_List (Formal); 646 Nbr : constant Natural := Get_Nbr_Elements (Index_List); 647 Last_Choice : Iir; 648 Index : Iir; 649 Staticness : Iir_Staticness; 650 Sub_Assoc : Iir; 651 begin 652 -- Find element. 653 Sub_Assoc := Base_Assoc; 654 for I in 0 .. Nbr - 1 loop 655 Index := Get_Nth_Element (Index_List, I); 656 657 -- Evaluate index. 658 Staticness := Get_Expr_Staticness (Index); 659 if Staticness = Locally then 660 Index := Eval_Expr (Index); 661 Set_Nth_Element (Index_List, I, Index); 662 else 663 Error_Msg_Sem (+Index, "index expression must be locally static"); 664 Set_Choice_Staticness (Base_Assoc, None); 665 end if; 666 667 -- Find index in choice list. 668 Last_Choice := Null_Iir; 669 Choice := Get_Individual_Association_Chain (Sub_Assoc); 670 while Choice /= Null_Iir loop 671 case Get_Kind (Choice) is 672 when Iir_Kind_Choice_By_Expression => 673 if Eval_Pos (Get_Choice_Expression (Choice)) 674 = Eval_Pos (Index) 675 then 676 goto Found; 677 end if; 678 when Iir_Kind_Choice_By_Range => 679 declare 680 Choice_Range : constant Iir := Get_Choice_Range (Choice); 681 begin 682 if Get_Expr_Staticness (Choice_Range) = Locally 683 and then 684 Eval_Int_In_Range (Eval_Pos (Index), Choice_Range) 685 then 686 -- FIXME: overlap. 687 raise Internal_Error; 688 end if; 689 end; 690 when others => 691 Error_Kind ("add_individual_assoc_index_name", Choice); 692 end case; 693 Last_Choice := Choice; 694 Choice := Get_Chain (Choice); 695 end loop; 696 697 -- If not found, append it. 698 Choice := Create_Iir (Iir_Kind_Choice_By_Expression); 699 Set_Choice_Expression (Choice, Index); 700 Set_Choice_Staticness (Choice, Staticness); 701 Location_Copy (Choice, Formal); 702 if Last_Choice = Null_Iir then 703 Set_Individual_Association_Chain (Sub_Assoc, Choice); 704 else 705 Set_Chain (Last_Choice, Choice); 706 end if; 707 708 << Found >> null; 709 710 if I < Nbr - 1 then 711 -- Create an intermediate assoc by individual. 712 Sub_Assoc := Get_Associated_Expr (Choice); 713 if Sub_Assoc = Null_Iir then 714 Sub_Assoc := Create_Iir 715 (Iir_Kind_Association_Element_By_Individual); 716 Location_Copy (Sub_Assoc, Index); 717 Set_Associated_Expr (Choice, Sub_Assoc); 718 Set_Choice_Staticness (Sub_Assoc, Locally); 719 end if; 720 end if; 721 end loop; 722 end Add_Individual_Assoc_Indexed_Name; 723 724 procedure Add_Individual_Assoc_Slice_Name 725 (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir) 726 is 727 Index : Iir; 728 Staticness : Iir_Staticness; 729 begin 730 -- FIXME: handle cases such as param(5 to 6)(5) 731 732 -- Find element. 733 Index := Get_Suffix (Formal); 734 735 -- Evaluate index. 736 Staticness := Get_Expr_Staticness (Index); 737 if Staticness = Locally then 738 Index := Eval_Range (Index); 739 Set_Suffix (Formal, Index); 740 else 741 Error_Msg_Sem (+Index, "range expression must be locally static"); 742 Set_Choice_Staticness (Sub_Assoc, None); 743 end if; 744 745 Choice := Create_Iir (Iir_Kind_Choice_By_Range); 746 Location_Copy (Choice, Formal); 747 Set_Choice_Range (Choice, Index); 748 Set_Chain (Choice, Get_Individual_Association_Chain (Sub_Assoc)); 749 Set_Choice_Staticness (Choice, Staticness); 750 Set_Individual_Association_Chain (Sub_Assoc, Choice); 751 end Add_Individual_Assoc_Slice_Name; 752 753 procedure Add_Individual_Assoc_Selected_Name 754 (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir) 755 is 756 Element : constant Iir := Get_Named_Entity (Formal); 757 Last_Choice : Iir; 758 begin 759 -- Try to find the existing choice. 760 Last_Choice := Null_Iir; 761 Choice := Get_Individual_Association_Chain (Sub_Assoc); 762 while Choice /= Null_Iir loop 763 if Get_Choice_Name (Choice) = Element then 764 return; 765 end if; 766 Last_Choice := Choice; 767 Choice := Get_Chain (Choice); 768 end loop; 769 770 -- If not found, append it. 771 Choice := Create_Iir (Iir_Kind_Choice_By_Name); 772 Location_Copy (Choice, Formal); 773 Set_Choice_Name (Choice, Element); 774 if Last_Choice = Null_Iir then 775 Set_Individual_Association_Chain (Sub_Assoc, Choice); 776 else 777 Set_Chain (Last_Choice, Choice); 778 end if; 779 end Add_Individual_Assoc_Selected_Name; 780 781 -- Subroutine of Add_Individual_Association. 782 -- Search/build the tree of choices for FORMAL, starting for IASSOC. 783 -- The root of the tree is an association by individual node. Each node 784 -- points to a chain of choices, whose associated expression is either an 785 -- association by individual (and the tree continue) or an association 786 -- by expression coming from the initial association (and this is a leaf). 787 procedure Add_Individual_Association_1 788 (Iassoc : in out Iir; Formal : Iir; Last : Boolean) 789 is 790 Base_Assoc : constant Iir := Iassoc; 791 Formal_Object : constant Iir := Name_To_Object (Formal); 792 Sub : Iir; 793 Choice : Iir; 794 begin 795 pragma Assert 796 (Get_Kind (Iassoc) = Iir_Kind_Association_Element_By_Individual); 797 798 -- Recurse to start from the basename of the formal. 799 case Get_Kind (Formal_Object) is 800 when Iir_Kind_Indexed_Name 801 | Iir_Kind_Slice_Name 802 | Iir_Kind_Selected_Element => 803 Add_Individual_Association_1 804 (Iassoc, Get_Prefix (Formal_Object), False); 805 when Iir_Kinds_Interface_Object_Declaration => 806 -- At the root of the formal. 807 pragma Assert 808 (Formal_Object = Get_Named_Entity (Get_Formal (Iassoc))); 809 return; 810 when others => 811 Error_Kind ("add_individual_association_1", Formal); 812 end case; 813 814 -- Add the choices for the indexes/slice/element. 815 case Get_Kind (Formal_Object) is 816 when Iir_Kind_Indexed_Name => 817 Add_Individual_Assoc_Indexed_Name (Choice, Iassoc, Formal_Object); 818 when Iir_Kind_Slice_Name => 819 Add_Individual_Assoc_Slice_Name (Choice, Iassoc, Formal_Object); 820 when Iir_Kind_Selected_Element => 821 Add_Individual_Assoc_Selected_Name (Choice, Iassoc, Formal_Object); 822 when others => 823 Error_Kind ("add_individual_association_1(3)", Formal); 824 end case; 825 826 Sub := Get_Associated_Expr (Choice); 827 if Sub = Null_Iir then 828 if not Last then 829 -- Create the individual association for the choice. 830 Sub := Create_Iir (Iir_Kind_Association_Element_By_Individual); 831 Location_Copy (Sub, Formal); 832 Set_Choice_Staticness (Sub, Locally); 833 Set_Formal (Sub, Formal); 834 Set_Associated_Expr (Choice, Sub); 835 end if; 836 else 837 if Last 838 or else Get_Kind (Sub) /= Iir_Kind_Association_Element_By_Individual 839 then 840 -- A final association. 841 pragma Assert 842 (Get_Kind (Sub) = Iir_Kind_Association_Element_By_Expression); 843 Error_Msg_Sem 844 (+Formal, "individual association of %n" 845 & " conflicts with that at %l", 846 (+Get_Interface_Of_Formal (Get_Formal (Iassoc)), 847 +Sub)); 848 else 849 if Get_Choice_Staticness (Sub) /= Locally then 850 -- Propagate error. 851 Set_Choice_Staticness (Base_Assoc, None); 852 end if; 853 end if; 854 end if; 855 856 if Last then 857 Iassoc := Choice; 858 else 859 Iassoc := Sub; 860 end if; 861 end Add_Individual_Association_1; 862 863 -- Insert ASSOC into the tree of individual assoc rooted by IASSOC. 864 -- This is done so that duplicate or missing associations are found (using 865 -- the same routine for aggregate/case statement). 866 procedure Add_Individual_Association (Iassoc : Iir; Assoc : Iir) 867 is 868 Formal : constant Iir := Get_Formal (Assoc); 869 Res_Iass : Iir; 870 Prev : Iir; 871 begin 872 -- Create the individual association for the formal. 873 Res_Iass := Iassoc; 874 Add_Individual_Association_1 (Res_Iass, Formal, True); 875 876 Prev := Get_Associated_Expr (Res_Iass); 877 if Prev = Null_Iir then 878 Set_Associated_Expr (Res_Iass, Assoc); 879 end if; 880 end Add_Individual_Association; 881 882 procedure Finish_Individual_Association1 (Assoc : Iir; Atype : Iir); 883 884 procedure Finish_Individual_Assoc_Array_Subtype 885 (Assoc : Iir; Atype : Iir; Dim : Positive) 886 is 887 Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Atype); 888 Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist); 889 Index_Type : constant Iir := Get_Nth_Element (Index_Tlist, Dim - 1); 890 Chain : constant Iir := Get_Individual_Association_Chain (Assoc); 891 Low, High : Iir; 892 El_Type : Iir; 893 El : Iir; 894 begin 895 Sem_Check_Continuous_Choices 896 (Chain, Index_Type, Low, High, Get_Location (Assoc), False); 897 if Dim < Nbr_Dims then 898 El := Chain; 899 while El /= Null_Iir loop 900 pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Expression); 901 Finish_Individual_Assoc_Array_Subtype 902 (Get_Associated_Expr (El), Atype, Dim + 1); 903 El := Get_Chain (El); 904 end loop; 905 else 906 El_Type := Get_Element_Subtype (Atype); 907 El := Chain; 908 while El /= Null_Iir loop 909 Finish_Individual_Association1 910 (Get_Associated_Expr (El), El_Type); 911 El := Get_Chain (El); 912 end loop; 913 end if; 914 end Finish_Individual_Assoc_Array_Subtype; 915 916 procedure Finish_Individual_Assoc_Array 917 (Actual : Iir; Assoc : Iir; Dim : Natural) 918 is 919 Actual_Type : constant Iir := Get_Actual_Type (Actual); 920 Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Actual_Type); 921 Actual_Index : Iir; 922 Base_Type : Iir; 923 Base_Index : Iir; 924 Low, High : Iir; 925 Chain : Iir; 926 begin 927 Actual_Index := Get_Nth_Element (Index_Tlist, Dim - 1); 928 if Actual_Index /= Null_Iir then 929 Base_Index := Actual_Index; 930 else 931 Base_Type := Get_Base_Type (Actual_Type); 932 Base_Index := Get_Index_Type (Base_Type, Dim - 1); 933 end if; 934 Chain := Get_Individual_Association_Chain (Assoc); 935 Sem_Choices_Range 936 (Chain, Base_Index, Low, High, Get_Location (Assoc), True, False); 937 Set_Individual_Association_Chain (Assoc, Chain); 938 if Actual_Index = Null_Iir then 939 declare 940 Index_Constraint : Iir; 941 Index_Subtype_Constraint : Iir; 942 begin 943 -- Create an index subtype. 944 case Get_Kind (Base_Index) is 945 when Iir_Kind_Integer_Subtype_Definition => 946 Actual_Index := 947 Create_Iir (Iir_Kind_Integer_Subtype_Definition); 948 when Iir_Kind_Enumeration_Type_Definition 949 | Iir_Kind_Enumeration_Subtype_Definition => 950 Actual_Index := 951 Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); 952 when others => 953 Error_Kind ("finish_individual_assoc_array", Base_Index); 954 end case; 955 Location_Copy (Actual_Index, Actual); 956 Set_Parent_Type (Actual_Index, Base_Index); 957 Index_Constraint := Get_Range_Constraint (Base_Index); 958 959 Index_Subtype_Constraint := Create_Iir (Iir_Kind_Range_Expression); 960 Location_Copy (Index_Subtype_Constraint, Actual); 961 Set_Range_Constraint (Actual_Index, Index_Subtype_Constraint); 962 Set_Type_Staticness (Actual_Index, Locally); 963 Set_Direction (Index_Subtype_Constraint, 964 Get_Direction (Index_Constraint)); 965 966 -- For ownership purpose, the bounds must be copied otherwise 967 -- they would be referenced before being defined. This is non 968 -- optimal but it doesn't happen often. 969 Low := Copy_Constant (Low); 970 High := Copy_Constant (High); 971 972 case Get_Direction (Index_Constraint) is 973 when Dir_To => 974 Set_Left_Limit (Index_Subtype_Constraint, Low); 975 Set_Left_Limit_Expr (Index_Subtype_Constraint, Low); 976 Set_Right_Limit (Index_Subtype_Constraint, High); 977 Set_Right_Limit_Expr (Index_Subtype_Constraint, High); 978 when Dir_Downto => 979 Set_Left_Limit (Index_Subtype_Constraint, High); 980 Set_Left_Limit_Expr (Index_Subtype_Constraint, High); 981 Set_Right_Limit (Index_Subtype_Constraint, Low); 982 Set_Right_Limit_Expr (Index_Subtype_Constraint, Low); 983 end case; 984 Set_Expr_Staticness (Index_Subtype_Constraint, Locally); 985 Set_Nth_Element (Get_Index_Subtype_List (Actual_Type), Dim - 1, 986 Actual_Index); 987 end; 988 else 989 declare 990 Act_High, Act_Low : Iir; 991 begin 992 Get_Low_High_Limit (Get_Range_Constraint (Actual_Type), 993 Act_Low, Act_High); 994 if Eval_Pos (Act_Low) /= Eval_Pos (Low) 995 or Eval_Pos (Act_High) /= Eval_Pos (High) 996 then 997 Error_Msg_Sem 998 (+Assoc, "indexes of individual association mismatch"); 999 end if; 1000 end; 1001 end if; 1002 1003 declare 1004 Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist); 1005 El_Type : Iir; 1006 El : Iir; 1007 begin 1008 if Dim = Nbr_Dims then 1009 El_Type := Get_Element_Subtype (Actual_Type); 1010 El := Chain; 1011 while El /= Null_Iir loop 1012 Finish_Individual_Association1 1013 (Get_Associated_Expr (El), El_Type); 1014 El := Get_Chain (El); 1015 end loop; 1016 end if; 1017 end; 1018 end Finish_Individual_Assoc_Array; 1019 1020 procedure Finish_Individual_Assoc_Record (Assoc : Iir; Atype : Iir) 1021 is 1022 El_List : constant Iir_Flist := Get_Elements_Declaration_List (Atype); 1023 Nbr_El : constant Natural := Get_Nbr_Elements (El_List); 1024 Matches : Iir_Array (0 .. Nbr_El - 1); 1025 Ch : Iir; 1026 Pos : Natural; 1027 Rec_El : Iir; 1028 begin 1029 -- Check for duplicate associations. 1030 Matches := (others => Null_Iir); 1031 Ch := Get_Individual_Association_Chain (Assoc); 1032 while Ch /= Null_Iir loop 1033 Rec_El := Get_Choice_Name (Ch); 1034 Pos := Natural (Get_Element_Position (Rec_El)); 1035 if Matches (Pos) /= Null_Iir then 1036 Error_Msg_Sem (+Ch, "individual %n already associated at %l", 1037 (+Rec_El, +Matches (Pos))); 1038 else 1039 Matches (Pos) := Ch; 1040 end if; 1041 Ch := Get_Chain (Ch); 1042 end loop; 1043 1044 -- Check for missing associations. 1045 for I in Matches'Range loop 1046 Rec_El := Get_Nth_Element (El_List, I); 1047 if Matches (I) = Null_Iir then 1048 Error_Msg_Sem (+Assoc, "%n not associated", +Rec_El); 1049 else 1050 Finish_Individual_Association1 1051 (Get_Associated_Expr (Matches (I)), Get_Type (Rec_El)); 1052 end if; 1053 end loop; 1054 1055 if Get_Constraint_State (Atype) /= Fully_Constrained then 1056 -- Some (sub-)elements are unbounded, create a bounded subtype. 1057 declare 1058 Inter : constant Iir := 1059 Get_Interface_Of_Formal (Get_Formal (Assoc)); 1060 Ntype : Iir; 1061 Nel_List : Iir_Flist; 1062 Nrec_El : Iir; 1063 Rec_El_Type : Iir; 1064 Staticness : Iir_Staticness; 1065 Assoc_Expr : Iir; 1066 Assoc_Type : Iir; 1067 begin 1068 Ntype := Create_Iir (Iir_Kind_Record_Subtype_Definition); 1069 Set_Is_Ref (Ntype, True); 1070 Location_Copy (Ntype, Assoc); 1071 Set_Parent_Type (Ntype, Atype); 1072 if Get_Kind (Atype) = Iir_Kind_Record_Subtype_Definition then 1073 Set_Resolution_Indication 1074 (Ntype, Get_Resolution_Indication (Atype)); 1075 end if; 1076 if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration 1077 then 1078 -- The subtype is used for signals. 1079 Set_Has_Signal_Flag (Ntype, True); 1080 end if; 1081 1082 Nel_List := Create_Iir_Flist (Nbr_El); 1083 Set_Elements_Declaration_List (Ntype, Nel_List); 1084 1085 Staticness := Locally; 1086 for I in Matches'Range loop 1087 Rec_El := Get_Nth_Element (El_List, I); 1088 Rec_El_Type := Get_Type (Rec_El); 1089 if (Get_Kind (Rec_El_Type) 1090 not in Iir_Kinds_Composite_Type_Definition) 1091 or else 1092 Get_Constraint_State (Rec_El_Type) = Fully_Constrained 1093 or else 1094 Matches (I) = Null_Iir -- In case of error. 1095 then 1096 Nrec_El := Rec_El; 1097 else 1098 Nrec_El := Create_Iir (Iir_Kind_Record_Element_Constraint); 1099 Ch := Matches (I); 1100 Location_Copy (Nrec_El, Ch); 1101 Set_Parent (Nrec_El, Ntype); 1102 Set_Identifier (Nrec_El, Get_Identifier (Rec_El)); 1103 pragma Assert (I = Natural (Get_Element_Position (Rec_El))); 1104 Set_Element_Position (Nrec_El, Iir_Index32 (I)); 1105 Assoc_Expr := Get_Associated_Expr (Ch); 1106 if (Get_Kind (Assoc_Expr) 1107 = Iir_Kind_Association_Element_By_Individual) 1108 then 1109 Assoc_Type := Get_Actual_Type (Assoc_Expr); 1110 Set_Subtype_Indication (Nrec_El, Assoc_Type); 1111 else 1112 Assoc_Type := Get_Type (Get_Actual (Assoc_Expr)); 1113 end if; 1114 Set_Type (Nrec_El, Assoc_Type); 1115 Append_Owned_Element_Constraint (Ntype, Nrec_El); 1116 end if; 1117 Staticness := Min (Staticness, 1118 Get_Type_Staticness (Get_Type (Nrec_El))); 1119 Set_Nth_Element (Nel_List, I, Nrec_El); 1120 end loop; 1121 Set_Type_Staticness (Ntype, Staticness); 1122 Set_Constraint_State (Ntype, Fully_Constrained); 1123 1124 Set_Actual_Type (Assoc, Ntype); 1125 Set_Actual_Type_Definition (Assoc, Ntype); 1126 end; 1127 else 1128 Set_Actual_Type (Assoc, Atype); 1129 end if; 1130 end Finish_Individual_Assoc_Record; 1131 1132 -- Free recursively all the choices of ASSOC. Once the type is computed 1133 -- this is not needed anymore. 1134 procedure Clean_Individual_Association (Assoc : Iir) 1135 is 1136 El, N_El : Iir; 1137 Expr : Iir; 1138 begin 1139 El := Get_Individual_Association_Chain (Assoc); 1140 Set_Individual_Association_Chain (Assoc, Null_Iir); 1141 1142 while Is_Valid (El) loop 1143 N_El := Get_Chain (El); 1144 1145 pragma Assert (Get_Kind (El) in Iir_Kinds_Choice); 1146 Expr := Get_Associated_Expr (El); 1147 if Get_Kind (Expr) = Iir_Kind_Association_Element_By_Individual then 1148 Clean_Individual_Association (Expr); 1149 Free_Iir (Expr); 1150 end if; 1151 1152 Free_Iir (El); 1153 El := N_El; 1154 end loop; 1155 end Clean_Individual_Association; 1156 1157 procedure Finish_Individual_Association1 (Assoc : Iir; Atype : Iir) 1158 is 1159 Ntype : Iir; 1160 begin 1161 if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then 1162 -- End of recursion. The association is an element association, 1163 -- not an individual one. 1164 return; 1165 end if; 1166 1167 case Get_Kind (Atype) is 1168 when Iir_Kind_Array_Subtype_Definition 1169 | Iir_Kind_Array_Type_Definition => 1170 if Get_Constraint_State (Atype) = Fully_Constrained then 1171 Finish_Individual_Assoc_Array_Subtype (Assoc, Atype, 1); 1172 Set_Actual_Type (Assoc, Atype); 1173 else 1174 Ntype := Create_Array_Subtype (Atype, Get_Location (Assoc)); 1175 Set_Index_Constraint_Flag (Ntype, True); 1176 Set_Constraint_State (Ntype, Fully_Constrained); 1177 Set_Has_Signal_Flag (Ntype, Get_Has_Signal_Flag (Atype)); 1178 Set_Actual_Type (Assoc, Ntype); 1179 Set_Actual_Type_Definition (Assoc, Ntype); 1180 Finish_Individual_Assoc_Array (Assoc, Assoc, 1); 1181 end if; 1182 when Iir_Kind_Record_Type_Definition 1183 | Iir_Kind_Record_Subtype_Definition => 1184 Finish_Individual_Assoc_Record (Assoc, Atype); 1185 when Iir_Kinds_Scalar_Type_And_Subtype_Definition => 1186 null; 1187 when others => 1188 Error_Kind ("finish_individual_association", Atype); 1189 end case; 1190 end Finish_Individual_Association1; 1191 1192 -- Called by sem_individual_association to finish the analyze of 1193 -- individual association ASSOC: compute bounds, detect missing elements. 1194 procedure Finish_Individual_Association (Assoc : Iir) 1195 is 1196 Inter : Iir; 1197 Atype : Iir; 1198 begin 1199 -- Guard. 1200 if Get_Choice_Staticness (Assoc) /= Locally then 1201 return; 1202 end if; 1203 1204 Inter := Get_Interface_Of_Formal (Get_Formal (Assoc)); 1205 Atype := Get_Type (Inter); 1206 Set_Whole_Association_Flag (Assoc, True); 1207 1208 Finish_Individual_Association1 (Assoc, Atype); 1209 1210 -- Free the hierarchy, keep only the top individual association. 1211 Clean_Individual_Association (Assoc); 1212 end Finish_Individual_Association; 1213 1214 -- Sem individual associations of ASSOCS: 1215 -- Add an Iir_Kind_Association_Element_By_Individual before each 1216 -- group of individual association for the same formal, and call 1217 -- Finish_Individual_Association with each of these added nodes. 1218 -- 1219 -- The purpose of By_Individual association is to have the type of the 1220 -- actual (might be an array subtype), and also to be sure that all 1221 -- sub-elements are associated. For that a tree is created. The tree is 1222 -- rooted by the top Association_Element_By_Individual, which contains a 1223 -- chain of choices (like the aggregate). The child of a choice is either 1224 -- an Association_Element written by the user, or a new subtree rooted 1225 -- by another Association_Element_By_Individual. The tree doesn't 1226 -- follow all the ownership rules: the formal of sub association_element 1227 -- are directly set to the association, and the associated_expr of the 1228 -- choices are directly set to formals. 1229 -- 1230 -- This tree is temporary (used only during analysis of the individual 1231 -- association) and removed once the check is done. 1232 procedure Sem_Individual_Association (Assoc_Chain : in out Iir) 1233 is 1234 Assoc : Iir; 1235 Prev_Assoc : Iir; 1236 Iassoc : Iir_Association_Element_By_Individual; 1237 Cur_Iface : Iir; 1238 Formal : Iir; 1239 begin 1240 Iassoc := Null_Iir; 1241 Cur_Iface := Null_Iir; 1242 Prev_Assoc := Null_Iir; 1243 Assoc := Assoc_Chain; 1244 while Assoc /= Null_Iir loop 1245 Formal := Get_Formal (Assoc); 1246 if Formal /= Null_Iir then 1247 Formal := Get_Object_Prefix (Formal); 1248 end if; 1249 if Formal = Null_Iir or else Formal /= Cur_Iface then 1250 -- New formal name, analyze the current individual association 1251 -- (if any). 1252 if Iassoc /= Null_Iir then 1253 Finish_Individual_Association (Iassoc); 1254 end if; 1255 Cur_Iface := Formal; 1256 Iassoc := Null_Iir; 1257 end if; 1258 1259 if Get_Whole_Association_Flag (Assoc) = False then 1260 -- Individual association. 1261 if Iassoc = Null_Iir then 1262 -- The first one for the interface: create a new individual 1263 -- association. 1264 Iassoc := 1265 Create_Iir (Iir_Kind_Association_Element_By_Individual); 1266 Location_Copy (Iassoc, Assoc); 1267 Set_Choice_Staticness (Iassoc, Locally); 1268 pragma Assert (Cur_Iface /= Null_Iir); 1269 Set_Formal 1270 (Iassoc, 1271 Build_Simple_Name (Cur_Iface, Get_Location (Formal))); 1272 -- Insert IASSOC. 1273 if Prev_Assoc = Null_Iir then 1274 Assoc_Chain := Iassoc; 1275 else 1276 Set_Chain (Prev_Assoc, Iassoc); 1277 end if; 1278 Set_Chain (Iassoc, Assoc); 1279 end if; 1280 1281 -- Add this individual association to the tree. 1282 Add_Individual_Association (Iassoc, Assoc); 1283 end if; 1284 Prev_Assoc := Assoc; 1285 Assoc := Get_Chain (Assoc); 1286 end loop; 1287 -- There is maybe a remaining iassoc. 1288 if Iassoc /= Null_Iir then 1289 Finish_Individual_Association (Iassoc); 1290 end if; 1291 end Sem_Individual_Association; 1292 1293 function Is_Conversion_Function (Assoc_Chain : Iir) return Boolean is 1294 begin 1295 -- [...] whose single parameter of the function [...] 1296 if not Is_Chain_Length_One (Assoc_Chain) then 1297 return False; 1298 end if; 1299 if Get_Kind (Assoc_Chain) /= Iir_Kind_Association_Element_By_Expression 1300 then 1301 return False; 1302 end if; 1303 -- FIXME: unfortunatly, the formal may already be set with the 1304 -- interface. 1305-- if Get_Formal (Assoc_Chain) /= Null_Iir then 1306-- return Null_Iir; 1307-- end if; 1308 return True; 1309 end Is_Conversion_Function; 1310 1311 function Is_Valid_Type_Conversion 1312 (Conv : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean 1313 is 1314 Atype : constant Iir := Get_Type (Conv); 1315 begin 1316 return Get_Base_Type (Atype) = Res_Base_Type 1317 and then Are_Types_Closely_Related (Atype, Param_Base_Type); 1318 end Is_Valid_Type_Conversion; 1319 1320 function Is_Valid_Function_Conversion 1321 (Call : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean 1322 is 1323 Imp : constant Iir := Get_Implementation (Call); 1324 Res_Type : constant Iir := Get_Type (Imp); 1325 Inters : constant Iir := Get_Interface_Declaration_Chain (Imp); 1326 Param_Type : Iir; 1327 begin 1328 if Inters = Null_Iir then 1329 return False; 1330 end if; 1331 Param_Type := Get_Type (Inters); 1332 1333 return Get_Base_Type (Res_Type) = Res_Base_Type 1334 and then Get_Base_Type (Param_Type) = Param_Base_Type; 1335 end Is_Valid_Function_Conversion; 1336 1337 function Is_Valid_Conversion 1338 (Func : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean is 1339 begin 1340 case Get_Kind (Func) is 1341 when Iir_Kind_Function_Call => 1342 return Is_Valid_Function_Conversion 1343 (Func, Res_Base_Type, Param_Base_Type); 1344 when Iir_Kind_Type_Conversion => 1345 return Is_Valid_Type_Conversion 1346 (Func, Res_Base_Type, Param_Base_Type); 1347 when others => 1348 Error_Kind ("is_valid_conversion", Func); 1349 end case; 1350 end Is_Valid_Conversion; 1351 1352 function Extract_Conversion 1353 (Conv : Iir; Res_Type : Iir; Param_Type : Iir; Loc : Iir) return Iir 1354 is 1355 List : Iir_List; 1356 It : List_Iterator; 1357 Res_Base_Type : Iir; 1358 Param_Base_Type : Iir; 1359 El : Iir; 1360 Res : Iir; 1361 begin 1362 Res_Base_Type := Get_Base_Type (Res_Type); 1363 if Param_Type = Null_Iir then 1364 -- In case of error. 1365 return Null_Iir; 1366 end if; 1367 Param_Base_Type := Get_Base_Type (Param_Type); 1368 if Is_Overload_List (Conv) then 1369 List := Get_Overload_List (Conv); 1370 Res := Null_Iir; 1371 It := List_Iterate (List); 1372 while Is_Valid (It) loop 1373 El := Get_Element (It); 1374 if Is_Valid_Conversion (El, Res_Base_Type, Param_Base_Type) then 1375 if Res /= Null_Iir then 1376 raise Internal_Error; 1377 end if; 1378 Free_Iir (Conv); 1379 Res := El; 1380 end if; 1381 Next (It); 1382 end loop; 1383 else 1384 if Is_Valid_Conversion (Conv, Res_Base_Type, Param_Base_Type) then 1385 Res := Conv; 1386 else 1387 Error_Msg_Sem (+Loc, "conversion function or type does not match"); 1388 return Null_Iir; 1389 end if; 1390 end if; 1391 1392 if Get_Kind (Res) = Iir_Kind_Function_Call then 1393 declare 1394 Imp : constant Iir := Get_Implementation (Res); 1395 Inter : constant Iir := Get_Interface_Declaration_Chain (Imp); 1396 begin 1397 if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then 1398 Error_Msg_Sem 1399 (+Loc, "interface of function must be a constant interface"); 1400 end if; 1401 if Get_Chain (Inter) /= Null_Iir then 1402 -- LRM08 6.5.7 Association lists 1403 -- In this case, the function name shall denote a function 1404 -- whose single parameter is of the type of the formal 1405 -- and [...] 1406 Error_Msg_Sem 1407 (+Loc, "conversion function must have only one parameter"); 1408 end if; 1409 end; 1410 end if; 1411 1412 return Res; 1413 end Extract_Conversion; 1414 1415 function Extract_In_Conversion 1416 (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir 1417 is 1418 Func : Iir; 1419 Assoc : Iir; 1420 begin 1421 if Conv = Null_Iir then 1422 return Null_Iir; 1423 end if; 1424 Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv); 1425 if Func = Null_Iir then 1426 return Null_Iir; 1427 end if; 1428 case Get_Kind (Func) is 1429 when Iir_Kind_Function_Call => 1430 Assoc := Get_Parameter_Association_Chain (Func); 1431 Free_Iir (Assoc); 1432 Set_Parameter_Association_Chain (Func, Null_Iir); 1433 Name_To_Method_Object (Func, Conv); 1434 return Func; 1435 when Iir_Kind_Type_Conversion => 1436 return Func; 1437 when others => 1438 Error_Kind ("extract_in_conversion", Func); 1439 end case; 1440 end Extract_In_Conversion; 1441 1442 function Extract_Out_Conversion 1443 (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir 1444 is 1445 Func : Iir; 1446 begin 1447 if Conv = Null_Iir then 1448 return Null_Iir; 1449 end if; 1450 Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv); 1451 1452 return Func; 1453 end Extract_Out_Conversion; 1454 1455 procedure Sem_Association_Open 1456 (Assoc : Iir; 1457 Finish : Boolean; 1458 Match : out Compatibility_Level) 1459 is 1460 Formal : Iir; 1461 begin 1462 if Finish then 1463 -- LRM 4.3.3.2 Associations lists 1464 -- It is an error if an actual of open is associated with a 1465 -- formal that is associated individually. 1466 if Get_Whole_Association_Flag (Assoc) = False then 1467 Error_Msg_Sem 1468 (+Assoc, "cannot associate individually with open"); 1469 end if; 1470 1471 Formal := Get_Formal (Assoc); 1472 if Formal /= Null_Iir then 1473 Set_Formal (Assoc, Finish_Sem_Name (Formal)); 1474 end if; 1475 end if; 1476 Match := Fully_Compatible; 1477 end Sem_Association_Open; 1478 1479 procedure Sem_Association_Package_Type_Not_Finish 1480 (Assoc : Iir; 1481 Inter : Iir; 1482 Match : out Compatibility_Level) 1483 is 1484 Formal : constant Iir := Get_Formal (Assoc); 1485 begin 1486 if Formal = Null_Iir then 1487 -- Can be associated only once 1488 Match := Fully_Compatible; 1489 else 1490 if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol) 1491 and then Get_Identifier (Formal) = Get_Identifier (Inter) 1492 then 1493 Match := Fully_Compatible; 1494 else 1495 Match := Not_Compatible; 1496 end if; 1497 end if; 1498 end Sem_Association_Package_Type_Not_Finish; 1499 1500 procedure Sem_Association_Package_Type_Finish (Assoc : Iir; Inter : Iir) 1501 is 1502 Formal : constant Iir := Get_Formal (Assoc); 1503 begin 1504 if Formal /= Null_Iir then 1505 pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter)); 1506 pragma Assert (Get_Named_Entity (Formal) = Inter); 1507 Set_Formal (Assoc, Finish_Sem_Name (Formal)); 1508 end if; 1509 end Sem_Association_Package_Type_Finish; 1510 1511 procedure Sem_Association_Package 1512 (Assoc : Iir; 1513 Inter : Iir; 1514 Finish : Boolean; 1515 Match : out Compatibility_Level) 1516 is 1517 Actual : Iir; 1518 Package_Inter : Iir; 1519 begin 1520 if not Finish then 1521 Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); 1522 return; 1523 end if; 1524 1525 Match := Not_Compatible; 1526 Sem_Association_Package_Type_Finish (Assoc, Inter); 1527 1528 -- Analyze actual. 1529 Actual := Get_Actual (Assoc); 1530 Actual := Sem_Denoting_Name (Actual); 1531 Set_Actual (Assoc, Actual); 1532 1533 Actual := Get_Named_Entity (Actual); 1534 if Is_Error (Actual) then 1535 return; 1536 end if; 1537 1538 -- LRM08 6.5.7.2 Generic map aspects 1539 -- An actual associated with a formal generic package in a 1540 -- generic map aspect shall be the name that denotes an instance 1541 -- of the uninstantiated package named in the formal generic 1542 -- package declaration [...] 1543 if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then 1544 Error_Msg_Sem 1545 (+Assoc, "actual of association is not a package instantiation"); 1546 return; 1547 end if; 1548 1549 Package_Inter := Get_Uninstantiated_Package_Decl (Inter); 1550 if Get_Uninstantiated_Package_Decl (Actual) /= Package_Inter then 1551 Error_Msg_Sem 1552 (+Assoc, 1553 "actual package name is not an instance of interface package"); 1554 return; 1555 end if; 1556 1557 -- LRM08 6.5.7.2 Generic map aspects 1558 -- b) If the formal generic package declaration includes an interface 1559 -- generic map aspect in the form that includes the box (<>) symbol, 1560 -- then the instantiated package denotes by the actual may be any 1561 -- instance of the uninstantiated package named in the formal 1562 -- generic package declaration. 1563 if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then 1564 null; 1565 else 1566 -- Other cases not yet handled. 1567 raise Internal_Error; 1568 end if; 1569 1570 Match := Fully_Compatible; 1571 1572 return; 1573 end Sem_Association_Package; 1574 1575 -- Create an implicit association_element_subprogram for the declaration 1576 -- of function ID for ACTUAL_Type (a type/subtype definition). 1577 function Sem_Implicit_Operator_Association 1578 (Id : Name_Id; Actual_Type : Iir; Actual_Name : Iir) return Iir 1579 is 1580 use Sem_Scopes; 1581 1582 -- Return TRUE if DECL is a function declaration with a comparaison 1583 -- operator profile. 1584 function Has_Comparaison_Profile (Decl : Iir) return Boolean 1585 is 1586 Inter : Iir; 1587 begin 1588 -- A function declaration. 1589 if not Is_Function_Declaration (Decl) then 1590 return False; 1591 end if; 1592 -- That returns a boolean. 1593 if (Get_Base_Type (Get_Return_Type (Decl)) 1594 /= Vhdl.Std_Package.Boolean_Type_Definition) 1595 then 1596 return False; 1597 end if; 1598 1599 -- With 2 interfaces of type ATYPE. 1600 Inter := Get_Interface_Declaration_Chain (Decl); 1601 for I in 1 .. 2 loop 1602 if Inter = Null_Iir then 1603 return False; 1604 end if; 1605 if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Actual_Type) 1606 then 1607 return False; 1608 end if; 1609 Inter := Get_Chain (Inter); 1610 end loop; 1611 if Inter /= Null_Iir then 1612 return False; 1613 end if; 1614 return True; 1615 end Has_Comparaison_Profile; 1616 1617 Interp : Name_Interpretation_Type; 1618 Decl : Iir; 1619 Res : Iir; 1620 begin 1621 Interp := Get_Interpretation (Id); 1622 while Valid_Interpretation (Interp) loop 1623 Decl := Get_Declaration (Interp); 1624 if Has_Comparaison_Profile (Decl) then 1625 Res := Create_Iir (Iir_Kind_Association_Element_Subprogram); 1626 Location_Copy (Res, Actual_Name); 1627 Set_Actual 1628 (Res, Build_Simple_Name (Decl, Get_Location (Actual_Name))); 1629 Set_Use_Flag (Decl, True); 1630 return Res; 1631 end if; 1632 Interp := Get_Next_Interpretation (Interp); 1633 end loop; 1634 1635 Error_Msg_Sem (+Actual_Name, "cannot find a %i declaration for type %i", 1636 (+Id, +Actual_Name)); 1637 return Null_Iir; 1638 end Sem_Implicit_Operator_Association; 1639 1640 procedure Sem_Association_Type (Assoc : Iir; 1641 Inter : Iir; 1642 Finish : Boolean; 1643 Match : out Compatibility_Level) 1644 is 1645 Inter_Def : constant Iir := Get_Type (Inter); 1646 Actual : Iir; 1647 Actual_Type : Iir; 1648 Op_Eq, Op_Neq : Iir; 1649 begin 1650 if not Finish then 1651 Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); 1652 return; 1653 end if; 1654 1655 Match := Fully_Compatible; 1656 Sem_Association_Package_Type_Finish (Assoc, Inter); 1657 Actual := Get_Actual (Assoc); 1658 1659 -- LRM08 6.5.7.2 Generic map aspects 1660 -- An actual associated with a formal generic type must be a subtype 1661 -- indication. 1662 -- FIXME: ghdl only supports type_mark! 1663 Actual := Sem_Types.Sem_Subtype_Indication (Actual); 1664 Set_Actual (Assoc, Actual); 1665 1666 -- Set type association for analysis of reference to this interface. 1667 pragma Assert (Is_Null (Get_Associated_Type (Inter_Def))); 1668 if Get_Kind (Actual) in Iir_Kinds_Subtype_Definition then 1669 Actual_Type := Actual; 1670 else 1671 Actual_Type := Get_Type (Actual); 1672 end if; 1673 Set_Actual_Type (Assoc, Actual_Type); 1674 Set_Associated_Type (Inter_Def, Actual_Type); 1675 1676 -- FIXME: it is not clear at all from the LRM how the implicit 1677 -- associations are done... 1678 Op_Eq := Sem_Implicit_Operator_Association 1679 (Std_Names.Name_Op_Equality, Actual_Type, Actual); 1680 if Op_Eq /= Null_Iir then 1681 Op_Neq := Sem_Implicit_Operator_Association 1682 (Std_Names.Name_Op_Inequality, Actual_Type, Actual); 1683 Set_Chain (Op_Eq, Op_Neq); 1684 Set_Subprogram_Association_Chain (Assoc, Op_Eq); 1685 end if; 1686 end Sem_Association_Type; 1687 1688 function Has_Interface_Subprogram_Profile 1689 (Inter : Iir; 1690 Decl : Iir; 1691 Explain_Loc : Location_Type := No_Location) return Boolean 1692 is 1693 -- Handle previous assocation of interface type before full 1694 -- instantiation. 1695 function Get_Inter_Type (Inter : Iir) return Iir 1696 is 1697 Res : Iir; 1698 begin 1699 Res := Get_Type (Inter); 1700 if Get_Kind (Res) = Iir_Kind_Interface_Type_Definition then 1701 -- FIXME: recurse ? 1702 return Get_Associated_Type (Res); 1703 else 1704 return Res; 1705 end if; 1706 end Get_Inter_Type; 1707 1708 Explain : constant Boolean := Explain_Loc /= No_Location; 1709 El_Inter, El_Decl : Iir; 1710 begin 1711 case Iir_Kinds_Interface_Subprogram_Declaration (Get_Kind (Inter)) is 1712 when Iir_Kind_Interface_Function_Declaration => 1713 if not Is_Function_Declaration (Decl) then 1714 if Explain then 1715 Error_Msg_Sem (Explain_Loc, " actual is not a function"); 1716 end if; 1717 return False; 1718 end if; 1719 if Get_Base_Type (Get_Inter_Type (Inter)) 1720 /= Get_Base_Type (Get_Type (Decl)) 1721 then 1722 if Explain then 1723 Error_Msg_Sem (Explain_Loc, " return type doesn't match"); 1724 end if; 1725 return False; 1726 end if; 1727 when Iir_Kind_Interface_Procedure_Declaration => 1728 if not Is_Procedure_Declaration (Decl) then 1729 if Explain then 1730 Error_Msg_Sem (Explain_Loc, " actual is not a procedure"); 1731 end if; 1732 return False; 1733 end if; 1734 end case; 1735 1736 El_Inter := Get_Interface_Declaration_Chain (Inter); 1737 El_Decl := Get_Interface_Declaration_Chain (Decl); 1738 loop 1739 exit when Is_Null (El_Inter) and Is_Null (El_Decl); 1740 if Is_Null (El_Inter) or Is_Null (El_Decl) then 1741 if Explain then 1742 Error_Msg_Sem 1743 (Explain_Loc, " number of interfaces doesn't match"); 1744 end if; 1745 return False; 1746 end if; 1747 if Get_Base_Type (Get_Inter_Type (El_Inter)) 1748 /= Get_Base_Type (Get_Type (El_Decl)) 1749 then 1750 if Explain then 1751 Error_Msg_Sem 1752 (Explain_Loc, 1753 " type of interface %i doesn't match", +El_Inter); 1754 end if; 1755 return False; 1756 end if; 1757 El_Inter := Get_Chain (El_Inter); 1758 El_Decl := Get_Chain (El_Decl); 1759 end loop; 1760 1761 return True; 1762 end Has_Interface_Subprogram_Profile; 1763 1764 procedure Sem_Association_Subprogram (Assoc : Iir; 1765 Inter : Iir; 1766 Finish : Boolean; 1767 Match : out Compatibility_Level) 1768 is 1769 Discard : Boolean; 1770 pragma Unreferenced (Discard); 1771 Actual : Iir; 1772 Res : Iir; 1773 begin 1774 if not Finish then 1775 Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); 1776 return; 1777 end if; 1778 1779 Match := Fully_Compatible; 1780 Sem_Association_Package_Type_Finish (Assoc, Inter); 1781 Actual := Get_Actual (Assoc); 1782 1783 -- LRM08 6.5.7.2 Generic map aspects 1784 -- An actual associated with a formal generic subprogram shall be a name 1785 -- that denotes a subprogram whose profile conforms to that of the 1786 -- formal, or the reserved word OPEN. The actual, if a predefined 1787 -- attribute name that denotes a function, shall be one of the 1788 -- predefined attributes 'IMAGE, 'VALUE, 'POS, 'VAL, 'SUCC, 'PREV, 1789 -- 'LEFTOF, or 'RIGHTOF. 1790 Sem_Name (Actual); 1791 Res := Get_Named_Entity (Actual); 1792 1793 if Is_Error (Res) then 1794 return; 1795 end if; 1796 1797 case Get_Kind (Res) is 1798 when Iir_Kinds_Subprogram_Declaration 1799 | Iir_Kinds_Interface_Subprogram_Declaration => 1800 if not Has_Interface_Subprogram_Profile (Inter, Res) then 1801 Error_Msg_Sem 1802 (+Assoc, "profile of %n doesn't match profile of %n", 1803 (+Actual, +Inter)); 1804 -- Explain 1805 Discard := Has_Interface_Subprogram_Profile 1806 (Inter, Res, Get_Location (Assoc)); 1807 return; 1808 end if; 1809 when Iir_Kind_Overload_List => 1810 declare 1811 Nbr_Errors : Natural; 1812 List : Iir_List; 1813 It : List_Iterator; 1814 El, R : Iir; 1815 begin 1816 Nbr_Errors := 0; 1817 R := Null_Iir; 1818 List := Get_Overload_List (Res); 1819 It := List_Iterate (List); 1820 while Is_Valid (It) loop 1821 El := Get_Element (It); 1822 if Has_Interface_Subprogram_Profile (Inter, El) then 1823 if Is_Null (R) then 1824 R := El; 1825 else 1826 if Nbr_Errors = 0 then 1827 Error_Msg_Sem 1828 (+Assoc, 1829 "many possible actual subprogram for %n:", 1830 +Inter); 1831 Error_Msg_Sem 1832 (+Assoc, " %n declared at %l", (+R, + R)); 1833 else 1834 Error_Msg_Sem 1835 (+Assoc, " %n declared at %l", (+El, +El)); 1836 end if; 1837 Nbr_Errors := Nbr_Errors + 1; 1838 end if; 1839 end if; 1840 Next (It); 1841 end loop; 1842 if Is_Null (R) then 1843 Error_Msg_Sem 1844 (+Assoc, "no matching name for %n", +Inter); 1845 if True then 1846 Error_Msg_Sem 1847 (+Assoc, " these names were incompatible:"); 1848 It := List_Iterate (List); 1849 while Is_Valid (It) loop 1850 El := Get_Element (It); 1851 Error_Msg_Sem 1852 (+Assoc, " %n declared at %l", (+El, +El)); 1853 Next (It); 1854 end loop; 1855 end if; 1856 return; 1857 elsif Nbr_Errors > 0 then 1858 return; 1859 end if; 1860 Free_Overload_List (Res); 1861 Res := R; 1862 end; 1863 when others => 1864 Error_Kind ("sem_association_subprogram", Res); 1865 end case; 1866 1867 Set_Named_Entity (Actual, Res); 1868 Vhdl.Xrefs.Xref_Name (Actual); 1869 Sem_Decls.Mark_Subprogram_Used (Res); 1870 end Sem_Association_Subprogram; 1871 1872 procedure Sem_Association_Terminal 1873 (Assoc : Iir; 1874 Inter : Iir; 1875 Finish : Boolean; 1876 Match : out Compatibility_Level) 1877 is 1878 Actual_Name : Iir; 1879 Actual : Iir; 1880 begin 1881 if not Finish then 1882 Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); 1883 return; 1884 end if; 1885 1886 Match := Not_Compatible; 1887 Sem_Association_Package_Type_Finish (Assoc, Inter); 1888 1889 -- Analyze actual. 1890 Actual_Name := Get_Actual (Assoc); 1891 Sem_Name (Actual_Name); 1892 Actual := Get_Named_Entity (Actual_Name); 1893 1894 if Is_Error (Actual) then 1895 return; 1896 elsif Is_Overload_List (Actual) then 1897 Error_Msg_Sem (+Actual_Name, "terminal name expected"); 1898 return; 1899 else 1900 Actual := Finish_Sem_Name (Actual_Name); 1901 case Get_Kind (Get_Object_Prefix (Actual)) is 1902 when Iir_Kind_Terminal_Declaration 1903 | Iir_Kind_Interface_Terminal_Declaration => 1904 null; 1905 when others => 1906 Error_Msg_Sem 1907 (+Actual_Name, "%n is not a terminal name", +Actual); 1908 return; 1909 end case; 1910 end if; 1911 1912 Set_Actual (Assoc, Actual); 1913 1914 if (Get_Base_Nature (Get_Nature (Get_Named_Entity (Actual))) 1915 /= Get_Base_Nature (Get_Nature (Inter))) 1916 then 1917 Error_Msg_Sem 1918 (+Actual, "nature of actual is not the same as formal nature"); 1919 return; 1920 end if; 1921 1922 Match := Fully_Compatible; 1923 1924 return; 1925 end Sem_Association_Terminal; 1926 1927 -- Associate ASSOC with interface INTERFACE 1928 -- This sets MATCH. 1929 procedure Sem_Association_By_Expression 1930 (Assoc : Iir; 1931 Inter : Iir; 1932 Formal_Name : Iir; 1933 Formal_Conv : Iir; 1934 Finish : Boolean; 1935 Match : out Compatibility_Level) 1936 is 1937 Formal_Type : Iir; 1938 Actual: Iir; 1939 Out_Conv, In_Conv : Iir; 1940 Expr : Iir; 1941 Res_Type : Iir; 1942 begin 1943 Out_Conv := Formal_Conv; 1944 if Formal_Name /= Null_Iir then 1945 Formal_Type := Get_Type (Formal_Name); 1946 else 1947 Formal_Type := Get_Type (Inter); 1948 end if; 1949 1950 -- Extract conversion from actual. 1951 -- LRM08 6.5.7.1 Association lists 1952 Actual := Get_Actual (Assoc); 1953 In_Conv := Null_Iir; 1954 if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then 1955 declare 1956 -- Actual before the extraction of the conversion. 1957 Prev_Actual : constant Iir := Actual; 1958 begin 1959 -- Extract conversion and new actual (conv_expr). 1960 case Get_Kind (Actual) is 1961 when Iir_Kind_Function_Call => 1962 Expr := Get_Parameter_Association_Chain (Actual); 1963 if Is_Conversion_Function (Expr) then 1964 In_Conv := Actual; 1965 Actual := Get_Actual (Expr); 1966 end if; 1967 when Iir_Kind_Type_Conversion => 1968 if Flags.Vhdl_Std > Vhdl_87 then 1969 In_Conv := Actual; 1970 Actual := Get_Expression (Actual); 1971 end if; 1972 when others => 1973 null; 1974 end case; 1975 1976 if Actual = Null_Iir then 1977 Match := Fully_Compatible; 1978 return; 1979 end if; 1980 1981 -- There could be an ambiguity between a conversion and a normal 1982 -- actual expression. Check if the new actual is an object and 1983 -- if the object is of the corresponding class. 1984 if Is_Valid (In_Conv) then 1985 if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then 1986 if not Is_Signal_Object (Actual) then 1987 -- Actual is not a signal object. This is not a 1988 -- conversion but a regular association. 1989 In_Conv := Null_Iir; 1990 Actual := Prev_Actual; 1991 end if; 1992 else 1993 -- Variable: let as is. 1994 null; 1995 end if; 1996 end if; 1997 end; 1998 end if; 1999 2000 -- 4 cases: F:out_conv, G:in_conv. 2001 -- A => B type of A = type of B 2002 -- F(A) => B type of B = type of F 2003 -- A => G(B) type of A = type of G 2004 -- F(A) => G(B) type of B = type of F, type of A = type of G 2005 if Out_Conv = Null_Iir and then In_Conv = Null_Iir then 2006 Match := Is_Expr_Compatible (Formal_Type, Actual); 2007 else 2008 Match := Fully_Compatible; 2009 if In_Conv /= Null_Iir then 2010 Match := Compatibility_Level'Min 2011 (Match, Is_Expr_Compatible (Formal_Type, In_Conv)); 2012 end if; 2013 if Out_Conv /= Null_Iir then 2014 Match := Compatibility_Level'Min 2015 (Match, Is_Expr_Compatible (Get_Type (Out_Conv), Actual)); 2016 end if; 2017 end if; 2018 2019 if Match = Not_Compatible then 2020 if Finish and then not Is_Error (Actual) then 2021 Report_Start_Group; 2022 Error_Msg_Sem 2023 (+Assoc, "can't associate %n with %n", (+Actual, +Inter)); 2024 Error_Msg_Sem 2025 (+Assoc, "(type of %n is " & Disp_Type_Of (Actual) & ")", 2026 (1 => +Actual)); 2027 Error_Msg_Sem 2028 (+Inter, "(type of %n is " & Disp_Type_Of (Inter) & ")", +Inter); 2029 Report_End_Group; 2030 end if; 2031 return; 2032 end if; 2033 2034 if not Finish then 2035 return; 2036 end if; 2037 2038 -- At that point, the analysis is being finished. 2039 2040 if Out_Conv = Null_Iir and then In_Conv = Null_Iir then 2041 Res_Type := Formal_Type; 2042 else 2043 if Out_Conv /= Null_Iir then 2044 Res_Type := Search_Compatible_Type (Get_Type (Out_Conv), 2045 Get_Type (Actual)); 2046 else 2047 Res_Type := Get_Type (Actual); 2048 end if; 2049 2050 if In_Conv /= Null_Iir then 2051 In_Conv := Extract_In_Conversion (In_Conv, Formal_Type, Res_Type); 2052 end if; 2053 if Out_Conv /= Null_Iir then 2054 Out_Conv := Extract_Out_Conversion (Out_Conv, 2055 Res_Type, Formal_Type); 2056 end if; 2057 end if; 2058 2059 if Res_Type = Null_Iir then 2060 -- In case of error, do not go farther. 2061 Match := Not_Compatible; 2062 return; 2063 end if; 2064 2065 if Formal_Name /= Null_Iir then 2066 declare 2067 Formal : Iir; 2068 Conv_Assoc : Iir; 2069 begin 2070 -- Extract formal from the conversion (and unlink it from the 2071 -- conversion, as the owner of the formal is the association, not 2072 -- the conversion). 2073 Formal := Finish_Sem_Name (Get_Formal (Assoc)); 2074 case Get_Kind (Formal) is 2075 when Iir_Kind_Function_Call => 2076 pragma Assert (Formal_Conv /= Null_Iir); 2077 Set_Formal_Conversion (Assoc, Formal); 2078 Conv_Assoc := Get_Parameter_Association_Chain (Formal); 2079 Set_Parameter_Association_Chain (Formal, Null_Iir); 2080 Formal := Get_Actual (Conv_Assoc); 2081 Free_Iir (Conv_Assoc); 2082 -- Name_To_Method_Object (Func, Conv); 2083 when Iir_Kind_Type_Conversion => 2084 pragma Assert (Formal_Conv /= Null_Iir); 2085 Conv_Assoc := Formal; 2086 Set_Formal_Conversion (Assoc, Formal); 2087 Formal := Get_Expression (Formal); 2088 Set_Expression (Conv_Assoc, Null_Iir); 2089 when others => 2090 pragma Assert (Formal_Conv = Null_Iir); 2091 null; 2092 end case; 2093 Set_Formal (Assoc, Formal); 2094 2095 -- Use the type of the formal to analyze the actual. In 2096 -- particular, the formal may be constrained while the actual is 2097 -- not. 2098 Formal_Type := Get_Type (Formal); 2099 if Out_Conv = Null_Iir and In_Conv = Null_Iir then 2100 Res_Type := Formal_Type; 2101 end if; 2102 end; 2103 end if; 2104 2105 -- LRM08 6.5.7 Association lists 2106 -- The formal part of a named association element may be in the form of 2107 -- a function call [...] if and only if the formal is an interface 2108 -- object, the mode of the formal is OUT, INOUT, BUFFER or LINKAGE [...] 2109 if Out_Conv /= Null_Iir 2110 and then Get_Mode (Inter) = Iir_In_Mode 2111 then 2112 Error_Msg_Sem 2113 (+Assoc, "can't use an out conversion for an in interface"); 2114 end if; 2115 2116 -- LRM08 6.5.7 Association lists 2117 -- The actual part of an association element may be in the form of a 2118 -- function call [...] if and only if the mode of the format is IN, 2119 -- INOUT or LINKAGE [...] 2120 Set_Actual_Conversion (Assoc, In_Conv); 2121 if In_Conv /= Null_Iir 2122 and then Get_Mode (Inter) in Iir_Buffer_Mode .. Iir_Out_Mode 2123 then 2124 Error_Msg_Sem 2125 (+Assoc, "can't use an in conversion for an out/buffer interface"); 2126 end if; 2127 2128 -- LRM08 5.3.2.2 Index constraints and discrete ranges 2129 -- e) [...] 2130 -- 3) [...] 2131 -- -- For an interface object or subelement whose mode is IN, INOUT 2132 -- or LINKAGE, if the actual part includes a conversion function 2133 -- or a type conversion, then the result type of that function 2134 -- or the type mark of the type conversion shall define a 2135 -- constraint for the index range corresponding to the index 2136 -- range of the objet, [...] 2137 -- -- For an interface object or subelement whose mode is OUT, 2138 -- BUFFER, INOUT or LINKAGE, if the formal part includes a 2139 -- conversion function or a type conversion, then the parameter 2140 -- subtype of that function or the type mark of the type 2141 -- conversion shall define a constraint for the index range 2142 -- corresponding to the index range of the object, [...] 2143 if not Is_Fully_Constrained_Type (Formal_Type) then 2144 if (Get_Mode (Inter) in Iir_In_Modes 2145 or else Get_Mode (Inter) = Iir_Linkage_Mode) 2146 and then In_Conv /= Null_Iir 2147 and then not Is_Fully_Constrained_Type (Get_Type (In_Conv)) 2148 then 2149 Error_Msg_Sem 2150 (+Assoc, "type of actual conversion must be fully constrained"); 2151 end if; 2152 if (Get_Mode (Inter) in Iir_Out_Modes 2153 or else Get_Mode (Inter) = Iir_Linkage_Mode) 2154 and then Out_Conv /= Null_Iir 2155 and then not Is_Fully_Constrained_Type (Get_Type (Out_Conv)) 2156 then 2157 Error_Msg_Sem 2158 (+Assoc, "type of formal conversion must be fully constrained"); 2159 end if; 2160 end if; 2161 2162 -- FIXME: LRM refs 2163 -- This is somewhat wrong. A missing conversion is not an error but 2164 -- may result in a type mismatch. 2165 if Get_Mode (Inter) = Iir_Inout_Mode then 2166 if In_Conv = Null_Iir and then Out_Conv /= Null_Iir then 2167 Error_Msg_Sem 2168 (+Assoc, "out conversion without corresponding in conversion"); 2169 elsif In_Conv /= Null_Iir and then Out_Conv = Null_Iir then 2170 Error_Msg_Sem 2171 (+Assoc, "in conversion without corresponding out conversion"); 2172 end if; 2173 end if; 2174 Set_Actual (Assoc, Actual); 2175 2176 -- Analyze actual. 2177 Expr := Sem_Expression (Actual, Res_Type); 2178 if Expr /= Null_Iir then 2179 Expr := Eval_Expr_Check_If_Static (Expr, Res_Type); 2180 Set_Actual (Assoc, Expr); 2181 if In_Conv = Null_Iir and then Out_Conv = Null_Iir then 2182 if not Eval_Is_In_Bound (Expr, Formal_Type, True) then 2183 Error_Msg_Sem 2184 (+Assoc, "actual constraints don't match formal ones"); 2185 end if; 2186 end if; 2187 end if; 2188 end Sem_Association_By_Expression; 2189 2190 -- Associate ASSOC with interface INTERFACE 2191 -- This sets MATCH. 2192 procedure Sem_Association (Assoc : Iir; 2193 Inter : Iir; 2194 Formal : Iir; 2195 Formal_Conv : Iir; 2196 Finish : Boolean; 2197 Match : out Compatibility_Level) is 2198 begin 2199 case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is 2200 when Iir_Kinds_Interface_Object_Declaration => 2201 if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then 2202 Sem_Association_Open (Assoc, Finish, Match); 2203 else 2204 Sem_Association_By_Expression 2205 (Assoc, Inter, Formal, Formal_Conv, Finish, Match); 2206 end if; 2207 2208 when Iir_Kind_Interface_Terminal_Declaration => 2209 if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then 2210 Sem_Association_Open (Assoc, Finish, Match); 2211 else 2212 Sem_Association_Terminal (Assoc, Inter, Finish, Match); 2213 end if; 2214 2215 when Iir_Kind_Interface_Package_Declaration => 2216 Sem_Association_Package (Assoc, Inter, Finish, Match); 2217 2218 when Iir_Kind_Interface_Type_Declaration => 2219 Sem_Association_Type (Assoc, Inter, Finish, Match); 2220 2221 when Iir_Kinds_Interface_Subprogram_Declaration => 2222 Sem_Association_Subprogram (Assoc, Inter, Finish, Match); 2223 end case; 2224 end Sem_Association; 2225 2226 procedure Sem_Association_Chain 2227 (Interface_Chain : Iir; 2228 Assoc_Chain: in out Iir; 2229 Finish: Boolean; 2230 Missing : Missing_Type; 2231 Loc : Iir; 2232 Match : out Compatibility_Level) 2233 is 2234 Assoc : Iir; 2235 Inter : Iir; 2236 2237 -- True if -Whide is enabled (save the state). 2238 Warn_Hide_Enabled : Boolean; 2239 2240 type Param_Assoc_Type is (None, Open, Individual, Whole); 2241 2242 type Assoc_Array is array (Natural range <>) of Param_Assoc_Type; 2243 Nbr_Inter : constant Natural := Get_Chain_Length (Interface_Chain); 2244 Inter_Matched : Assoc_Array (0 .. Nbr_Inter - 1) := (others => None); 2245 2246 Last_Individual : Iir; 2247 Has_Individual : Boolean; 2248 Pos : Integer; 2249 Formal : Iir; 2250 2251 First_Named_Assoc : Iir; 2252 Last_Named_Assoc : Iir; 2253 2254 Formal_Name : Iir; 2255 Formal_Conv : Iir; 2256 begin 2257 Match := Fully_Compatible; 2258 First_Named_Assoc := Null_Iir; 2259 Has_Individual := False; 2260 2261 -- Loop on every assoc element, try to match it. 2262 Inter := Interface_Chain; 2263 Last_Individual := Null_Iir; 2264 Pos := 0; 2265 2266 -- First positional associations 2267 Assoc := Assoc_Chain; 2268 while Assoc /= Null_Iir loop 2269 Formal := Get_Formal (Assoc); 2270 exit when Formal /= Null_Iir; 2271 2272 -- Try to match actual of ASSOC with the interface. 2273 if Inter = Null_Iir then 2274 if Finish then 2275 Error_Msg_Sem (+Assoc, "too many actuals for %n", +Loc); 2276 end if; 2277 Match := Not_Compatible; 2278 return; 2279 end if; 2280 Set_Whole_Association_Flag (Assoc, True); 2281 Sem_Association (Assoc, Inter, Null_Iir, Null_Iir, Finish, Match); 2282 if Match = Not_Compatible then 2283 return; 2284 end if; 2285 if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then 2286 Inter_Matched (Pos) := Open; 2287 else 2288 Inter_Matched (Pos) := Whole; 2289 end if; 2290 Set_Whole_Association_Flag (Assoc, True); 2291 Inter := Get_Chain (Inter); 2292 2293 Pos := Pos + 1; 2294 Assoc := Get_Chain (Assoc); 2295 end loop; 2296 2297 -- Then association by name. 2298 if Assoc /= Null_Iir then 2299 -- Make interfaces visible 2300 -- 2301 -- LRM08 12.3 Visibility 2302 -- A declaration is visible by selection at places that are defined 2303 -- as follows: 2304 -- j) For a formal parameter declaration of a given subprogram 2305 -- declaration: at the place of the formal part (before the 2306 -- compound delimiter =>) of a named parameter association 2307 -- element of a corresponding subprogram call. 2308 -- k) For a local generic declaration of a given component 2309 -- declaration ... 2310 -- l) For a local port declaration of a given component declaration: 2311 -- ... 2312 -- m) For a formal generic declaration of a given entity declaration: 2313 -- ... 2314 -- n) For a formal port declaration of a given entity declaration: 2315 -- ... 2316 -- o) For a formal generic declaration or a formal port declaration 2317 -- of a given block statement: ... 2318 -- p) For a formal generic declaration of a given package 2319 -- declaration: ... 2320 -- q) For a formal generic declaration of a given subprogram 2321 -- declarations: ... 2322 -- 2323 -- At a place in which a given declaration is visible by selection, 2324 -- every declaration with the same designator as the given 2325 -- declaration and that would otherwise be directly visible is 2326 -- hidden. 2327 Sem_Scopes.Open_Declarative_Region; 2328 2329 -- Do not warn about hidding here, way to common, way useless. 2330 Warn_Hide_Enabled := Is_Warning_Enabled (Warnid_Hide); 2331 Enable_Warning (Warnid_Hide, False); 2332 2333 Sem_Scopes.Add_Declarations_From_Interface_Chain (Interface_Chain); 2334 2335 Enable_Warning (Warnid_Hide, Warn_Hide_Enabled); 2336 2337 First_Named_Assoc := Assoc; 2338 loop 2339 if Formal = Null_Iir then 2340 -- Positional after named argument. Already caught by 2341 -- Sem_Actual_Of_Association_Chain (because it is called only 2342 -- once, while sem_association_chain may be called several 2343 -- times). 2344 Match := Not_Compatible; 2345 exit; 2346 end if; 2347 2348 -- Last assoc to be cleaned up. 2349 Last_Named_Assoc := Assoc; 2350 2351 if Finish then 2352 Sem_Name (Formal); 2353 else 2354 Sem_Name_Soft (Formal); 2355 end if; 2356 Formal_Name := Get_Named_Entity (Formal); 2357 if Is_Error (Formal_Name) then 2358 Match := Not_Compatible; 2359 -- Continue analysis in order to catch more errors. 2360 end if; 2361 2362 Assoc := Get_Chain (Assoc); 2363 exit when Assoc = Null_Iir; 2364 Formal := Get_Formal (Assoc); 2365 end loop; 2366 2367 -- Remove visibility by selection of interfaces. This is needed 2368 -- to correctly analyze actuals. 2369 Sem_Scopes.Close_Declarative_Region; 2370 2371 if Match /= Not_Compatible then 2372 Assoc := First_Named_Assoc; 2373 loop 2374 Formal := Get_Formal (Assoc); 2375 Formal_Name := Get_Named_Entity (Formal); 2376 2377 -- Extract conversion 2378 Formal_Conv := Null_Iir; 2379 case Get_Kind (Formal_Name) is 2380 when Iir_Kind_Function_Call => 2381 -- Only one actual 2382 declare 2383 Call_Assoc : constant Iir := 2384 Get_Parameter_Association_Chain (Formal_Name); 2385 begin 2386 if (Get_Kind (Call_Assoc) 2387 /= Iir_Kind_Association_Element_By_Expression) 2388 or else Get_Chain (Call_Assoc) /= Null_Iir 2389 or else Get_Formal (Call_Assoc) /= Null_Iir 2390 or else (Get_Actual_Conversion (Call_Assoc) 2391 /= Null_Iir) 2392 then 2393 if Finish then 2394 Error_Msg_Sem 2395 (+Assoc, "ill-formed formal conversion"); 2396 end if; 2397 Match := Not_Compatible; 2398 exit; 2399 end if; 2400 Formal_Conv := Formal_Name; 2401 Formal_Name := Get_Actual (Call_Assoc); 2402 end; 2403 when Iir_Kind_Type_Conversion => 2404 Formal_Conv := Formal_Name; 2405 Formal_Name := Get_Expression (Formal_Name); 2406 when Iir_Kind_Slice_Name 2407 | Iir_Kind_Indexed_Name 2408 | Iir_Kind_Selected_Element 2409 | Iir_Kind_Simple_Name => 2410 null; 2411 when others => 2412 Formal_Name := Formal; 2413 end case; 2414 case Get_Kind (Formal_Name) is 2415 when Iir_Kind_Selected_Element 2416 | Iir_Kind_Slice_Name 2417 | Iir_Kind_Indexed_Name => 2418 Inter := Get_Base_Name (Formal_Name); 2419 Set_Whole_Association_Flag (Assoc, False); 2420 when Iir_Kind_Simple_Name 2421 | Iir_Kind_Operator_Symbol => 2422 Inter := Get_Named_Entity (Formal_Name); 2423 Formal_Name := Inter; 2424 Set_Whole_Association_Flag (Assoc, True); 2425 when others => 2426 -- Error 2427 if Finish then 2428 Error_Msg_Sem (+Assoc, "formal is not a name"); 2429 end if; 2430 Match := Not_Compatible; 2431 exit; 2432 end case; 2433 2434 -- Simplify overload list (for interface subprogram). 2435 -- FIXME: Interface must hide previous subprogram declarations, 2436 -- so there should be no need to filter. 2437 if Is_Overload_List (Inter) then 2438 declare 2439 List : constant Iir_List := Get_Overload_List (Inter); 2440 It : List_Iterator; 2441 Filtered_Inter : Iir; 2442 El : Iir; 2443 begin 2444 Filtered_Inter := Null_Iir; 2445 It := List_Iterate (List); 2446 while Is_Valid (It) loop 2447 El := Get_Element (It); 2448 if Get_Kind (El) in Iir_Kinds_Interface_Declaration 2449 and then 2450 Get_Parent (El) = Get_Parent (Interface_Chain) 2451 then 2452 Add_Result (Filtered_Inter, El); 2453 end if; 2454 Next (It); 2455 end loop; 2456 Free_Overload_List (Inter); 2457 Inter := Filtered_Inter; 2458 2459 pragma Assert 2460 (Get_Kind (Formal) = Iir_Kind_Simple_Name 2461 or else 2462 Get_Kind (Formal) = Iir_Kind_Operator_Symbol); 2463 Set_Named_Entity (Formal, Inter); 2464 2465 if Inter = Null_Iir then 2466 if Finish then 2467 Error_Msg_Sem (+Assoc, "no interface %i for %n", 2468 (+Formal, +Loc)); 2469 end if; 2470 Match := Not_Compatible; 2471 exit; 2472 end if; 2473 2474 if Is_Overload_List (Inter) then 2475 if Finish then 2476 Error_Msg_Sem (+Assoc, "ambiguous formal name"); 2477 end if; 2478 Match := Not_Compatible; 2479 exit; 2480 end if; 2481 end; 2482 end if; 2483 if Get_Kind (Inter) not in Iir_Kinds_Interface_Declaration 2484 or else Interface_Chain = Null_Iir 2485 or else Get_Parent (Inter) /= Get_Parent (Interface_Chain) 2486 then 2487 if Finish then 2488 Error_Msg_Sem 2489 (+Formal, "%n is not an interface name", +Inter); 2490 end if; 2491 Match := Not_Compatible; 2492 exit; 2493 end if; 2494 2495 -- LRM 4.3.2.2 Association Lists 2496 -- The formal part of a named element association may be 2497 -- in the form of a function call, [...], if and only 2498 -- if the mode of the formal is OUT, INOUT, BUFFER, or 2499 -- LINKAGE, and the actual is not OPEN. 2500 if Formal_Conv /= Null_Iir 2501 and then (Get_Kind (Inter) 2502 not in Iir_Kinds_Interface_Object_Declaration 2503 or else Get_Mode (Inter) = Iir_In_Mode) 2504 then 2505 if Finish then 2506 Error_Msg_Sem 2507 (+Assoc, 2508 "formal conversion allowed only for interface object"); 2509 end if; 2510 Match := Not_Compatible; 2511 exit; 2512 end if; 2513 2514 -- Find the Interface. 2515 declare 2516 Inter1 : Iir; 2517 begin 2518 Inter1 := Interface_Chain; 2519 Pos := 0; 2520 while Inter1 /= Null_Iir loop 2521 exit when Inter = Inter1; 2522 Inter1 := Get_Chain (Inter1); 2523 Pos := Pos + 1; 2524 end loop; 2525 if Inter1 = Null_Iir then 2526 if Finish then 2527 Error_Msg_Sem 2528 (+Assoc, 2529 "no corresponding interface for %i", +Inter); 2530 end if; 2531 Match := Not_Compatible; 2532 exit; 2533 end if; 2534 end; 2535 2536 Sem_Association 2537 (Assoc, Inter, Formal_Name, Formal_Conv, Finish, Match); 2538 exit when Match = Not_Compatible; 2539 2540 if Get_Whole_Association_Flag (Assoc) then 2541 -- Whole association. 2542 Last_Individual := Null_Iir; 2543 if Inter_Matched (Pos) = None then 2544 if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open 2545 then 2546 Inter_Matched (Pos) := Open; 2547 else 2548 Inter_Matched (Pos) := Whole; 2549 end if; 2550 else 2551 if Finish then 2552 Error_Msg_Sem 2553 (+Assoc, "%n already associated", +Inter); 2554 end if; 2555 Match := Not_Compatible; 2556 exit; 2557 end if; 2558 else 2559 -- Individual association. 2560 Has_Individual := True; 2561 if Inter_Matched (Pos) /= Whole then 2562 if Finish 2563 and then Inter_Matched (Pos) = Individual 2564 and then Last_Individual /= Inter 2565 then 2566 Error_Msg_Sem 2567 (+Assoc, 2568 "non consecutive individual association for %n", 2569 +Inter); 2570 Match := Not_Compatible; 2571 exit; 2572 end if; 2573 Last_Individual := Inter; 2574 Inter_Matched (Pos) := Individual; 2575 else 2576 if Finish then 2577 Error_Msg_Sem 2578 (+Assoc, "%n already associated", +Inter); 2579 Match := Not_Compatible; 2580 exit; 2581 end if; 2582 end if; 2583 end if; 2584 2585 Assoc := Get_Chain (Assoc); 2586 exit when Assoc = Null_Iir; 2587 end loop; 2588 end if; 2589 2590 if Finish and Has_Individual and Match /= Not_Compatible then 2591 Sem_Individual_Association (Assoc_Chain); 2592 end if; 2593 2594 if not Finish then 2595 -- Always cleanup if not finishing: there can be other tries in 2596 -- case of overloading. 2597 Assoc := First_Named_Assoc; 2598 while Assoc /= Null_Iir loop 2599 Formal := Get_Formal (Assoc); 2600 -- User may have used by position assoc after named 2601 -- assocs. 2602 if Is_Valid (Formal) then 2603 Sem_Name_Clean (Formal); 2604 end if; 2605 exit when Assoc = Last_Named_Assoc; 2606 Assoc := Get_Chain (Assoc); 2607 end loop; 2608 end if; 2609 2610 if Match = Not_Compatible then 2611 return; 2612 end if; 2613 end if; 2614 2615 if Missing = Missing_Allowed then 2616 -- No need to check for missing associations. 2617 return; 2618 end if; 2619 2620 -- LRM93 8.6 Procedure Call Statement 2621 -- For each formal parameter of a procedure, a procedure call must 2622 -- specify exactly one corresponding actual parameter. 2623 -- This actual parameter is specified either explicitly, by an 2624 -- association element (other than the actual OPEN) in the association 2625 -- list, or in the absence of such an association element, by a default 2626 -- expression (see Section 4.3.3.2). 2627 2628 -- LRM93 7.3.3 Function Calls 2629 -- For each formal parameter of a function, a function call must 2630 -- specify exactly one corresponding actual parameter. 2631 -- This actual parameter is specified either explicitly, by an 2632 -- association element (other than the actual OPEN) in the association 2633 -- list, or in the absence of such an association element, by a default 2634 -- expression (see Section 4.3.3.2). 2635 2636 -- LRM93 1.1.1.2 / LRM08 6.5.6.3 Port clauses 2637 -- A port of mode IN may be unconnected or unassociated only if its 2638 -- declaration includes a default expression. 2639 -- A port of any mode other than IN may be unconnected or unassociated 2640 -- as long as its type is not an unconstrained array type. 2641 2642 -- LRM08 6.5.6.2 Generic clauses 2643 -- It is an error if no such actual [instantiated package] is specified 2644 -- for a given formal generic package (either because the formal generic 2645 -- is unassociated or because the actual is OPEN). 2646 2647 Inter := Interface_Chain; 2648 Pos := 0; 2649 while Inter /= Null_Iir loop 2650 if Inter_Matched (Pos) <= Open then 2651 if Sem_Check_Missing_Association (Inter, Missing, Finish, Loc) 2652 then 2653 Match := Not_Compatible; 2654 if not Finish then 2655 return; 2656 end if; 2657 end if; 2658 end if; 2659 2660 -- Clear associated type of interface type. 2661 if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then 2662 Set_Associated_Type (Get_Type (Inter), Null_Iir); 2663 end if; 2664 2665 Inter := Get_Chain (Inter); 2666 Pos := Pos + 1; 2667 end loop; 2668 end Sem_Association_Chain; 2669 2670 function Sem_Check_Missing_Association 2671 (Inter : Iir; Missing : Missing_Type; Finish : Boolean; Loc : Iir) 2672 return Boolean 2673 is 2674 Err : Boolean; 2675 begin 2676 -- Interface is unassociated (none or open). 2677 Err := False; 2678 case Get_Kind (Inter) is 2679 when Iir_Kinds_Interface_Object_Declaration => 2680 case Missing is 2681 when Missing_Parameter 2682 | Missing_Generic => 2683 if Get_Mode (Inter) /= Iir_In_Mode 2684 or else Get_Default_Value (Inter) = Null_Iir 2685 then 2686 Err := True; 2687 if Finish then 2688 Error_Msg_Sem (+Loc, "no actual for %n", +Inter); 2689 else 2690 return True; 2691 end if; 2692 end if; 2693 when Missing_Port => 2694 case Get_Mode (Inter) is 2695 when Iir_In_Mode => 2696 -- No overloading for components/entities. 2697 pragma Assert (Finish); 2698 if Get_Default_Value (Inter) = Null_Iir then 2699 Error_Msg_Sem 2700 (+Loc, "%n of mode IN must be connected", +Inter); 2701 Err := True; 2702 end if; 2703 when Iir_Out_Mode 2704 | Iir_Linkage_Mode 2705 | Iir_Inout_Mode 2706 | Iir_Buffer_Mode => 2707 -- No overloading for components/entities. 2708 pragma Assert (Finish); 2709 if not Is_Fully_Constrained_Type (Get_Type (Inter)) 2710 then 2711 Error_Msg_Sem 2712 (+Loc, 2713 "unconstrained %n must be connected", +Inter); 2714 Err := True; 2715 end if; 2716 when Iir_Unknown_Mode => 2717 raise Internal_Error; 2718 end case; 2719 when Missing_Allowed => 2720 null; 2721 end case; 2722 when Iir_Kind_Interface_Package_Declaration => 2723 if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then 2724 Error_Msg_Sem (+Loc, "%n must be associated", +Inter); 2725 Err := True; 2726 end if; 2727 when Iir_Kind_Interface_Function_Declaration 2728 | Iir_Kind_Interface_Procedure_Declaration => 2729 Error_Msg_Sem (+Loc, "%n must be associated", +Inter); 2730 Err := True; 2731 when others => 2732 Error_Kind ("sem_association_chain", Inter); 2733 end case; 2734 return Err; 2735 end Sem_Check_Missing_Association; 2736end Vhdl.Sem_Assocs; 2737